by Friend (1 Submission)
Category: Math/Dates
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Mon 8th January 2001
Date Added: Mon 8th February 2021
Rating: (1 Votes)
file splitter/assembler
Private Sub Option1_Click()
cmdAssemble.Visible = False
cmbSize.Enabled = True
End Sub
Private Sub Option2_Click()
cmdAssemble.Visible = True
cmbSize.Enabled = False
End Sub
Private Sub cmdbrowse_Click()
Dim Ans As String
With cmopenfile
.CancelError = False
.Flags = 0
.FilterIndex = 1
.Filter = "File to split (*.*) *.* File to combine (*.000) *.000"
End With
cmopenfile.ShowOpen
Ans = cmopenfile.Filename
If Ans <> "" Then
txtFileName.Text = Ans
End If
End Sub
Private Sub cmdSplit_Click()
If Not CheckForFile Then Exit Sub
If SplitFile(txtFileName.Text, cmbSize.ItemData(cmbSize.ListIndex)) Then
MsgBox "File was split!"
Else
MsgBox "Error splitting file..."
End If
End Sub
Private Sub cmdAssemble_Click()
If Not CheckForFile Then Exit Sub
If (Right$(txtFileName.Text, 3)) <> "000" Then
MsgBox "That's not the proper extension For a split file. It should be something like Myfile.000, the first file of the split files.", 16, "No go !"
Exit Sub
End If
If AssembleFile(txtFileName.Text) Then
MsgBox "File assembled!"
Else
MsgBox "Error assembeling file..."
End If
End Sub
Private Sub cmdExit_Click()
Unload Me
End
End Sub
Private Sub Form_Load()
txtFileName.Text = ""
cmbSize.AddItem "16 Kb"
cmbSize.ItemData(cmbSize.NewIndex) = 16
cmbSize.AddItem "32 Kb"
cmbSize.ItemData(cmbSize.NewIndex) = 32
cmbSize.AddItem "64 Kb"
cmbSize.ItemData(cmbSize.NewIndex) = 64
cmbSize.AddItem "128 Kb"
cmbSize.ItemData(cmbSize.NewIndex) = 128
cmbSize.AddItem "256 Kb"
cmbSize.ItemData(cmbSize.NewIndex) = 256
cmbSize.AddItem "512 Kb"
cmbSize.ItemData(cmbSize.NewIndex) = 512
cmbSize.AddItem "720 Kb"
cmbSize.ItemData(cmbSize.NewIndex) = 720
cmbSize.AddItem "1200 Kb"
cmbSize.ItemData(cmbSize.NewIndex) = 1200
cmbSize.AddItem "1440 Kb"
cmbSize.ItemData(cmbSize.NewIndex) = 1440
cmbSize.ListIndex = cmbSize.ListCount - 1
txtFileName.Text = App.Path
End Sub
Function CheckForFile() As Boolean
txtFileName.Text = Trim(txtFileName.Text)
CheckForFile = False
If txtFileName.Text = "" Then
MsgBox "Please Select a file.", 16, "No file selected"
Exit Function
End If
If Dir(txtFileName.Text, vbNormal) = "" Then
MsgBox "The file '" & txtFileName.Text & "' was not found!", 16, "File not exist!"
Exit Function
End If
CheckForFile = True
End Function
Function SplitFile(Filename As String, Filesize As Long) As Boolean
On Error GoTo handelsplit
Dim SizeOfFile As Long, CountFiles As Integer
Dim iNumberOfFiles As Integer, lSizeOfCurrentFile As Long
Dim sBuffer As String
Dim lEndPart As Long
Dim lSizeToSplit As Long, sHeader As String * 16
Dim iFileCounter As Integer, sNewFilename As String
If MsgBox("Continue to split file?", 4 + 32 + 256, "Split?") = vbNo Then
SplitFile = False
Exit Function
End If
Open Filename For Binary As #1
SizeOfFile = LOF(1)
lSizeToSplit = Filesize * 1024
If SizeOfFile <= lSizeToSplit Then
Close #1
SplitFile = False
MsgBox "This file is smaller than the selected split size! Why split it ?", 16, "Duh!"
Exit Function
End If
sHeader = Input(16, #1)
Close #1
If Mid(sHeader, 1, 7) = "SPLITIT" Then
MsgBox "This file is alread split!"
SplitFile = False
Exit Function
End If
Open Filename For Binary As #1
SizeOfFile = LOF(1)
lSizeToSplit = Filesize * 1024
CountFiles = 0
iNumberOfFiles = (SizeOfFile \ lSizeToSplit) + 1
sHeader = "SPLITIT" & Format$(iFileCounter, "000") & Format$(iNumberOfFiles, "000") & Right$(Filename, 3)
sNewFilename = Left$(Filename, Len(Filename) - 3) & Format$(iFileCounter, "000")
Open sNewFilename For Binary As #2
Put #2, , sHeader
lSizeOfCurrentFile = Len(sHeader)
While Not EOF(1)
Me.Caption = "File Split : " & iFileCounter & " (" & Int(lSizeOfCurrentFile / 1024) & " Kb)"
Me.Refresh
sBuffer = Input(10240, #1)
lSizeOfCurrentFile = lSizeOfCurrentFile + Len(sBuffer)
If lSizeOfCurrentFile > lSizeToSplit Then
lEndPart = Len(sBuffer) - (lSizeOfCurrentFile - lSizeToSplit) + Len(sHeader)
Put #2, , Mid$(sBuffer, 1, lEndPart)
Close #2
iFileCounter = iFileCounter + 1
sHeader = "SPLITIT" & Format$(iFileCounter, "000") & Format$(iNumberOfFiles, "000") & Right$(Filename, 3)
sNewFilename = Left$(Filename, Len(Filename) - 3) & Format$(iFileCounter, "000")
Open sNewFilename For Binary As #2
Put #2, , sHeader
Put #2, , Mid$(sBuffer, lEndPart + 1)
lSizeOfCurrentFile = Len(sHeader) + (Len(sBuffer) - lEndPart)
Else
Put #2, , sBuffer
End If
Wend
Me.Caption = "Finished"
Close #2
Close #1
SplitFile = True
Exit Function
handelsplit:
SplitFile = False
MsgBox Err.Description, 16, "Error #" & Err.Number
Exit Function
End Function
Function AssembleFile(Filename As String) As Boolean
On Error GoTo handelassemble
Dim sHeader As String * 16
Dim sBuffer As String '10Kb buffer
Dim sFileExt As String, iNumberOfFiles As Integer
Dim iCurrentFileNumber As Integer
Dim iCounter As Integer, sTempFilename As String
Dim sNewFilename As String
If MsgBox("Continue to assemble file?", 4 + 256 + 32, "Assemble?") = vbNo Then
AssembleFile = False
Exit Function
End If
Open Filename For Binary As #1
sHeader = Input(Len(sHeader), #1)
If Mid$(sHeader, 1, 7) <> "SPLITIT" Then
MsgBox "This is not a split file ;) nice try!"
AssembleFile = False
Exit Function
Else
iCurrentFileNumber = Val(Mid$(sHeader, 8, 3))
iNumberOfFiles = Val(Mid$(sHeader, 11, 3))
sFileExt = Mid$(sHeader, 14, 3)
If iCurrentFileNumber <> 0 Then
MsgBox "This is not the first file in the sequence!!! AAAGGHH!"
AssembleFile = False
Exit Function
End If
End If
Close #1
sNewFilename = Left$(Filename, Len(Filename) - 3) & sFileExt
Open sNewFilename For Binary As #2
For iCounter = 0 To iNumberOfFiles - 1
sTempFilename = Left$(Filename, Len(Filename) - 3) & Format$(iCounter, "000")
Me.Caption = "File Assemble : " & iCounter & "(" & sTempFilename & ")"
Me.Refresh
Open sTempFilename For Binary As #1
sHeader = Input(Len(sHeader), #1)
If Mid$(sHeader, 1, 7) <> "SPLITIT" Then
MsgBox "This is not a split file ;) nice try! " & sTempFilename
AssembleFile = False
Exit Function
End If
iCurrentFileNumber = Val(Mid$(sHeader, 8, 3))
If iCurrentFileNumber <> iCounter Then
MsgBox "The file '" & sTempFilename & "' is out of sequence!! AARRGHH!"
AssembleFile = False
Close #2
Close #1
Exit Function
End If
While Not EOF(1)
sBuffer = Input(10240, #1)
Put #2, , sBuffer
Wend
Close #1
Next iCounter
Close #2
Me.Caption = "Finished"
AssembleFile = True
Exit Function
handelassemble:
AssembleFile = False
MsgBox Err.Description, 16, "Error #" & Err.Number
Exit Function
End Function