clsisowriter.cls

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

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

' Create Mode 1 ISO9660 Level 2 + Joliet Filesystem Images
'
' by rm_code 27.07.2006

Private Declare Sub CpyMem Lib "kernel32" _
Alias "RtlMoveMemory" ( _
    pDst As Any, _
    pSrc As Any, _
    ByVal cBytes As Long _
)

Private Enum VD_TYPES
    VD_BOOT = 0
    VD_PRIMARY = 1
    VD_SUPPLEMENT = 2
    VD_PARTITION = 3
    VD_END = 255
End Enum

Private Enum ISO_DIR_FLAGS
    ISO_FLAG_FILE = 0
    ISO_FLAG_EXISTENCE = 2 ^ 0
    ISO_FLAG_DIRECTORY = 2 ^ 1
    ISO_FLAG_ASSOCIATED = 2 ^ 2
    ISO_FLAG_RECORD = 2 ^ 3
    ISO_FLAG_PROTECTION = 2 ^ 4
    ISO_FLAG_DRESERVED1 = 2 ^ 5
    ISO_FLAG_DRESERVED2 = 2 ^ 6
    ISO_FLAG_MULTIEXTENT = 2 ^ 7
End Enum

' all bytes are chars except for the gmt offset (numeric)
Private Type ISO_DATETIME
    dt_year(3)                  As Byte
    dt_month(1)                 As Byte
    dt_day(1)                   As Byte
    dt_hour(1)                  As Byte
    dt_minute(1)                As Byte
    dt_second(1)                As Byte
    dt_hsecond(1)               As Byte
    dt_gmtoff                   As Byte
End Type

Private Type ISO_DIRREC_DATETIME
    drdt_year                   As Byte
    drdt_month                  As Byte
    drdt_day                    As Byte
    drdt_hour                   As Byte
    drdt_minute                 As Byte
    drdt_second                 As Byte
    drdt_gmtoff                 As Byte
End Type

' data types:
'
' 711:   8 bit unsigned
' 712:   8 bit signed
' 721:  16 bit least significant
' 722:  16 bit most  significant
' 723:  16 bit both  byte order
' 731:  32 bit least significant
' 732:  32 bit most  significant
' 733:  32 bit both  byte order
'
' 741:  D-Chars und A-Chars
' 7421: A1-Chars
' 7422: D1-Chars

Private Type ISO_PRIMARY_VOLUME_DESCRIPTOR
    vol_desc_type               As Byte         ' 711
    standard_id(4)              As Byte         ' "CD001"
    vol_desc_version            As Byte         ' 711
    unused_1                    As Byte         ' -
    system_id(31)               As Byte         ' 741 (A)
    volume_id(31)               As Byte         ' 741 (D)
    unused_2(7)                 As Byte         ' -
    vol_space_size(7)           As Byte         ' 733
    unused_3(31)                As Byte         ' -
    vol_set_size(3)             As Byte         ' 723
    vol_seq_num(3)              As Byte         ' 723
    logical_block_size(3)       As Byte         ' 723
    path_table_size(7)          As Byte         ' 733
    type_l_path_table(3)        As Byte         ' 731
    type_l_opt_path_table(3)    As Byte         ' 731
    type_m_path_table(3)        As Byte         ' 731
    type_m_opt_path_table(3)    As Byte         ' 731
    root_directory(33)          As Byte
    vol_set_id(127)             As Byte         ' 741 (D)
    publisher_id(127)           As Byte         ' 741 (A)
    data_prep_id(127)           As Byte         ' 741 (A)
    app_id(127)                 As Byte         ' 741 (A)
    cpy_file_id(36)             As Byte         ' 741 (D)
    abstr_file_id(36)           As Byte         ' 741 (D)
    bibl_file_id(36)            As Byte         ' 741 (D)
    vol_creation_date(16)       As Byte         ' date
    vol_modification_date(16)   As Byte         ' date
    vol_expiration_date(16)     As Byte         ' date
    vol_effective_date(16)      As Byte         ' date
    file_struct_version         As Byte         ' 711
    unused_4                    As Byte         ' -
    app_use(511)                As Byte         ' -
    unused_5(652)               As Byte         ' -
End Type

Private Type ISO_SUPPLEMENTARY_VOLUME_DESCRIPTOR
    vol_desc_type               As Byte         ' 711
    standard_id(4)              As Byte         ' "CD001"
    vol_desc_version            As Byte         ' 711
    vol_flags                   As Byte         ' 8 bits
    system_id(31)               As Byte         ' 741 (A)
    volume_id(31)               As Byte         ' 741 (D)
    unused_2(7)                 As Byte         ' -
    vol_space_size(7)           As Byte         ' 733
    escape_seqs(31)             As Byte         ' -
    vol_set_size(3)             As Byte         ' 723
    vol_seq_num(3)              As Byte         ' 723
    logical_block_size(3)       As Byte         ' 723
    path_table_size(7)          As Byte         ' 733
    type_l_path_table(3)        As Byte         ' 731
    type_l_opt_path_table(3)    As Byte         ' 731
    type_m_path_table(3)        As Byte         ' 731
    type_m_opt_path_table(3)    As Byte         ' 731
    root_directory(33)          As Byte
    vol_set_id(127)             As Byte         ' 741 (D)
    publisher_id(127)           As Byte         ' 741 (A)
    data_prep_id(127)           As Byte         ' 741 (A)
    app_id(127)                 As Byte         ' 741 (A)
    cpy_file_id(36)             As Byte         ' 741 (D)
    abstr_file_id(36)           As Byte         ' 741 (D)
    bibl_file_id(36)            As Byte         ' 741 (D)
    vol_creation_date(16)       As Byte         ' date
    vol_modification_date(16)   As Byte         ' date
    vol_expiration_date(16)     As Byte         ' date
    vol_effective_date(16)      As Byte         ' date
    file_struct_version         As Byte         ' 711
    unused_4                    As Byte         ' -
    app_use(511)                As Byte         ' -
    unused_5(652)               As Byte         ' -
End Type

Private Type ISO_VOLUME_DESCRIPTOR_TERMINATOR
    vol_desc_type               As Byte         ' 711
    standard_id(4)              As Byte         ' "CD001"
    vol_desc_version            As Byte         ' 711
    reserved(2040)              As Byte         ' -
End Type

Private Type ISO_DIRECTORY_RECORD
    length                      As Byte         ' 711
    ext_attr_rec_len            As Byte         ' 711
    extent(7)                   As Byte         ' 733
    data_length(7)              As Byte         ' 733
    rec_date_time(6)            As Byte         ' date_short
    flags                       As Byte         ' 711
    file_unit_size              As Byte         ' 711
    interleave_gap_size         As Byte         ' 711
    vol_seq_num(3)              As Byte         ' 723
    file_id_len                 As Byte         ' 711
    file_id(255)                As Byte         ' 741 (D)
    ' padding byte for (Len(file_id) mod 2)
End Type

Private Type ISO_PATH_TABLE_RECORD
    length                      As Byte         ' 711
    ext_attr_rec_len            As Byte         ' 711
    extent(3)                   As Byte         ' 731/2
    parent_dir_num(1)           As Byte         ' 721/2
    dir_id(255)                 As Byte         ' 741 (D)
    ' padding byte for (Len(dir_id) mod 2)
End Type

Private Const ISO_STANDARD_ID   As String = "CD001"
Private Const ISO_BLOCKSIZE     As Long = 2048
Private Const ISO_FILENAMELEN   As Long = 31
Private Const ISO_DIRNAMELEN    As Long = 31
Private Const ISO_SEPARATOR1    As String = "."
Private Const ISO_SEPARATOR2    As String = ";"
Private Const ISO_FILLER        As String = " "

Private Const ISO_EMPTY_BLOCKS  As Long = 16
Private Const ISO_PVD_BLOCKS    As Long = 1
Private Const ISO_SVD_BLOCKS    As Long = 1
Private Const ISO_TVD_BLOCKS    As Long = 1

Private Const ISO_PATHTABLE_LBA As Long = ISO_EMPTY_BLOCKS + _
                                          ISO_PVD_BLOCKS + _
                                          ISO_TVD_BLOCKS ' + ISO_SVD_BLOCKS

Private clsRoot                 As clsISODirectory  ' Root

Private blnJoliet               As Boolean

Private strVolumeID             As String           ' CD Name
Private strVolumeIDJoliet       As String
Private strSystemID             As String
Private strSystemIDJoliet       As String

Private strAppID                As String
Private strAppIDJoliet          As String
Private strPublisherID          As String
Private strPublisherIDJoliet    As String
Private strDataPrepID           As String
Private strDataPrepIDJoliet     As String
Private strVolSetID             As String
Private strVolSetIDJoliet       As String
Private strCpyFileID            As String
Private strCpyFileIDJoliet      As String
Private strBiblFileID           As String
Private strBiblFileIDJoliet     As String
Private strAbstrFileID          As String
Private strAbstrFileIDJoliet    As String

Private dateVolCreation         As Date

Private hFileOut                As hFile

Private lngApproxImgSize        As Long

Public Event BuildingFilesystem()
Public Event WritingPathTable()
Public Event WritingDirectoryRecords()
Public Event WritingFiles(ByVal percent As Long)
Public Event WritingFinished()

' filter ilegal A-Chars from a string
Private Function StringToAChars( _
    ByVal strText As String _
) As String

    Dim i           As Long
    Dim strLetter   As String

    For i = 1 To Len(strText)
        strLetter = Mid$(strText, i, 1)
        If Not IsAChars(strLetter) Then
            strLetter = ""
        End If
        StringToAChars = StringToAChars & strLetter
    Next
End Function

' filter ilegal D-Chars from a string
Private Function StringToDChars( _
    ByVal strText As String _
) As String

    Dim i           As Long
    Dim strLetter   As String

    strText = UCase$(Replace(strText, " ", "_"))

    For i = 1 To Len(strText)
        strLetter = Mid$(strText, i, 1)
        If Not IsDChars(strLetter) Then
            strLetter = ""
        End If
        StringToDChars = StringToDChars & strLetter
    Next
End Function

' check if clsChild is a child of clsParent (depth is unimportant)
Public Function DirectoryIsChildOf( _
    clsParent As clsISODirectory, _
    clsChild As clsISODirectory _
) As Boolean

    DirectoryIsChildOf = DirectoryLevel(clsParent) - DirectoryInPath(clsParent, clsChild) < 0
End Function

' get the depth of equality from 2 directories (left to right)
Public Function DirectoryInPath( _
    clsDir1 As clsISODirectory, _
    clsDir2 As clsISODirectory _
) As Long

    Dim i               As Long
    Dim lngMax          As Long
    Dim lngCnt          As Long

    Dim strPath1Parts() As String
    Dim strPath2Parts() As String

    strPath1Parts = Split(clsDir1.FullPath, "\")
    strPath2Parts = Split(clsDir2.FullPath, "\")

    If UBound(strPath1Parts) > UBound(strPath2Parts) Then
        lngMax = UBound(strPath2Parts)
    Else
        lngMax = UBound(strPath1Parts)
    End If

    For i = 0 To lngMax
        If strPath1Parts(i) <> strPath2Parts(i) Then
            Exit For
        End If

        lngCnt = lngCnt + 1
    Next

    DirectoryInPath = lngCnt
End Function

' level of a directory
Public Function DirectoryLevel( _
    clsDir As clsISODirectory _
) As Long

    Dim strParts()  As String

    strParts = Split(clsDir.FullPath, "\")

    DirectoryLevel = UBound(strParts) - 1
End Function

Public Property Get Joliet( _
) As Boolean

    Joliet = blnJoliet
End Property

Public Property Let Joliet( _
    ByVal blnNewVal As Boolean _
)

    blnJoliet = blnNewVal
End Property

' generate a short DOS name from a string (e.g. "asdasd~1")
Private Function ShortDosName( _
    ByVal name As String, _
    ByVal index As Long, _
    ByVal max As Long _
) As String

    name = Left(name, Len(name) - (1 + Len(CStr(index))))
    name = name & "~" & index

    ShortDosName = name
End Function

' remove the extension from a filename
Private Function StripExtension( _
    ByVal File As String _
) As String

    If InStrRev(File, ".") > 0 Then
        StripExtension = Left$(File, InStrRev(File, ".") - 1)
    Else
        StripExtension = File
    End If
End Function

' return the extension of a filename
Private Function GetExtension( _
    ByVal File As String _
) As String

    Dim lngDotPos   As Long

    lngDotPos = InStrRev(File, ".")

    If lngDotPos > 0 Then
        GetExtension = Mid$(File, lngDotPos + 1)
    End If
End Function

' set the start LBA of directory records
Private Function AddStartBlocks( _
    clsDir As clsISODirectory, _
    ByVal DirTableBlocks As Long, _
    ByVal PathTableBlocks As Long _
) As Long

    Dim lngLBA  As Long
    Dim i       As Long

    If blnJoliet Then
        lngLBA = ISO_PATHTABLE_LBA + ISO_SVD_BLOCKS + PathTableBlocks * 4
    Else
        lngLBA = ISO_PATHTABLE_LBA + PathTableBlocks * 2
    End If

    ' set the directory record start LBA for directories
    SetDirRecordStartLBA clsDir, lngLBA

    If blnJoliet Then
        SetDirRecordStartLBAJoliet clsDir, lngLBA
    End If

    ' set the start LBA for files
    SetFileStartLBA clsDir, lngLBA

    AddStartBlocks = lngLBA
End Function

' set the LBA of files
Private Sub SetFileStartLBA( _
    clsDir As clsISODirectory, _
    LBA As Long _
)

    Dim i   As Long

    With clsDir.Files
        For i = 0 To .Count - 1
            .File(i).Size = FileLen(.File(i).LocalPath)
            If .File(i).Size > 0 Then
                .File(i).LBA = LBA
                LBA = LBA + RoundBytesByBlocks(.File(i).Size) \ ISO_BLOCKSIZE
            Else
                .File(i).LBA = 0
            End If
        Next
    End With

    For i = 0 To clsDir.SubDirectoryCount - 1
        SetFileStartLBA clsDir.SubDirectory(i), LBA
    Next
End Sub

Private Sub SetDirRecordStartLBAJoliet( _
    clsDir As clsISODirectory, _
    LBA As Long _
)

    Dim i   As Long

    clsDir.Files.LBAJoliet = LBA
    LBA = LBA + clsDir.Files.BlocksJoliet

    For i = 0 To clsDir.SubDirectoryCount - 1
        SetDirRecordStartLBAJoliet clsDir.SubDirectory(i), LBA
    Next
End Sub

' set the LBA of directory records
Private Sub SetDirRecordStartLBA( _
    clsDir As clsISODirectory, _
    LBA As Long _
)

    Dim i   As Long

    clsDir.Files.LBA = LBA
    LBA = LBA + clsDir.Files.Blocks

    For i = 0 To clsDir.SubDirectoryCount - 1
        SetDirRecordStartLBA clsDir.SubDirectory(i), LBA
    Next
End Sub

Private Function DirectoryTableAddSizesJoliet( _
    clsDir As clsISODirectory _
) As Long

    Dim lngBytes    As Long
    Dim lngPSize    As Long
    Dim i           As Long

    ' "." and ".."
    lngBytes = RecordSizeDirRecord(1) * 2

    For i = 0 To clsDir.Files.Count - 1
        lngPSize = RecordSizeDirRecord(LenB(clsDir.Files.File(i).JolietName) + 1)
        If lngBytes + lngPSize > RoundBytesByBlocks(lngBytes) Then
            lngBytes = RoundBytesByBlocks(lngBytes) + lngPSize
        Else
            lngBytes = lngBytes + lngPSize
        End If
    Next

    For i = 0 To clsDir.SubDirectoryCount - 1
        lngPSize = RecordSizeDirRecord(LenB(clsDir.SubDirectory(i).JolietName) + 1)