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

' Class:    CDirectory

Private Const XACT_E_RECOVERYINPROGRESS = -2147799170#

Public Sub Create(ByVal strDirPath As String)
    On Error GoTo ErrorHandler
    
    Dim objFS                   As Scripting.FileSystemObject
    Dim strDirName              As String
    Dim objCRMLogCtl            As COMSVCSLib.ICrmLogControl
    Dim aRecord(1)              As Variant
    Dim lErrNumber              As Long
    Dim strMyTransactionID      As String
    Dim strLocksTransactionID   As String
    Dim bAquiredLock            As Boolean
    Dim strCompProgID           As String
    Dim strCompDesc             As String
    
    ' Initialize.
    Set objFS = New Scripting.FileSystemObject
    Set objCRMLogCtl = New COMSVCSLib.CRMClerk
    strDirName = GetFolderName(strDirPath)
    strCompProgID = "FileSystemCRM.CDirectoryCompensator"
    strCompDesc = "The compensator for CDirectory."
    strMyTransactionID = GetObjectContext().ContextInfo.GetTransactionId
    bAquiredLock = False
    
    ' Validation.
    If (objFS.FolderExists(strDirPath)) Then _
        Err.Raise vbObjectError + 1, "FolderExists", "Directory already exist."
    
    ' Strip the trailing backslash off of the directory path.
    If (Right(strDirPath, 1) = "\") Then _
        strDirPath = Left(strDirPath, Len(strDirPath) - 1)
    
    ' Register compensator
    On Error Resume Next
    Do
        objCRMLogCtl.RegisterCompensator strCompProgID, strCompDesc, COMSVCSLib.CRMREGFLAG_ALLPHASES
        lErrNumber = Err.Number
    Loop While (lErrNumber = XACT_E_RECOVERYINPROGRESS)
    On Error GoTo ErrorHandler
    If (lErrNumber <> 0) Then Err.Raise vbObjectError + 1, "RegisterCompensator", _
        "Could not register the compensator component (err=" & lErrNumber & ")."

    ' Obtain lock for folder.
    On Error Resume Next
    Do While (Not bAquiredLock)
        ' Loop until lock is freed.
        Do
            If (objFS.FileExists(strDirPath & "\..\" & strDirName & "_lock.txt")) Then
                strLocksTransactionID = objFS.GetFile(strDirPath & "\..\" & strDirName & "_lock.txt").OpenAsTextStream.ReadLine
            Else
                strLocksTransactionID = ""
            End If
        Loop Until (strLocksTransactionID = "" Or strMyTransactionID = Trim(strLocksTransactionID))
        
        ' If not locked by my transaction, attempt to obtain lock.
        If (strLocksTransactionID = "") Then
            objFS.CreateTextFile(strDirPath & "\..\" & strDirName & "_lock.txt", False).WriteLine strMyTransactionID
            If (Err = 0) Then bAquiredLock = True
        Else
            bAquiredLock = True
        End If
    Loop
    On Error GoTo ErrorHandler
    
    ' Write event information to the CRM log.
    aRecord(0) = CInt(tagDirCommands.DIRCREATE)
    aRecord(1) = strDirPath
    objCRMLogCtl.WriteLogRecordVariants aRecord
    objCRMLogCtl.ForceLog
    
    ' Perform the action and attempt to isolate the new directory from other clients.
    objFS.CreateFolder strDirPath
    objFS.GetFolder(strDirPath).Attributes = _
        objFS.GetFolder(strDirPath).Attributes + Hidden
    
    ' Clean up.
    Set objFS = Nothing
    Set objCRMLogCtl = Nothing
    
    Exit Sub
ErrorHandler:
    Err.Raise vbObjectError + 1, "Create", "Error creating directory: " & Err.Source & " (err=" & Err.Number & "): " & Err.Description
End Sub

Public Sub Delete(ByVal strDirPath As String)
    
    Dim objFS                   As Scripting.FileSystemObject
    Dim strDirName              As String
    Dim objCRMLogCtl            As COMSVCSLib.ICrmLogControl
    Dim aRecord(1)              As Variant
    Dim lErrNumber              As Long
    Dim strMyTransactionID      As String
    Dim strLocksTransactionID   As String
    Dim bAquiredLock            As Boolean
    Dim strCompProgID           As String
    Dim strCompDesc             As String
    
    ' Initialize.
    Set objFS = New Scripting.FileSystemObject
    Set objCRMLogCtl = New COMSVCSLib.CRMClerk
    strDirName = GetFolderName(strDirPath)
    strCompProgID = "FileSystemCRM.CDirectoryCompensator"
    strCompDesc = "The compensator for CDirectory."
    strMyTransactionID = GetObjectContext().ContextInfo.GetTransactionId
    bAquiredLock = False
    
    ' Validation.
    If (Not objFS.FolderExists(strDirPath)) Then _
        Err.Raise vbObjectError + 1, "FolderExists", "Directory does not exist."
    
    ' Strip the trailing backslash off of the directory path.
    If (Right(strDirPath, 1) = "\") Then _
        strDirPath = Left(strDirPath, Len(strDirPath) - 1)
    
    ' Register compensator
    On Error Resume Next
    Do
        objCRMLogCtl.RegisterCompensator strCompProgID, strCompDesc, COMSVCSLib.CRMREGFLAG_ALLPHASES
        lErrNumber = Err.Number
    Loop While (lErrNumber = XACT_E_RECOVERYINPROGRESS)
    On Error GoTo ErrorHandler
    If (lErrNumber <> 0) Then Err.Raise vbObjectError + 2, "RegisterCompensator", _
        "Could not register the compensator component (err=" & lErrNumber & ")."

    ' Obtain lock for folder.
    On Error Resume Next
    Do While (Not bAquiredLock)
        ' Loop until lock is freed.
        Do
            If (objFS.FileExists(strDirPath & "\..\" & strDirName & "_lock.txt")) Then
                strLocksTransactionID = objFS.GetFile(strDirPath & "\..\" & strDirName & "_lock.txt").OpenAsTextStream.ReadLine
            Else
                strLocksTransactionID = ""
            End If
        Loop Until (strLocksTransactionID = "" Or strMyTransactionID = Trim(strLocksTransactionID))
        
        ' If not locked by my transaction, attempt to obtain lock.
        If (strLocksTransactionID = "") Then
            objFS.CreateTextFile(strDirPath & "\..\" & strDirName & "_lock.txt", False).WriteLine strMyTransactionID
            If (Err = 0) Then bAquiredLock = True
        Else
            bAquiredLock = True
        End If
    Loop
    On Error GoTo ErrorHandler
    
    ' Write event information to the CRM log.
    aRecord(0) = CLng(tagDirCommands.DIRDELETE)
    aRecord(1) = strDirPath
    objCRMLogCtl.WriteLogRecordVariants aRecord
    objCRMLogCtl.ForceLog
    
    ' Perform the action.
    ' Nothing to do since we defer the actual delete to the compensator.
    
    ' Clean up.
    Set objFS = Nothing
    Set objCRMLogCtl = Nothing
    
    Exit Sub
ErrorHandler:
    Err.Raise vbObjectError + 1, "Delete", "Error deleting directory: " & Err.Source & " (err=" & Err.Number & "): " & Err.Description
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
