VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CDirectoryCompensator"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

' Class:    CDirectoryCompensator

Implements COMSVCSLib.ICrmCompensatorVariants

Public Enum tagDirCommands
    DIRCREATE = 0
    DIRDELETE = 1
End Enum

Private m_bCommitTX             As Boolean
Private m_objDirsToBeUnlocked   As Scripting.Dictionary

Private Sub ICrmCompensatorVariants_SetLogControlVariants(ByVal pLogControl As COMSVCSLib.ICrmLogControl)
    ' First method called when compensator is created.
    ' Used to obtain the ICrmLogControl interface, if needed.
End Sub



Private Sub ICrmCompensatorVariants_BeginPrepareVariants()
    ' Used to receive notification when prepare phase is beginnng.
    ' Note that prepare phase is skipped during recovery.
    m_bCommitTX = True
End Sub

Private Function ICrmCompensatorVariants_PrepareRecordVariants(pLogRecord As Variant) As Boolean
    Dim lCommand        As Long
    Dim strDirPath  As String
    
    ' Initialize.
    lCommand = pLogRecord(0)
    strDirPath = pLogRecord(1)
    
    ' If in debug mode, display the CRM flags and sequence number appended to the end of the array.
    #If DEBUGGING Then
        Debug.Print "CRM flags  = " & pLogRecord(UBound(pLogRecord) - 1)
        Debug.Print "Sequence # = " & pLogRecord(UBound(pLogRecord))
    #End If

    ' See if we received a valid record.
    If (m_bCommitTX = False) Then
        ' Do nothing.  No need to continue validating if we are not going to commit the transaction.
    ElseIf (lCommand = tagDirCommands.DIRCREATE And strDirPath <> "") Then
        ' Do nothing.
    ElseIf (lCommand = tagDirCommands.DIRDELETE And strDirPath <> "") Then
        ' Do nothing.
    Else
        m_bCommitTX = False
    End If
    
    ' We don't want to forget this record.
    ICrmCompensatorVariants_PrepareRecordVariants = False
End Function

Private Function ICrmCompensatorVariants_EndPrepareVariants() As Boolean
    ' Return whether or not prepare phase completed successfully and it is OK to commit transaction.
    ICrmCompensatorVariants_EndPrepareVariants = m_bCommitTX
End Function



Private Sub ICrmCompensatorVariants_BeginCommitVariants(ByVal bRecovery As Boolean)
    ' Don't need to perform any initialization nor care whether this is a recovery.
    Set m_objDirsToBeUnlocked = New Scripting.Dictionary
End Sub

Private Function ICrmCompensatorVariants_CommitRecordVariants(pLogRecord As Variant) As Boolean
    Dim objFS           As Scripting.FileSystemObject
    Dim lCommand        As Long
    Dim strDirPath      As String
    
    ' Initialize.
    Set objFS = New Scripting.FileSystemObject
    lCommand = pLogRecord(0)
    strDirPath = pLogRecord(1)
    
    Select Case lCommand
        Case tagDirCommands.DIRCREATE
            ' Unhide directory and then add it to the list of locks to be removed.
            If (objFS.FolderExists(strDirPath)) Then
                objFS.GetFolder(strDirPath).Attributes = _
                    objFS.GetFolder(strDirPath).Attributes - Hidden
                If (Not m_objDirsToBeUnlocked.Exists(strDirPath)) Then _
                    m_objDirsToBeUnlocked.Add strDirPath, "unlock"
            End If
        Case tagDirCommands.DIRDELETE
            If (objFS.FolderExists(strDirPath)) Then
                ' Delete folder and then add it to the list of locks to be removed.
                objFS.DeleteFolder strDirPath
                If (Not m_objDirsToBeUnlocked.Exists(strDirPath)) Then _
                    m_objDirsToBeUnlocked.Add strDirPath, "unlock"
            End If
    End Select
    
    ' Since we've successfully committed, forget this record.
    ICrmCompensatorVariants_CommitRecordVariants = True
End Function

Private Sub ICrmCompensatorVariants_EndCommitVariants()
    Dim varLock     As Variant
    Dim objFS       As Scripting.FileSystemObject
    
    ' Initialize.
    Set objFS = New Scripting.FileSystemObject

    ' Remove lock(s) from directory(s).
    For Each varLock In m_objDirsToBeUnlocked
        objFS.DeleteFile varLock & "\..\" & GetFolderName(varLock) & "_lock.txt"
    Next
End Sub



Private Sub ICrmCompensatorVariants_BeginAbortVariants(ByVal bRecovery As Boolean)
    ' Don't need to perform any initialization nor care whether this is a recovery.
    Set m_objDirsToBeUnlocked = New Scripting.Dictionary
End Sub

Private Function ICrmCompensatorVariants_AbortRecordVariants(pLogRecord As Variant) As Boolean
    Dim objFS           As Scripting.FileSystemObject
    Dim lCommand        As Long
    Dim strDirPath      As String
    
    ' Initialize.
    Set objFS = New Scripting.FileSystemObject
    lCommand = pLogRecord(0)
    strDirPath = pLogRecord(1)
    
    Select Case lCommand
        Case tagDirCommands.DIRCREATE
            If (objFS.FolderExists(strDirPath)) Then
                ' Delete folder and then add it to the list of locks to be removed.
                objFS.DeleteFolder strDirPath
                If (Not m_objDirsToBeUnlocked.Exists(strDirPath)) Then _
                    m_objDirsToBeUnlocked.Add strDirPath, "unlock"
            End If
        Case tagDirCommands.DIRDELETE
            If (objFS.FolderExists(strDirPath)) Then
                ' Add directory to the list of locks to be removed.
                If (Not m_objDirsToBeUnlocked.Exists(strDirPath)) Then _
                    m_objDirsToBeUnlocked.Add strDirPath, "unlock"
            End If
    End Select
    
    ' Since we've successfully aborted, forget this record.
    ICrmCompensatorVariants_AbortRecordVariants = True
End Function

Private Sub ICrmCompensatorVariants_EndAbortVariants()
    Dim varLock     As Variant
    Dim objFS       As Scripting.FileSystemObject
    
    ' Initialize.
    Set objFS = New Scripting.FileSystemObject

    ' Remove lock(s) from directory(s).
    For Each varLock In m_objDirsToBeUnlocked
        objFS.DeleteFile varLock & "\..\" & GetFolderName(varLock) & "_lock.txt"
    Next
End Sub



Private Function GetFolderName(ByVal strDirPath As String) As String
    Dim lCount      As Long
    Dim strChar     As String
    Dim strDirName  As String
    Dim lIndex      As Long
    
    ' Initialize lIndex ignoring any trailing backslash.
    If (Right(strDirPath, 1) <> "\") Then
        lIndex = Len(strDirPath)
    Else
        lIndex = Len(strDirPath) - 1
    End If
    
    ' Obtain folder name.
    Do While (strChar <> "\" And lIndex > 0)
        strDirName = strChar & strDirName
        strChar = Mid(strDirPath, lIndex, 1)
        lIndex = lIndex - 1
    Loop
    
    GetFolderName = strDirName
End Function
