frmmain.frm

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

            Text            =   "Ready"
            TextSave        =   "Ready"
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   3069
            MinWidth        =   3069
            Text            =   "Size: 0 KB"
            TextSave        =   "Size: 0 KB"
         EndProperty
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin MSComctlLib.TabStrip tabstrip 
      Height          =   5040
      Left            =   75
      TabIndex        =   6
      Top             =   825
      Width           =   7740
      _ExtentX        =   13653
      _ExtentY        =   8890
      MultiRow        =   -1  'True
      TabFixedWidth   =   2820
      HotTracking     =   -1  'True
      TabMinWidth     =   1352
      _Version        =   393216
      BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} 
         NumTabs         =   2
         BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "Filesystem"
            Key             =   "FS"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   " Volume Descriptors"
            Key             =   "VD"
            ImageVarType    =   2
         EndProperty
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Menu mnuFile 
      Caption         =   "File"
      Visible         =   0   'False
      Begin VB.Menu mnuISOCreate 
         Caption         =   "Create ISO Image..."
      End
      Begin VB.Menu mnuS2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuPrjClear 
         Caption         =   "New project"
      End
      Begin VB.Menu mnuS3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "Exit"
      End
   End
   Begin VB.Menu mnuMenuDir 
      Caption         =   "Directory"
      Visible         =   0   'False
      Begin VB.Menu mnuDirNew 
         Caption         =   "New directory"
      End
      Begin VB.Menu mnuS4 
         Caption         =   "-"
      End
      Begin VB.Menu mnuDirRemove 
         Caption         =   "Remove"
      End
      Begin VB.Menu mnuDirRen 
         Caption         =   "Rename"
      End
   End
   Begin VB.Menu mnuMenuFiles 
      Caption         =   "Files"
      Visible         =   0   'False
      Begin VB.Menu mnuFilesRem 
         Caption         =   "Remove"
      End
      Begin VB.Menu mnuFileRen 
         Caption         =   "Rename"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' Drag'n'Drop needs its own format number to identify
' the source of the data
Private Const OLEDragDropFormatLVW  As Integer = 100

Private WithEvents clsISOWrt        As clsISOWriter
Attribute clsISOWrt.VB_VarHelpID = -1

Private Sub cboDescr_Click()
    Select Case cboDescr.ListIndex
        Case 0 ' ISO9660
            txtAppID.MaxLength = 128
            txtAppID.text = clsISOWrt.ApplicationID(False)
            txtPrepID.MaxLength = 128
            txtPrepID.text = clsISOWrt.DataPreparerID(False)
            txtPubID.MaxLength = 128
            txtPubID.text = clsISOWrt.PublisherID(False)
            txtSysID.MaxLength = 32
            txtSysID.text = clsISOWrt.SystemID(False)
            txtVolID.MaxLength = 32
            txtVolID.text = clsISOWrt.VolumeID(False)
            txtVolSetID.MaxLength = 128
            txtVolSetID.text = clsISOWrt.VolumeSetID(False)
        Case 1 ' Joliet
            txtAppID.MaxLength = 64
            txtAppID.text = clsISOWrt.ApplicationID(True)
            txtPrepID.MaxLength = 64
            txtPrepID.text = clsISOWrt.DataPreparerID(True)
            txtPubID.MaxLength = 64
            txtPubID.text = clsISOWrt.PublisherID(True)
            txtSysID.MaxLength = 16
            txtSysID.text = clsISOWrt.SystemID(True)
            txtVolID.MaxLength = 16
            txtVolID.text = clsISOWrt.VolumeID(True)
            txtVolSetID.MaxLength = 64
            txtVolSetID.text = clsISOWrt.VolumeSetID(True)
    End Select
End Sub

Private Sub clsISOWrt_BuildingFilesystem()
    sbar.Panels(1).text = "Building filesystem"
End Sub

Private Sub clsISOWrt_WritingDirectoryRecords()
    sbar.Panels(1).text = "Writing directory records"
End Sub

Private Sub clsISOWrt_WritingFiles( _
    ByVal percent As Long _
)

    sbar.Panels(1).text = "Writing files (" & percent & "%)"
End Sub

Private Sub clsISOWrt_WritingFinished()
    sbar.Panels(1).text = "Ready"
End Sub

Private Sub clsISOWrt_WritingPathTable()
    sbar.Panels(1).text = "Writing path table"
End Sub

Private Sub cmdMenu_Click()
    ' main menu
    PopupMenu mnuFile, _
              vbPopupMenuLeftButton, _
              cmdMenu.Left, _
              cmdMenu.Top + cmdMenu.Height + Screen.TwipsPerPixelY, _
              mnuISOCreate
End Sub

Private Sub cmdSetDate_Click()
    clsISOWrt.VolumeCreation = Now

    dateCreation.Year = Year(clsISOWrt.VolumeCreation)
    dateCreation.Month = Month(clsISOWrt.VolumeCreation)
    dateCreation.Day = Day(clsISOWrt.VolumeCreation)

    timeCreation.Hour = Hour(clsISOWrt.VolumeCreation)
    timeCreation.Minute = Minute(clsISOWrt.VolumeCreation)
    timeCreation.Second = Second(clsISOWrt.VolumeCreation)
End Sub

Private Sub dateCreation_Change()
    With dateCreation
        clsISOWrt.VolumeCreation = .Day & "." & .Month & "." & .Year & " " & _
                                   timeCreation.Hour & ":" & timeCreation.Minute & ":" & timeCreation.Second
    End With
End Sub

Private Sub Form_Load()
    Set clsISOWrt = New clsISOWriter

    With tvwDirs
        .Initialize
        .InitializeImageList
        .AddIcon imgs.ListImages(1).Picture.handle  ' folder icon

        .ItemHeight = 18
        .HasButtons = True
        .HasLines = True
        .HasRootLines = True
        .LabelEdit = True

        .Font.name = "Tahoma"

        .OLEDragMode = drgAutomatic
        .OLEDropMode = drpManual

        ' Root
        .AddNode Key:="\", _
                 text:="root", _
                 Image:=0, _
                 SelectedImage:=0

        .SelectedNode = .GetKeyNode("\")

        .OLEDragInsertStyle = disDropHilite
        .OLEDragAutoExpand = True
    End With

    cboDescr.ListIndex = 0

    cmdSetDate_Click
End Sub

Private Sub Form_Resize()
    On Error Resume Next

    picInfo.Left = Me.ScaleWidth - picInfo.Width

    tabstrip.Width = Me.ScaleWidth
    tabstrip.Height = Me.ScaleHeight - picHeader.Height - sbar.Height
    tabstrip.Top = picHeader.Height
    tabstrip.Left = 0

    spltMain.Top = tabstrip.ClientTop
    spltMain.Left = tabstrip.ClientLeft
    spltMain.Width = tabstrip.ClientWidth
    spltMain.Height = tabstrip.ClientHeight

    picVD.Top = tabstrip.ClientTop
    picVD.Left = tabstrip.ClientLeft
    picVD.Width = tabstrip.ClientWidth
    picVD.Height = tabstrip.ClientHeight
End Sub

Private Sub lvwFiles_AfterLabelEdit( _
    Cancel As Integer, _
    NewString As String _
)

    ' change the name of a file

    Dim clsDir  As clsISODirectory

    ' get the directory from the selected node
    Set clsDir = DirFromSelectedNode()
    If clsDir Is Nothing Then
        Cancel = 1
        Exit Sub
    End If

    ' empty filenames are ilegal
    If Trim$(NewString) = "" Then
        Cancel = 1
        Exit Sub
    End If

    clsDir.Files.File(lvwFiles.SelectedItem.index - 1).name = NewString
End Sub

Private Sub lvwFiles_MouseDown( _
    Button As Integer, _
    Shift As Integer, _
    x As Single, _
    y As Single _
)

    ' options for files
    If Button = vbRightButton Then
        PopupMenu mnuMenuFiles, _
                  vbPopupMenuRightButton, _
                  x + spltMain.CurrSplitterPos + spltMain.SplitterSize + tabstrip.ClientLeft + Screen.TwipsPerPixelX, _
                  y + tabstrip.ClientTop + Screen.TwipsPerPixelY, _
                  mnuFilesRem
    End If
End Sub

Private Sub lvwFiles_OLEDragDrop( _
    Data As MSComctlLib.DataObject, _
    Effect As Long, _
    Button As Integer, _
    Shift As Integer, _
    x As Single, _
    y As Single _
)

    Dim i           As Long
    Dim hNode       As Long
    Dim clsDir      As clsISODirectory
    Dim strFilter() As String
    Dim blnNewDirs  As Boolean

    ReDim strFilter(0) As String
    strFilter(0) = "*"

    ' files/directories were dropped from the Explorer
    If Data.GetFormat(vbCFFiles) Then
        Set clsDir = DirFromSelectedNode()
        If clsDir Is Nothing Then Exit Sub

        For i = 1 To Data.Files.Count
            If DirExists(Data.Files(i)) Then
                With clsDir.AddSubDirectory(GetFilename(Data.Files(i)))
                    ' add local directory to the image
                    .AddLocalDirectory Data.Files(i), strFilter
                End With

                ' Treeview needs to be refreshed
                blnNewDirs = True
            Else
                clsDir.Files.Add Data.Files(i)
            End If
        Next

        If blnNewDirs Then
            ' adding new nodes is faster with redrawing disabled
            tvwDirs.SetRedrawMode False
            ' rebuild the selected node
            ISOBuildTree tvwDirs.SelectedNode, clsDir
            tvwDirs.SetRedrawMode True
        End If

        ShowFilesForDir tvwDirs.SelectedNode
    End If

    sbar.Panels(2).text = "Size: " & FormatFileSize(clsISOWrt.ImageSize)
End Sub

Private Sub ISOBuildTree( _
    ByVal hNode As Long, _
    clsDir As clsISODirectory _
)

    ' build a tree from a directory in the image
    ' (recursive)

    Dim hSubNode    As Long
    Dim i           As Long

    ' first clear all subnodes of the main node
    Do
        hSubNode = tvwDirs.NodeChild(hNode)
        If hSubNode = 0 Then Exit Do
        tvwDirs.DeleteNode hSubNode
    Loop

    ' build subnodes
    For i = 0 To clsDir.SubDirectoryCount - 1
        With clsDir.SubDirectory(i)
            ISOBuildTree tvwDirs.AddNode(hNode, , .FullPath, .name, 0, 0), clsDir.SubDirectory(i)
        End With
    Next
End Sub

' return the directory for the selected node
Private Function DirFromSelectedNode( _
) As clsISODirectory

    With tvwDirs
        Set DirFromSelectedNode = clsISOWrt.DirByPath(.GetNodeKey(.SelectedNode))
    End With
End Function

Private Sub lvwFiles_OLEStartDrag( _
    Data As MSComctlLib.DataObject, _
    AllowedEffects As Long _
)

    Dim btData()    As Byte
    ReDim btData(0) As Byte

    ' only copy nodes, do not move them
    AllowedEffects = vbDropEffectCopy
    Data.SetData btData, OLEDragDropFormatLVW
End Sub

Private Sub mnuDirNew_Click()
    Dim strNewDir   As String
    Dim clsDir      As clsISODirectory
    Dim clsDirNew   As clsISODirectory

    strNewDir = InputBox("New directory's name:")
    If StrPtr(strNewDir) = 0 Then Exit Sub
    If Trim$(strNewDir) = "" Then Exit Sub

    Set clsDir = DirFromSelectedNode()
    If clsDir Is Nothing Then Exit Sub

    Set clsDirNew = clsDir.AddSubDirectory(strNewDir)
    If clsDirNew Is Nothing Then Exit Sub

    With clsDirNew
        tvwDirs.EnsureVisible tvwDirs.AddNode(tvwDirs.SelectedNode, , .FullPath, .name, 0, 0)
    End With
End Sub

Private Sub mnuDirRemove_Click()
    Dim clsDir      As clsISODirectory
    Dim i           As Long

    Set clsDir = DirFromSelectedNode()
    If clsDir Is Nothing Then Exit Sub

    If clsDir.FullPath = "\" Then Exit Sub
    If clsDir.Parent Is Nothing Then Exit Sub