Split any file into smaller files

'***********************************
'*** PASTE THIS CODE INTO A FORM ***
'***********************************
Option Explicit
Private Sub Command1_Click()
 Dim Ans As String
 Ans = GetOpenFileNameDLG("File to split *.*|*.*|File to combine *.000|*.000|", "Please select a file", "", Me.hwnd)
 If Ans <> "" Then
 Text1.Text = Ans
 End If
End Sub
Private Sub Command2_Click()
 
 'Check that somting is selected
 If Not CheckForFile Then Exit Sub
 
 'Ok split the file in the current directory
 
 If SplitFile(Text1.Text, Combo1.ItemData(Combo1.ListIndex)) Then
 MsgBox "File was split!"
 Else
 MsgBox "Error splitting file..."
 End If
 
 
End Sub
Private Sub Command3_Click()
 'Check that somting is selected
 If Not CheckForFile Then Exit Sub
 'Check to see if it is a Split file with extension "MYFILE.SP(x)"
 
 If (Right$(Text1.Text, 3)) <> "000" Then
 MsgBox "That's not the proper extension for a split file. It should be somthing like Myfile.000, the first file of the split files.", 16, "No go !"
 Exit Sub
 End If
 
 'Ok assemble the files in the current directory
 
 If AssembleFile(Text1.Text) Then
 MsgBox "File assembled!"
 Else
 MsgBox "Error assembeling file..."
 End If
End Sub
Private Sub Command4_Click()
 Unload Me
 End
End Sub
Private Sub Form_Load()
 Text1.Text = ""
 Combo1.AddItem "16 Kb"
 Combo1.ItemData(Combo1.NewIndex) = 16
 Combo1.AddItem "32 Kb"
 Combo1.ItemData(Combo1.NewIndex) = 32
 Combo1.AddItem "64 Kb"
 Combo1.ItemData(Combo1.NewIndex) = 64
 Combo1.AddItem "128 Kb"
 Combo1.ItemData(Combo1.NewIndex) = 128
 Combo1.AddItem "256 Kb"
 Combo1.ItemData(Combo1.NewIndex) = 256
 Combo1.AddItem "512 Kb"
 Combo1.ItemData(Combo1.NewIndex) = 512
 Combo1.AddItem "720 Kb"
 Combo1.ItemData(Combo1.NewIndex) = 720
 Combo1.AddItem "1200 Kb"
 Combo1.ItemData(Combo1.NewIndex) = 1200
 Combo1.AddItem "1440 Kb"
 Combo1.ItemData(Combo1.NewIndex) = 1440
 Combo1.ListIndex = Combo1.ListCount - 1
 Command1.Caption = "Browse"
 Command2.Caption = "Split File"
 Command3.Caption = "Assemble Files"
 Command4.Caption = "Cancel"
End Sub
Function CheckForFile() As Boolean
 'We don't want nasty spaces in the end
 Text1.Text = Trim(Text1.Text)
 CheckForFile = False
 'Check for text in textbox
 If Text1.Text = "" Then
 'Stop !! no text entered
 MsgBox "Please select a file first!", 16, "No file selected"
 Exit Function
 End If
 'Check if the file excists
 If Dir$(Text1.Text, vbNormal) = "" Then
 'Stop !! no file
 MsgBox "The file '" & Text1.Text & "' was not found!", 16, "File non excistend?!"
 Exit Function
 End If
 CheckForFile = True
End Function
Function SplitFile(Filename As String, Filesize As Long) As Boolean
On Error GoTo handelsplit
 
 Dim lSizeOfFile As Long, iCountFiles As Integer
 Dim iNumberOfFiles As Integer, lSizeOfCurrentFile As Long
 Dim sBuffer As String '10Kb buffer
 Dim sRemainBuffer As String, lEndPart As Long
 Dim lSizeToSplit As Long, sHeader As String * 16
 Dim iFileCounter As Integer, sNewFilename As String
 Dim lWhereInFileCounter As Long
 
 If MsgBox("Continue to split file?", 4 + 32 + 256, "Split?") = vbNo Then
 SplitFile = False
 Exit Function
 End If
 
 Open Filename For Binary As #1
 lSizeOfFile = LOF(1)
 lSizeToSplit = Filesize * 1024
 
 'Check if the file is actualy larger than the selected split size
 If lSizeOfFile <= 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
 
 'Check if file isn't alread split
 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
 lSizeOfFile = LOF(1)
 lSizeToSplit = Filesize * 1024
 
 'Write the header of the split file
 ' Signature   = "SPLITIT" = Size 7
 ' Split Number  = "xxx" = Size 3
 ' Total Number of Split Files = "xxx" = Size 3
 ' Origanal file extension = "aaa" = Size 3
 'Total of 16 for header
 
 iCountFiles = 0
 iNumberOfFiles = (lSizeOfFile \ 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 'Write the header
 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
  'Write last bit
  lEndPart = Len(sBuffer) - (lSizeOfCurrentFile - lSizeToSplit) + Len(sHeader)
  Put #2, , Mid$(sBuffer, 1, lEndPart)
  Close #2
  'Make new file
  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 'Write the header
  'Put Rest of buffer read
  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)
 
 'Check if it's a split file !!!
 If Mid$(sHeader, 1, 7) <> "SPLITIT" Then
 MsgBox "This is not a split file ;) nice try!"
 AssembleFile = False
 Exit Function
 Else
 'The first file is a split file ok
 'Read the header values
 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
 'Create the assembled file
 Open sNewFilename For Binary As #2
 
 'Assemble files
 For iCounter = 0 To iNumberOfFiles - 1
 sTempFilename = Left$(Filename, Len(Filename) - 3) & Format$(iCounter, "000")
 
 Me.Caption = "File Assemble : " & 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