form1.frm

打包文件

      End
      Begin VB.Label Label3 
         Caption         =   "Finally, Please Enter The Path And Name of the file you wish to be created."
         Height          =   375
         Left            =   120
         TabIndex        =   21
         Top             =   120
         Width           =   5775
      End
   End
   Begin VB.Label Status 
      Caption         =   "Please Click Next To Continue"
      Height          =   495
      Left            =   120
      TabIndex        =   6
      Top             =   5880
      Width           =   6015
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command8_Click() ' Back Button
' This just switches back a screen
If Picture1.Visible = True Then
    Picture2.Visible = True
    Picture1.Visible = False
    Command8.Enabled = False
    Command9.Enabled = True
ElseIf Picture3.Visible = True Then
    Picture3.Visible = False
    Picture1.Visible = True
    Command2.Enabled = False
    Command9.Enabled = True
End If
End Sub

Private Sub Command9_Click() ' Next Button
' This just switches forward a screen
If Picture2.Visible = True Then
    Picture2.Visible = False
    Picture1.Visible = True
    Command8.Enabled = True
    If List1.ListCount = 0 Then
        Command9.Enabled = False
    Else
        Command9.Enabled = True
    End If
ElseIf Picture1.Visible = True Then
    Picture1.Visible = False
    Picture3.Visible = True
    Command9.Enabled = False
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
' Stop them from closing via the X, they HAVE to hit Cancel or End
Cancel = -1
End Sub

Private Sub Command3_Click() ' Cancel Button
End
End Sub

Private Sub Command5_Click() ' Add Button

' Show the Open Dialog
CD.ShowOpen

' Check to see if the user selected a file
If CD.filename = "" Then Exit Sub

' See if the file was already added
For i = 0 To List1.ListCount - 1
    If List1.List(i) = CD.filename Then Exit Sub
Next i

' Now we need to make sure that the file isn't empty

' If an error occurs, the file doesn't exist
On Error GoTo NoFile

' Check to see if the file has a a size of 0
If FileLen(CD.filename) <= 0 Then
    
    ' Display a Yes-No Box asking the user if he would
    ' still like to add the file even though it has no
    ' content
    retval = MsgBox("The file " & CD.filename & " has a zero Byte length (Its Empty)!" & _
                    vbNewLine & "Are you Sure you want to add it?", vbYesNo, "Error")
                    
    ' User clicked No
    If retval = vbNo Then
        Exit Sub
        
    End If
End If

' Now add the file to the list boxes
List1.AddItem CD.filename
Coll.AddItem CD.FileTitle
' Enable the Next button
Command9.Enabled = True

NoFile:
End Sub

Private Sub Command6_Click() ' Remove button

' Scan through each item in the listbox to see if its selected
For i = 0 To List1.ListCount - 1
    If List1.Selected(i) Then
        ' Remove the selected Item
        List1.RemoveItem i
        Coll.RemoveItem i
        
        ' Now check to see if there are any more items in the
        ' Listboxes
        If List1.ListCount = 0 Then
            ' If there arn't, disable the Next button
            Command9.Enabled = False
        Else
            ' if there are, Enable the next button
            Command9.Enabled = True
        End If
        Exit Sub
    End If
Next i

End Sub

Private Sub Command7_Click() ' Remove all button
' Clear the listboxes, and disable the Next button
Coll.Clear
List1.Clear
Command9.Enabled = False
End Sub

Private Sub Command4_Click() ' "..." button
' Set the Filter for the commondialog
CD.Filter = "Executables (*.EXE)|*.EXE"

' Show the Save Dialog Box
CD.ShowSave

' See if the filname is valid
If CD.filename = "" Then Exit Sub
Text3.Text = CD.filename
End Sub

Private Sub Text3_Change()

' Check to see if the last 3 digits of the file they type
' is a valid Executable
If UCase(Right(Text3.Text, 4)) = ".EXE" Then
    ' Enable the Finish Button
    Command2.Enabled = True
Else
    ' Disable The Finish Button
    Command2.Enabled = False
End If
End Sub

Private Sub Command2_Click() ' Finish/End Buttons
Dim MyString As String, Dat As String, Starting As Boolean, LenNow As String

' Disable all of the command buttons
Command2.Enabled = False
Command3.Enabled = False
Command8.Enabled = False
Command9.Enabled = False

' Check to see if the user wants to quit!
If Command2.Caption = "&End" Then End

' Add the Number of files to MyString
MyString$ = vbNewLine & "-=#NOOFFILES#=-" & vbNewLine & List1.ListCount & _
            vbNewLine & "-=#FILNAME#=-" & vbNewLine

' Add the filenames to MyString
For i = 0 To List1.ListCount - 1
    MyString$ = MyString & Coll.List(i) & vbNewLine
Next i

' Create the compressed files
For i = 0 To List1.ListCount - 1
    Status.Caption = "Compressing " & List1.List(i)
    DoEvents
    Open List1.List(i) For Binary As #1
        Dat$ = Input(LOF(1), #1)
        Dat$ = HuffmanEncode(Dat$, False)
    Close #1
    Status.Caption = List1.List(i) & " was successfully compressed."
    Open List1.List(i) & "_" For Binary As #1
        Put #1, , Dat$
    Close #1
Next i

' Add the Length of each file to MyString
MyString$ = MyString$ & "-=#LOFS#=-" & vbNewLine
LenNow = 0
For i = 0 To List1.ListCount - 1
    MyString$ = MyString & FileLen(List1.List(i) & "_") & vbNewLine
    LenNow = LenNow + FileLen(List1.List(i))
Next i
MyString = MyString & "-=#SELFEXTRACT#=-" & vbNewLine

' Copy the original EXE (SE.dat) to the specified location
FileCopy App.Path & "\dat\SE.dat", Text3.Text

' Open the destination file
Open Text3.Text For Binary As #2

' Write the header to the destination file
Put #2, LOF(2) + 1, MyString$

' Open each file to be added individualy
For i = 0 To List1.ListCount - 1
    Open List1.List(i) & "_" For Binary As #1
        PG.Max = LOF(1)
        PG.Visible = True
        Status.Caption = "Adding " & List1.List(i) & "..."
        Do
            ' Find how much of the file is left
            a = LOF(1)
            b = Loc(1)
            PG.Value = b
            c = a - b
            ' See if the chunk to be taken is less that 5KB
            If c <= 5000 Then
                ' Get the c-size chunk from the file
                Dat$ = Input(c, #1)
                
                ' Write it to the destination file
                Put #2, LOF(2) + 1, Dat$
                GoTo DoneThatOne
            Else
                ' Get 1KB from the file
                Dat$ = Input(5000, #1)
                
                ' Write that chunk to the destination file
                Put #2, LOF(2) + 1, Dat$
            End If
        Loop
        
DoneThatOne:

    Close #1
Next i
PG.Visible = False
Dat = ""

' Now all the files are done...close the destination file
Close #2

Status.Caption = Text3.Text & " was created successfully!"

' That wasn't too hard was it?

' Kill all of the compressed files
For i = 0 To List1.ListCount - 1
    Kill List1.List(i) & "_"
Next i

' Change to the finishing screen
Picture3.Visible = False
Picture4.Visible = True

' Inform the user that the file is complete
Label14.Caption = "Your file (" & Text3.Text & ") was successfully created!" & vbNewLine & vbNewLine & _
"Total File(s) size was: " & LenNow & vbNewLine & vbNewLine & _
"Self Extractor Size: " & FileLen(Text3.Text) & vbNewLine & vbNewLine & _
"Compression Rate: " & Format$(CSng(LenNow - FileLen(Text3.Text)) / CSng(LenNow), _
"0.00%") & "."
' Prepare for shutdown
Command2.Caption = "&End"
Command2.Enabled = True
Command3.Enabled = False
Command8.Enabled = False
Command9.Enabled = False

End Sub