clsisowriter.cls

iso文件制作与制作光盘 iso文件制作与制作光盘

                .length = min(255, LenB(clsSubDir.JolietName))
                .ext_attr_rec_len = 0

                If msb Then
                    CpyMem .extent(0), SwapLong(clsSubDir.Files.LBAJoliet), 4
                Else
                    CpyMem .extent(0), clsSubDir.Files.LBAJoliet, 4
                End If

                If clsSubDir.Parent Is Nothing Then
                    If msb Then
                        CpyMem .parent_dir_num(0), SwapInteger(1), 2
                    Else
                        CpyMem .parent_dir_num(0), 1, 2
                    End If
                Else
                    If msb Then
                        CpyMem .parent_dir_num(0), SwapInteger(clsSubDir.Parent.DirectoryNumber), 2
                    Else
                        CpyMem .parent_dir_num(0), clsSubDir.Parent.DirectoryNumber, 2
                    End If
                End If

                CpySwapBSTR StrPtr(clsSubDir.JolietName), _
                            VarPtr(.dir_id(0)), _
                            min(256, LenB(clsSubDir.JolietName))
            End With

            FileWrite hFileOut, VarPtr(udtEntry), RecordSizePathTable(udtEntry.length)
        Next

        WritePathTableByLayerJoliet = True
        Exit Function
    End If

    For i = 0 To clsDir.SubDirectoryCount - 1
        If WritePathTableByLayerJoliet(clsDir.SubDirectory(i), layer_search, layer_current + 1, msb, dirnum) Then
            WritePathTableByLayerJoliet = True
        End If
    Next
End Function

' The directories must have a specific order in the path table.
' Roughly like a pyramid, carried of layer by layer:
'
'         root (1)                          Layer 0
'        /       \
'       /         \-_
'  subdir1 (2)        subdir2 (3)           Layer 1
'    |                     |
'    |                     /
'  subdir3 (4)        subdir4 (5)           Layer 2
'                  /         \
'                 /           \
'             subdir5 (6)    subdir6 (7)    Layer 3
'
' The numbers in the brackets describe the order
' of these directories in the path table.
'
Private Function WritePathTableByLayer( _
    clsDir As clsISODirectory, _
    ByVal layer_search As Long, _
    ByVal layer_current As Long, _
    ByVal msb As Boolean, _
    ByRef dirnum As Integer _
) As Boolean

    Dim i           As Long
    Dim clsSubDir   As clsISODirectory
    Dim udtEntry    As ISO_PATH_TABLE_RECORD

    ' found the layer looking for?
    If layer_current = layer_search Then
        ' add all the subdirectories to the path table
        For i = 0 To clsDir.SubDirectoryCount - 1
            Set clsSubDir = clsDir.SubDirectory(i)

            clsSubDir.DirectoryNumber = dirnum
            dirnum = dirnum + 1

            With udtEntry
                .length = min(255, Len(clsSubDir.DOSName))
                .ext_attr_rec_len = 0

                If msb Then
                    CpyMem .extent(0), SwapLong(clsSubDir.Files.LBA), 4
                Else
                    CpyMem .extent(0), clsSubDir.Files.LBA, 4
                End If

                If clsSubDir.Parent Is Nothing Then
                    If msb Then
                        CpyMem .parent_dir_num(0), SwapInteger(1), 2
                    Else
                        CpyMem .parent_dir_num(0), 1, 2
                    End If
                Else
                    If msb Then
                        CpyMem .parent_dir_num(0), SwapInteger(clsSubDir.Parent.DirectoryNumber), 2
                    Else
                        CpyMem .parent_dir_num(0), clsSubDir.Parent.DirectoryNumber, 2
                    End If
                End If

                CpyMem .dir_id(0), ByVal clsSubDir.DOSName, .length
            End With

            FileWrite hFileOut, VarPtr(udtEntry), RecordSizePathTable(udtEntry.length)
        Next

        ' found the layer we have looked for, so return true
        ' to look for further directories on this layer
        WritePathTableByLayer = True
        Exit Function
    End If

    ' didn't find the layer, look in the other subdirectories
    For i = 0 To clsDir.SubDirectoryCount - 1
        If WritePathTableByLayer(clsDir.SubDirectory(i), layer_search, layer_current + 1, msb, dirnum) Then
            WritePathTableByLayer = True
        End If
    Next
End Function

Private Function DebugOutput( _
    clsDir As clsISODirectory _
)

    Dim i   As Long

    Debug.Print "Directory: " & clsDir.name, clsDir.DOSName, clsDir.JolietName
    Debug.Print "   Number: " & clsDir.DirectoryNumber
    Debug.Print "    Files: " & clsDir.Files.Count
    Debug.Print "  FBlocks: " & clsDir.Files.Blocks
    Debug.Print "     FLBA: " & clsDir.Files.LBA

    For i = 0 To clsDir.Files.Count - 1
        With clsDir.Files.File(i)
            Debug.Print "     File " & i & ":" & .name, .DOSName, .JolietName
            Debug.Print "         LBA: " & .LBA
        End With
    Next

    Debug.Print ""

    For i = 0 To clsDir.SubDirectoryCount - 1
        DebugOutput clsDir.SubDirectory(i)
    Next
End Function

Public Property Get ImageSize( _
) As Long

    ImageSize = CalcDirSize(clsRoot) + 2048& * 100&
End Property

' get the size of a directory (recursive)
Private Function CalcDirSize( _
    clsDir As clsISODirectory _
) As Long

    Dim clsDirN     As clsISODirectory
    Dim i           As Long
    Dim lngBytes    As Long

    For i = 0 To clsDir.Files.Count - 1
        lngBytes = lngBytes + RoundBytesByBlocks(clsDir.Files.File(i).Size)
    Next

    For i = 0 To clsDir.SubDirectoryCount - 1
        lngBytes = lngBytes + CalcDirSize(clsDir.SubDirectory(i))
    Next

    CalcDirSize = lngBytes
End Function

Private Function IsDChars( _
    ByVal text As String _
) As Boolean

    Dim btChr   As Byte
    Dim i       As Long

    For i = 1 To Len(text)
        btChr = Asc(Mid$(text, i, 1))

        If Not ((btChr >= &H41 And btChr <= &H5A) Or _
                (btChr >= &H30 And btChr <= &H39) Or _
                (btChr = &H2E) Or (btChr = &H5F)) Then

            Exit Function
        End If
    Next

    IsDChars = True
End Function

Private Function IsAChars( _
    ByVal text As String _
) As Boolean

    Dim btChr   As Byte
    Dim i       As Long

    For i = 1 To Len(text)
        btChr = Asc(Mid$(text, i, 1))

        If Not ((btChr >= &H41 And btChr <= &H5A) Or _
                (btChr >= &H61 And btChr <= &H7A) Or _
                (btChr >= &H20 And btChr <= &H22) Or _
                (btChr >= &H26 And btChr <= &H2F) Or _
                (btChr >= &H3A And btChr <= &H3F) Or _
                (btChr >= &H30 And btChr <= &H39) Or _
                (btChr = &H5F)) Then

            Exit Function
        End If
    Next

    IsAChars = True
End Function

Private Function RecordSizePathTable( _
    ByVal dir_name_len As Long, _
    Optional ByVal count_padding_byte As Long = 1 _
) As Long

    RecordSizePathTable = 8 + dir_name_len + IIf(dir_name_len Mod 2, count_padding_byte, 0)
End Function

Private Function RecordSizeDirRecord( _
    ByVal dir_name_len As Long, _
    Optional ByVal count_padding_byte As Long = 1 _
) As Long

    RecordSizeDirRecord = 32 + dir_name_len + IIf(dir_name_len Mod 2, count_padding_byte, 0)
End Function

Public Property Get VolumeSetID( _
    ByVal Joliet As Boolean _
) As String

    VolumeSetID = IIf(Joliet, strVolSetIDJoliet, strVolSetID)
End Property

Public Property Let VolumeSetID( _
    ByVal Joliet As Boolean, _
    ByVal strNewVal As String _
)

    If Joliet Then
        strVolSetIDJoliet = strNewVal
    Else
        strVolSetID = StringToDChars(strNewVal)
    End If
End Property

Public Property Get VolumeCreation( _
) As Date

    VolumeCreation = dateVolCreation
End Property

Public Property Let VolumeCreation( _
    ByVal dateNewVal As Date _
)

    dateVolCreation = dateNewVal
End Property

Public Property Get DataPreparerID( _
    ByVal Joliet As Boolean _
) As String

    DataPreparerID = IIf(Joliet, strDataPrepIDJoliet, strDataPrepID)
End Property

Public Property Let DataPreparerID( _
    ByVal Joliet As Boolean, _
    ByVal strNewVal As String _
)

    If Joliet Then
        strDataPrepIDJoliet = strNewVal
    Else
        strDataPrepID = StringToAChars(strNewVal)
    End If
End Property

Public Property Get PublisherID( _
    ByVal Joliet As Boolean _
) As String

    PublisherID = IIf(Joliet, strPublisherIDJoliet, strPublisherID)
End Property

Public Property Let PublisherID( _
    ByVal Joliet As Boolean, _
    ByVal strNewVal As String _
)

    If Joliet Then
        strPublisherIDJoliet = strNewVal
    Else
        strPublisherID = StringToAChars(strNewVal)
    End If
End Property

Public Property Get ApplicationID( _
    ByVal Joliet As Boolean _
) As String

    ApplicationID = IIf(Joliet, strAppIDJoliet, strAppID)
End Property

Public Property Let ApplicationID( _
    ByVal Joliet As Boolean, _
    ByVal strNewVal As String _
)

    If Joliet Then
        strAppIDJoliet = strNewVal
    Else
        strAppID = StringToAChars(strNewVal)
    End If
End Property

Public Property Get VolumeID( _
    ByVal Joliet As Boolean _
) As String

    VolumeID = IIf(Joliet, strVolumeIDJoliet, strVolumeID)
End Property

Public Property Let VolumeID( _
    ByVal Joliet As Boolean, _
    ByVal strNewVal As String _
)

    If Joliet Then
        strVolumeIDJoliet = strNewVal
    Else
        strVolumeID = StringToDChars(strNewVal)
    End If
End Property

Public Property Get SystemID( _
    ByVal Joliet As Boolean _
) As String

    SystemID = IIf(Joliet, strSystemIDJoliet, strSystemID)
End Property

Public Property Let SystemID( _
    ByVal Joliet As Boolean, _
    ByVal strNewVal As String _
)

    If Joliet Then
        strSystemIDJoliet = strNewVal
    Else
        strSystemID = StringToAChars(strNewVal)
    End If
End Property

Public Property Get Root( _
) As clsISODirectory

    Set Root = clsRoot
End Property

Private Sub Class_Initialize()
    Set clsRoot = New clsISODirectory

    strSystemID = "WIN32"
    strSystemIDJoliet = "WIN32"
    strVolumeID = "NEU_VOL"
    strVolumeIDJoliet = "Neues Volume"
    strPublisherID = "clsISOWriter"
    strPublisherIDJoliet = "clsISOWriter"
    strAppID = "VB ISO Writer"
    strAppIDJoliet = "VB ISO Writer"

    dateVolCreation = Now
    blnJoliet = True
End Sub

' return a directory from a full path
Public Function DirByPath( _
    ByVal strPath As String _
) As clsISODirectory

    Dim strParts()  As String
    Dim i           As Long
    Dim j           As Long
    Dim clsDir      As clsISODirectory

    Set clsDir = clsRoot

    If strPath = "" Then Exit Function
    If Not Left$(strPath, 1) = "\" Then Exit Function

    If strPath <> "\" Then
        strPath = Mid$(strPath, 2, Len(strPath) - 2)

        strParts = Split(strPath, "\")

        Do
            For i = 0 To clsDir.SubDirectoryCount - 1
                If clsDir.SubDirectory(i).name = strParts(j) Then
                    j = j + 1
                    Set clsDir = clsDir.SubDirectory(i)
                    GoTo NextLoop
                End If
            Next

            If i > clsDir.SubDirectoryCount Then
                Exit Function
            End If

NextLoop:
            If j > UBound(strParts) Then
                Exit Do
            End If
        Loop
    End If

    Set DirByPath = clsDir
End Function

Private Function min( _
    ByVal value1 As Long, _
    ByVal value2 As Long _
) As Long

    min = IIf(value1 < value2, value1, value2)
End Function

Private Function max( _
    ByVal value1 As Long, _
    ByVal value2 As Long _
) As Long

    max = IIf(value1 > value2, value1, value2)
End Function

' both byte ordered 16 bit int
Private Function IntegerTo723( _
    ByVal intg As Integer _
) As Long

    CpyMem ByVal VarPtr(IntegerTo723) + 0, intg, 2
    CpyMem ByVal VarPtr(IntegerTo723) + 2, SwapInteger(intg), 2
End Function

' both byte ordered 32 bit int
Private Function LongTo733( _
    ByVal lng As Long _
) As Double

    CpyMem ByVal VarPtr(LongTo733) + 0, lng, 4
    CpyMem ByVal VarPtr(LongTo733) + 4, SwapLong(lng), 4
End Function

' swap bytes of a 16 bit int
Private Function SwapInteger( _
    ByVal word As Integer _
) As Integer

    SwapInteger = ((word And &HFF00) \ &H100) Or _
                  ((word And &HFF) * &H100)
End Function

' swap bytes of a 32 bit int
Private Function SwapLong( _
    ByVal dw As Long _
) As Long

    ' by Mike D Sutton, [e-mail], 20040914
    SwapLong = (((dw And &HFF000000) \ &H1000000) And &HFF&) Or _
                ((dw And &HFF0000) \ &H100&) Or _
                ((dw And &HFF00&) * &H100&) Or _
                ((dw And &H7F&) * &H1000000)

    If (dw And &H80&) Then SwapLong = SwapLong Or &H80000000
End Function