clsisowriter.cls

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

        CpyMem .vol_seq_num(0), IntegerTo723(1), 4
        CpyMem .logical_block_size(0), IntegerTo723(ISO_BLOCKSIZE), 4
        CpyMem .path_table_size(0), LongTo733(PathTableBytesJoliet), 8
        CpyMem .type_l_path_table(0), PathTableLBAJoliet, 4
        CpyMem .type_m_path_table(0), SwapLong(PathTableLBAJoliet + PathTableBlocksJoliet), 4

        CpyMem .root_directory(0), udtRootDir, 34

        strSpace = Space(128)

        CpySwapBSTR StrPtr(strVolSetIDJoliet), VarPtr(.vol_set_id(0)), min(128, LenB(strVolSetIDJoliet))
        CpySwapBSTR StrPtr(strPublisherIDJoliet), VarPtr(.publisher_id(0)), min(128, LenB(strPublisherIDJoliet))
        CpySwapBSTR StrPtr(strDataPrepIDJoliet), VarPtr(.data_prep_id(0)), min(128, LenB(strDataPrepIDJoliet))
        CpySwapBSTR StrPtr(strAppIDJoliet), VarPtr(.app_id(0)), min(128, LenB(strAppIDJoliet))
        CpySwapBSTR StrPtr(strCpyFileIDJoliet), VarPtr(.cpy_file_id(0)), min(37, LenB(strCpyFileIDJoliet))
        CpySwapBSTR StrPtr(strAbstrFileIDJoliet), VarPtr(.abstr_file_id(0)), min(37, LenB(strAbstrFileIDJoliet))
        CpySwapBSTR StrPtr(strBiblFileIDJoliet), VarPtr(.bibl_file_id(0)), min(37, LenB(strBiblFileIDJoliet))

        CpyMem .vol_creation_date(0), ISODateTime(dateVolCreation), 17
        CpyMem .vol_effective_date(0), ISODateTime(CDate("00:00:00")), 17
        CpyMem .vol_expiration_date(0), ISODateTime(CDate("00:00:00")), 17
        CpyMem .vol_modification_date(0), ISODateTime(CDate("00:00:00")), 17

        .file_struct_version = 1
    End With

    FileWrite hFileOut, VarPtr(udtPVD), Len(udtPVD)
    If blnJoliet Then FileWrite hFileOut, VarPtr(udtSVD), Len(udtSVD)
    FileWrite hFileOut, VarPtr(udtTVD), Len(udtTVD)
End Sub

' copy unicode string to a pointer,
' and reverse the byte order
Private Sub CpySwapBSTR( _
    ByVal pFrom As Long, _
    ByVal pTo As Long, _
    ByVal length As Long _
)

    Dim i   As Long

    For i = 1 To length Step 2
        CpyMem ByVal pTo + 0, ByVal pFrom + 1, 1
        CpyMem ByVal pTo + 1, ByVal pFrom + 0, 1

        pFrom = pFrom + 2
        pTo = pTo + 2
    Next
End Sub

' Date for Directory Record
Private Function ISODateTimeSmall( _
    ByVal dtDate As Date _
) As ISO_DIRREC_DATETIME

    Dim udtDate As ISO_DIRREC_DATETIME

    If Year(dtDate) >= 1900 And Year(dtDate) <= 2155 Then
        udtDate.drdt_year = Year(dtDate) - 1900
        udtDate.drdt_month = Month(dtDate)
        udtDate.drdt_day = Day(dtDate)
        udtDate.drdt_hour = Hour(dtDate)
        udtDate.drdt_minute = Minute(dtDate)
        udtDate.drdt_second = Second(dtDate)
    End If

    ISODateTimeSmall = udtDate
End Function

' Date for Volume Descriptor
Private Function ISODateTime( _
    ByVal dtDate As Date _
) As ISO_DATETIME

    Dim udtDate As ISO_DATETIME

    If dtDate = "00:00:00" And Year(dtDate) = 1899 Then
        CpyMem udtDate.dt_year(0), ByVal "0000", 4
        CpyMem udtDate.dt_month(0), ByVal "00", 2
        CpyMem udtDate.dt_day(0), ByVal "00", 2
        CpyMem udtDate.dt_hour(0), ByVal "00", 2
        CpyMem udtDate.dt_minute(0), ByVal "00", 2
        CpyMem udtDate.dt_second(0), ByVal "00", 2
        CpyMem udtDate.dt_hsecond(0), ByVal "00", 2
    Else
        CpyMem udtDate.dt_year(0), ByVal CStr(Year(dtDate)), 4
        CpyMem udtDate.dt_month(0), ByVal Add0(Month(dtDate)), 2
        CpyMem udtDate.dt_day(0), ByVal Add0(Day(dtDate)), 2
        CpyMem udtDate.dt_hour(0), ByVal Add0(Hour(dtDate)), 2
        CpyMem udtDate.dt_minute(0), ByVal Add0(Minute(dtDate)), 2
        CpyMem udtDate.dt_second(0), ByVal Add0(Second(dtDate)), 2
        CpyMem udtDate.dt_hsecond(0), ByVal "00", 2
    End If

    ISODateTime = udtDate
End Function

' add leading zeroes to a string
Private Function Add0( _
    ByVal strText As String _
) As String

    If Not Left$(strText, 1) = "0" Then
        Add0 = "0" & strText
    Else
        Add0 = strText
    End If
End Function

' fill a sector in the ISO Image with null chars
Private Sub FillLastSector()
    Dim lngFPos     As Long
    Dim btEmpty()   As Byte

    lngFPos = FilePosition(hFileOut)
    lngFPos = RoundBytesByBlocks(lngFPos) - lngFPos

    ReDim btEmpty(lngFPos - 1) As Byte

    FileWrite hFileOut, VarPtr(btEmpty(0)), lngFPos
End Sub

' copy files to the ISO image
Private Sub WriteFiles( _
    clsDir As clsISODirectory _
)

    Dim i           As Long
    Dim btFile()    As Byte
    Dim hFS         As hFile

    For i = 0 To clsDir.Files.Count - 1
        RaiseEvent WritingFiles(FilePosition(hFileOut) / lngApproxImgSize * 100)

        If clsDir.Files.File(i).Size > 0 Then
            ReDim btFile(clsDir.Files.File(i).Size - 1) As Byte

            hFS = FileOpen(clsDir.Files.File(i).LocalPath, GENERIC_READ, , OPEN_EXISTING)

            If hFS.handle <> INVALID_HANDLE Then
                FileRead hFS, VarPtr(btFile(0)), clsDir.Files.File(i).Size
                FileClose hFS
            End If

            FileWrite hFileOut, VarPtr(btFile(0)), clsDir.Files.File(i).Size

            FillLastSector
        End If
    Next

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

Private Sub WriteDirectoryRecordsJoliet( _
    clsDir As clsISODirectory _
)

    Dim i           As Long
    Dim udtEntry    As ISO_DIRECTORY_RECORD
    Dim clsSubDir   As clsISODirectory

    ' .
    With udtEntry
        .length = RecordSizeDirRecord(1)
        .ext_attr_rec_len = 0

        CpyMem .extent(0), LongTo733(clsDir.Files.LBAJoliet), 8
        CpyMem .data_length(0), LongTo733(clsDir.Files.BlocksJoliet * 2048&), 8

        CpyMem .rec_date_time(0), ISODateTimeSmall(dateVolCreation), 7

        .flags = ISO_FLAG_DIRECTORY
        .file_unit_size = 0
        .interleave_gap_size = 0
        CpyMem .vol_seq_num(0), IntegerTo723(1), 4
        .file_id_len = 1

        .file_id(0) = 0
    End With

    FileWrite hFileOut, VarPtr(udtEntry), udtEntry.length

    ' ..
    With udtEntry
        .length = RecordSizeDirRecord(1)
        .ext_attr_rec_len = 0

        If Not clsDir.Parent Is Nothing Then
            CpyMem .extent(0), LongTo733(clsDir.Parent.Files.LBAJoliet), 8
            CpyMem .data_length(0), LongTo733(clsDir.Parent.Files.BlocksJoliet * 2048&), 8
        Else
            CpyMem .extent(0), LongTo733(clsDir.Files.LBAJoliet), 8
            CpyMem .data_length(0), LongTo733(clsDir.Files.BlocksJoliet * 2048&), 8
        End If

        CpyMem .rec_date_time(0), ISODateTimeSmall(dateVolCreation), 7

        .flags = ISO_FLAG_DIRECTORY
        .file_unit_size = 0
        .interleave_gap_size = 0
        CpyMem .vol_seq_num(0), IntegerTo723(1), 4
        .file_id_len = 1
        .file_id(0) = 1
    End With

    FileWrite hFileOut, VarPtr(udtEntry), udtEntry.length

    For i = 0 To clsDir.SubDirectoryCount - 1
        Set clsSubDir = clsDir.SubDirectory(i)

        With udtEntry
            .length = RecordSizeDirRecord(LenB(clsSubDir.JolietName) + 1)
            CpyMem .extent(0), LongTo733(clsSubDir.Files.LBAJoliet), 8
            CpyMem .data_length(0), LongTo733(clsSubDir.Files.BlocksJoliet * 2048&), 8
            .flags = ISO_FLAG_DIRECTORY
            .file_id_len = LenB(clsSubDir.JolietName)
            CpySwapBSTR StrPtr(clsSubDir.JolietName), _
                        VarPtr(.file_id(0)), min(256, _
                        LenB(clsSubDir.JolietName))
        End With

        If FilePosition(hFileOut) + udtEntry.length > RoundBytesByBlocks(FilePosition(hFileOut)) Then
            FillLastSector
        End If

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

    For i = 0 To clsDir.Files.Count - 1
        With udtEntry
            .length = RecordSizeDirRecord(LenB(clsDir.Files.File(i).JolietName) + 1)
            CpyMem .extent(0), LongTo733(clsDir.Files.File(i).LBA), 8
            CpyMem .data_length(0), LongTo733(clsDir.Files.File(i).Size), 8
            CpyMem .rec_date_time(0), ISODateTimeSmall(clsDir.Files.File(i).CreationDate), 7
            .flags = ISO_FLAG_FILE
            .file_id_len = LenB(clsDir.Files.File(i).JolietName)
            CpySwapBSTR StrPtr(clsDir.Files.File(i).JolietName), _
                        VarPtr(.file_id(0)), _
                        min(256, LenB(clsDir.Files.File(i).JolietName))
        End With

        If FilePosition(hFileOut) + udtEntry.length > RoundBytesByBlocks(FilePosition(hFileOut)) Then
            FillLastSector
        End If

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

    FillLastSector

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

' write directory records to the ISO image
Private Sub WriteDirectoryRecords( _
    clsDir As clsISODirectory _
)

    Dim i           As Long
    Dim udtEntry    As ISO_DIRECTORY_RECORD
    Dim clsSubDir   As clsISODirectory

    ' .
    With udtEntry
        .length = RecordSizeDirRecord(1)
        .ext_attr_rec_len = 0

        CpyMem .extent(0), LongTo733(clsDir.Files.LBA), 8
        CpyMem .data_length(0), LongTo733(clsDir.Files.Blocks * 2048&), 8

        CpyMem .rec_date_time(0), ISODateTimeSmall(dateVolCreation), 7

        .flags = ISO_FLAG_DIRECTORY
        .file_unit_size = 0
        .interleave_gap_size = 0
        CpyMem .vol_seq_num(0), IntegerTo723(1), 4
        .file_id_len = 1

        .file_id(0) = 0
    End With

    FileWrite hFileOut, VarPtr(udtEntry), udtEntry.length

    ' ..
    With udtEntry
        .length = RecordSizeDirRecord(1)
        .ext_attr_rec_len = 0

        If Not clsDir.Parent Is Nothing Then
            CpyMem .extent(0), LongTo733(clsDir.Parent.Files.LBA), 8
            CpyMem .data_length(0), LongTo733(clsDir.Parent.Files.Blocks * 2048&), 8
        Else
            CpyMem .extent(0), LongTo733(clsDir.Files.LBA), 8
            CpyMem .data_length(0), LongTo733(clsDir.Files.Blocks * 2048&), 8
        End If

        CpyMem .rec_date_time(0), ISODateTimeSmall(dateVolCreation), 7

        .flags = ISO_FLAG_DIRECTORY
        .file_unit_size = 0
        .interleave_gap_size = 0
        CpyMem .vol_seq_num(0), IntegerTo723(1), 4
        .file_id_len = 1
        .file_id(0) = 1
    End With

    FileWrite hFileOut, VarPtr(udtEntry), udtEntry.length

    ' subdirectories
    For i = 0 To clsDir.SubDirectoryCount - 1
        Set clsSubDir = clsDir.SubDirectory(i)

        With udtEntry
            .length = RecordSizeDirRecord(Len(clsSubDir.DOSName) + 1)
            CpyMem .extent(0), LongTo733(clsSubDir.Files.LBA), 8
            CpyMem .data_length(0), LongTo733(clsSubDir.Files.Blocks * 2048&), 8
            .flags = ISO_FLAG_DIRECTORY
            .file_id_len = Len(clsSubDir.DOSName)
            CpyMem .file_id(0), ByVal clsSubDir.DOSName, Len(clsSubDir.DOSName)
        End With

        If FilePosition(hFileOut) + udtEntry.length > RoundBytesByBlocks(FilePosition(hFileOut)) Then
            FillLastSector
        End If

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

    ' files
    For i = 0 To clsDir.Files.Count - 1
        With udtEntry
            .length = RecordSizeDirRecord(Len(clsDir.Files.File(i).DOSName) + 1)
            CpyMem .extent(0), LongTo733(clsDir.Files.File(i).LBA), 8
            CpyMem .data_length(0), LongTo733(clsDir.Files.File(i).Size), 8
            CpyMem .rec_date_time(0), ISODateTimeSmall(clsDir.Files.File(i).CreationDate), 7
            .flags = ISO_FLAG_FILE
            .file_id_len = Len(clsDir.Files.File(i).DOSName)
            CpyMem .file_id(0), ByVal clsDir.Files.File(i).DOSName, Len(clsDir.Files.File(i).DOSName)
        End With

        If FilePosition(hFileOut) + udtEntry.length > RoundBytesByBlocks(FilePosition(hFileOut)) Then
            FillLastSector
        End If

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

    FillLastSector

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

Private Sub WritePathTableJoliet( _
    clsDir As clsISODirectory, _
    ByVal msb As Boolean _
)

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

    With udtEntry
        .length = 1
        .ext_attr_rec_len = 0

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

        If clsDir.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(clsDir.Parent.DirectoryNumber), 2
            Else
                CpyMem .parent_dir_num(0), clsDir.Parent.DirectoryNumber, 2
            End If
        End If

        .dir_id(0) = 0
        .dir_id(1) = 0
    End With

    FileWrite hFileOut, VarPtr(udtEntry), RecordSizePathTable(1)

    i = 0
    intDirNum = 2

    Do
        If Not WritePathTableByLayerJoliet(clsDir, i, 0, msb, intDirNum) Then
            Exit Do
        End If

        i = i + 1
    Loop
End Sub

' write the path table
'
' a path table must be written 2 times,
' one of it with reversed byte order.
' Same thing for the Joliet path table.
' Makes 4 path tables.
Private Sub WritePathTable( _
    clsDir As clsISODirectory, _
    ByVal msb As Boolean _
)

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

    With udtEntry
        .length = 1
        .ext_attr_rec_len = 0

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

        If clsDir.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(clsDir.Parent.DirectoryNumber), 2
            Else
                CpyMem .parent_dir_num(0), clsDir.Parent.DirectoryNumber, 2
            End If
        End If

        .dir_id(0) = 0
        .dir_id(1) = 0
    End With

    FileWrite hFileOut, VarPtr(udtEntry), RecordSizePathTable(1)

    i = 0
    intDirNum = 2

    Do
        If Not WritePathTableByLayer(clsDir, i, 0, msb, intDirNum) Then
            Exit Do
        End If

        i = i + 1
    Loop
End Sub

Private Function WritePathTableByLayerJoliet( _
    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

    If layer_current = layer_search Then
        For i = 0 To clsDir.SubDirectoryCount - 1
            Set clsSubDir = clsDir.SubDirectory(i)

            clsSubDir.DirectoryNumber = dirnum
            dirnum = dirnum + 1

            With udtEntry