clsisowriter.cls

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

        If lngBytes + lngPSize > RoundBytesByBlocks(lngBytes) Then
            lngBytes = RoundBytesByBlocks(lngBytes) + lngPSize
        Else
            lngBytes = lngBytes + lngPSize
        End If
    Next

    clsDir.Files.BlocksJoliet = RoundBytesByBlocks(lngBytes) \ ISO_BLOCKSIZE

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

    DirectoryTableAddSizesJoliet = DirectoryTableAddSizesJoliet + clsDir.Files.BlocksJoliet
End Function

' get the size of each directory record
Private Function DirectoryTableAddSizes( _
    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(Len(clsDir.Files.File(i).DOSName) + 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(Len(clsDir.SubDirectory(i).DOSName) + 1)
        If lngBytes + lngPSize > RoundBytesByBlocks(lngBytes) Then
            lngBytes = RoundBytesByBlocks(lngBytes) + lngPSize
        Else
            lngBytes = lngBytes + lngPSize
        End If
    Next

    clsDir.Files.Blocks = RoundBytesByBlocks(lngBytes) \ ISO_BLOCKSIZE

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

    DirectoryTableAddSizes = DirectoryTableAddSizes + clsDir.Files.Blocks
End Function

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

    Dim i           As Long

    For i = 0 To clsDir.SubDirectoryCount - 1
        PathTableAddSizesJoliet = PathTableAddSizesJoliet + RecordSizePathTable(LenB(clsDir.SubDirectory(i).JolietName))
    Next

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

' get the path table's size
Private Function PathTableAddSizes( _
    clsDir As clsISODirectory _
) As Long

    Dim i           As Long

    For i = 0 To clsDir.SubDirectoryCount - 1
        PathTableAddSizes = PathTableAddSizes + RecordSizePathTable(Len(clsDir.SubDirectory(i).DOSName))
    Next

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

' Adjust filenames to Level 2 rules.
' A maximum of 31 chars are allowed for a filename,
' filenames bigger then that should end with a "~x".
' Watch out for identical entries, or identical entries
' created by adjustment.
Private Sub FilesAddDosJolNames( _
    clsDir As clsISODirectory _
)

    Dim i       As Long
    Dim j       As Long
    Dim k       As Long
    Dim lngKF   As Long
    Dim strKey  As String
    Dim strPt() As String
    Dim clsFl   As clsISOFiles

    Set clsFl = clsDir.Files

    ' do not shorten joliet names, even if the
    ' standards tell you, they can only carry 64 chars
    For i = 0 To clsFl.Count - 1
        With clsFl.File(i)
            .DOSName = UCase$(Left$(StripExtension(.name), ISO_FILENAMELEN))
            .DOSName = .DOSName & "." & UCase$(Left$(GetExtension(.name), 3))
            .JolietName = .name
        End With
    Next

    For i = 0 To clsFl.Count - 1
        strKey = Left$(clsFl.File(i).DOSName, ISO_FILENAMELEN - 2)

        lngKF = 0
        k = 1

        If Not (InStr(clsFl.File(i).DOSName, "~") > 0 And InStr(clsFl.File(i).DOSName, "~") <= ISO_FILENAMELEN) Then
            ' find the number of duplicates of strKey
            For j = 0 To clsFl.Count - 1
                If j <> i Then
                    If Left$(clsFl.File(j).DOSName, ISO_FILENAMELEN - 2) = strKey Then
                        lngKF = lngKF + 1
                    End If
                End If
            Next
        End If

        If lngKF > 0 Then
            ' found some equal keys, change them all
            For j = 0 To clsFl.Count - 1
                With clsFl.File(j)
                    If Left$(.DOSName, ISO_FILENAMELEN - 2) = strKey Then
                        strPt = Split(.DOSName, ".")

                        .DOSName = ShortDosName(strPt(0), k, lngKF + 1)

                        If UBound(strPt) = 1 Then
                            If Len(strPt(1)) > 0 Then
                                .DOSName = .DOSName & "." & strPt(1)
                            End If
                        End If

                        k = k + 1
                    End If
                End With
            Next
        Else
            ' only one key, check if it hasn't got a "~"
            If InStr(clsFl.File(i).DOSName, "~") < 1 Then
                If Len(StripExtension(clsFl.File(i).name)) > ISO_FILENAMELEN Then
                    With clsFl.File(i)
                        strPt = Split(.DOSName, ".")

                        .DOSName = ShortDosName(strPt(0), 1, 1)

                        If UBound(strPt) = 1 Then
                            If Len(strPt(1)) > 0 Then
                                .DOSName = .DOSName & "." & strPt(1)
                            End If
                        End If
                    End With
                End If
            End If
        End If
    Next

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

Private Sub PathAddDosJolNames( _
    clsDir As clsISODirectory _
)

    Dim i       As Long
    Dim j       As Long
    Dim k       As Long
    Dim maxlen  As Long
    Dim lngKF   As Long
    Dim strKey  As String

    For i = 0 To clsDir.SubDirectoryCount - 1
        With clsDir.SubDirectory(i)
            .DOSName = UCase$(Left$(.name, ISO_DIRNAMELEN))

            If InStr(.DOSName, "~") > 0 Then
                If IsNumeric(Mid$(.DOSName, InStr(.DOSName, "~") + 1)) Then
                    .DOSName = Left$(.DOSName, InStr(.DOSName, "~"))
                Else
                    If Len(.name) > ISO_DIRNAMELEN Then
                        .DOSName = Left$(.DOSName, ISO_DIRNAMELEN - 2) & "~"
                    End If
                End If
            Else
                If Len(.name) > ISO_DIRNAMELEN Then
                    .DOSName = Left$(.DOSName, ISO_DIRNAMELEN - 2) & "~"
                End If
            End If

            .JolietName = .name
            .NameValid = False
        End With
    Next

    For i = 0 To clsDir.SubDirectoryCount - 1
        strKey = clsDir.SubDirectory(i).DOSName

        lngKF = 0

        For j = 0 To clsDir.SubDirectoryCount - 1
            If i <> j Then
                If StrComp(clsDir.SubDirectory(j).DOSName, strKey, vbTextCompare) = 0 Then
                    lngKF = lngKF + 1
                End If
            End If
        Next

        If InStr(clsDir.SubDirectory(i).DOSName, "~") > 0 Then
            For k = 1 To Len(CStr(lngKF))
                For j = 0 To clsDir.SubDirectoryCount - 1
                    If i <> j Then
                        With clsDir.SubDirectory(j)
                            If Not .NameValid Then
                                If StrComp(Left$(strKey, Len(strKey) - k) & "~", .DOSName, vbTextCompare) = 0 Then
                                    .DOSName = strKey
                                End If
                            End If
                        End With
                    End If
                Next
            Next

            k = 1

            For j = 0 To clsDir.SubDirectoryCount - 1
                If Not clsDir.SubDirectory(j).NameValid Then
                    If Not ((j = i) And Len(clsDir.SubDirectory(i).name) <= ISO_DIRNAMELEN) Then
                        If StrComp(clsDir.SubDirectory(j).DOSName, strKey, vbTextCompare) = 0 Then
                            clsDir.SubDirectory(j).DOSName = ShortDosName(clsDir.SubDirectory(j).DOSName & " ", k, lngKF)
                            clsDir.SubDirectory(j).NameValid = True
                            k = k + 1
                        End If
                    End If
                End If
            Next
        End If
    Next

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

' align bytes to a multiple of 2048
Private Function RoundBytesByBlocks( _
    ByVal lngBytesIn As Long _
) As Long

    RoundBytesByBlocks = lngBytesIn + (ISO_BLOCKSIZE - (lngBytesIn Mod ISO_BLOCKSIZE))
End Function

Private Function OpenImage( _
    ByVal file_out As String _
) As Boolean

    hFileOut = FileOpen(file_out, GENERIC_WRITE, , CREATE_ALWAYS)
    OpenImage = hFileOut.handle <> INVALID_HANDLE
End Function

Private Function CloseImage( _
) As Boolean

    FileClose hFileOut
    CloseImage = True
End Function

Public Function SaveISO( _
    ByVal file_out As String _
) As Boolean

    Dim lngPathTableBlocks  As Long
    Dim lngPathTableBlocksJ As Long
    Dim lngPathTableBytes   As Long
    Dim lngPathTableBytesJ  As Long
    Dim lngDirTableBlocks   As Long
    Dim lngDirTableBlocksJ  As Long
    Dim lngVolSpace         As Long
    Dim intDirs             As Integer

    If Not OpenImage(file_out) Then Exit Function

    RaiseEvent BuildingFilesystem

    ' create names
    PathAddDosJolNames clsRoot
    FilesAddDosJolNames clsRoot

    ' get the path table size
    lngPathTableBytes = PathTableAddSizes(clsRoot) + RecordSizePathTable(1)

    If blnJoliet Then
        lngPathTableBytesJ = PathTableAddSizesJoliet(clsRoot) + RecordSizePathTable(1)
    End If

    lngPathTableBlocks = RoundBytesByBlocks(lngPathTableBytes) \ ISO_BLOCKSIZE
    lngPathTableBlocksJ = RoundBytesByBlocks(lngPathTableBytesJ) \ ISO_BLOCKSIZE

    ' get the directory record table size
    lngDirTableBlocks = DirectoryTableAddSizes(clsRoot)

    If blnJoliet Then
        lngDirTableBlocksJ = DirectoryTableAddSizesJoliet(clsRoot)
    End If

    ' assign directory record LBAs
    lngVolSpace = AddStartBlocks(clsRoot, _
                                 lngDirTableBlocks + lngDirTableBlocksJ, _
                                 lngPathTableBlocks)

    ' 16 empty blocks + descriptors
    WriteHeader lngVolSpace, _
                lngPathTableBytes, _
                lngPathTableBytesJ, _
                lngPathTableBlocks, _
                lngPathTableBlocksJ, _
                ISO_PATHTABLE_LBA + Abs(blnJoliet), _
                ISO_PATHTABLE_LBA + 1 + lngPathTableBlocks * 2

    ' write the path table
    RaiseEvent WritingPathTable

    clsRoot.DirectoryNumber = 1

    WritePathTable clsRoot, False
    FillLastSector
    WritePathTable clsRoot, True
    FillLastSector

    If blnJoliet Then
        WritePathTableJoliet clsRoot, False
        FillLastSector
        WritePathTableJoliet clsRoot, True
        FillLastSector
    End If

    ' write directory records
    RaiseEvent WritingDirectoryRecords
    WriteDirectoryRecords clsRoot

    If blnJoliet Then WriteDirectoryRecordsJoliet clsRoot

    ' write files
    lngApproxImgSize = ImageSize
    WriteFiles clsRoot
    lngApproxImgSize = 0

    CloseImage

    RaiseEvent WritingFinished

    SaveISO = True
End Function

Private Sub WriteHeader( _
    ByVal VolumeSpace As Long, _
    ByVal PathTableBytes As Long, _
    ByVal PathTableBytesJoliet As Long, _
    ByVal PathTableBlocks As Long, _
    ByVal PathTableBlocksJoliet As Long, _
    ByVal PathTableLBA As Long, _
    ByVal PathTableLBAJoliet As Long _
)

    Dim btEmptyBlock(ISO_BLOCKSIZE - 1) As Byte
    Dim udtPVD                          As ISO_PRIMARY_VOLUME_DESCRIPTOR
    Dim udtSVD                          As ISO_SUPPLEMENTARY_VOLUME_DESCRIPTOR
    Dim udtTVD                          As ISO_VOLUME_DESCRIPTOR_TERMINATOR
    Dim udtRootDir                      As ISO_DIRECTORY_RECORD
    Dim i                               As Long
    Dim strSpace                        As String

    ' write 16 empty blocks
    For i = 1 To 16
        FileWrite hFileOut, VarPtr(btEmptyBlock(0)), ISO_BLOCKSIZE
    Next

    ' Volume Descriptor Set Terminator
    With udtTVD
        .vol_desc_type = VD_END
        CpyMem .standard_id(0), ByVal ISO_STANDARD_ID, 5
        .vol_desc_version = 1
    End With

    ' Root Directory Record
    With udtRootDir
        .length = RecordSizeDirRecord(1)
        .ext_attr_rec_len = 0
        CpyMem .extent(0), LongTo733(clsRoot.Files.LBA), 8
        CpyMem .data_length(0), LongTo733(clsRoot.Files.Blocks * ISO_BLOCKSIZE), 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

    ' Primary Volume Descriptor
    With udtPVD
        .vol_desc_type = VD_PRIMARY
        CpyMem .standard_id(0), ByVal ISO_STANDARD_ID, 5
        .vol_desc_version = 1

        CpyMem .system_id(0), ByVal strSystemID, min(32, Len(strSystemID))
        CpyMem .volume_id(0), ByVal strVolumeID, min(32, Len(strVolumeID))

        CpyMem .vol_space_size(0), LongTo733(VolumeSpace), 8
        CpyMem .vol_set_size(0), IntegerTo723(1), 4
        CpyMem .vol_seq_num(0), IntegerTo723(1), 4
        CpyMem .logical_block_size(0), IntegerTo723(ISO_BLOCKSIZE), 4
        CpyMem .path_table_size(0), LongTo733(PathTableBytes), 8
        CpyMem .type_l_path_table(0), PathTableLBA, 4
        CpyMem .type_m_path_table(0), SwapLong(PathTableLBA + PathTableBlocks), 4

        CpyMem .root_directory(0), udtRootDir, 34

        strSpace = Space(128)

        CpyMem .vol_set_id(0), ByVal strSpace, 128
        CpyMem .vol_set_id(0), ByVal strVolSetID, min(128, Len(strVolSetID))
        CpyMem .publisher_id(0), ByVal strSpace, 128
        CpyMem .publisher_id(0), ByVal strPublisherID, min(128, Len(strPublisherID))
        CpyMem .data_prep_id(0), ByVal strSpace, 128
        CpyMem .data_prep_id(0), ByVal strDataPrepID, min(128, Len(strDataPrepID))
        CpyMem .app_id(0), ByVal strSpace, 128
        CpyMem .app_id(0), ByVal strAppID, min(128, Len(strAppID))
        CpyMem .cpy_file_id(0), ByVal strSpace, 37
        CpyMem .cpy_file_id(0), ByVal strCpyFileID, min(37, Len(strCpyFileID))
        CpyMem .abstr_file_id(0), ByVal strSpace, 37
        CpyMem .abstr_file_id(0), ByVal strAbstrFileID, min(37, Len(strAbstrFileID))
        CpyMem .bibl_file_id(0), ByVal strSpace, 37
        CpyMem .bibl_file_id(0), ByVal strBiblFileID, min(37, Len(strBiblFileID))

        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

    ' Root Directory Record for SVD
    With udtRootDir
        .length = RecordSizeDirRecord(1)
        .ext_attr_rec_len = 0
        CpyMem .extent(0), LongTo733(clsRoot.Files.LBAJoliet), 8
        CpyMem .data_length(0), LongTo733(clsRoot.Files.BlocksJoliet * ISO_BLOCKSIZE), 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

    With udtSVD
        .vol_desc_type = VD_SUPPLEMENT
        CpyMem .standard_id(0), ByVal ISO_STANDARD_ID, 5
        .vol_desc_version = 1

        .vol_flags = 0          ' only Escape Sequences from ISO 2375 (?)
        .escape_seqs(0) = &H25  ' hope that works...
        .escape_seqs(1) = &H2F
        .escape_seqs(2) = &H45

        CpySwapBSTR StrPtr(strSystemIDJoliet), VarPtr(.system_id(0)), min(32, LenB(strSystemIDJoliet))
        CpySwapBSTR StrPtr(strVolumeIDJoliet), VarPtr(.volume_id(0)), min(32, LenB(strVolumeIDJoliet))

        CpyMem .vol_space_size(0), LongTo733(VolumeSpace), 8
        CpyMem .vol_set_size(0), IntegerTo723(1), 4