'**************************************
' Name: Split any file into smaller file
'     s
' Description:This code will read any la
'     rge file and split it into smaller chunc
'     ks so you can copy to stiffy,e-mail or f
'     tp it. This code is for you out there pl
'     aying with file management etc. This cod
'     e is very basic but it does some cool th
'     ings. It will leave the source file and 
'     will create a bunch of smaller files in 
'     the same directory.. This code can be mo
'     dified to output directly to the stiffy 
'     drive if you want.
' By: Riaan Aspeling
'
' Inputs:Create a new form and drop four
'     Command Buttons on it (Command1 to Comma
'     nd4). Also drop a Textbox on it (Text1) 
'     and a Combobox (Combo1). You can (if you
'     want) place a label above the textbox an
'     d change it's caption to "Source File" a
'     nd a label above the combobox and change
'     it's caption to "Split File size".
Now copy the source into the form and the module. Run and have fun ;).
If you make a nice util With the code please send me a copy : riaana@hotmail.com
'
' Returns:Split files with extensions fr
'     om Myfile.000 to MyFile.999
'
' Assumes:If checked the split files aft
'     er I've Assembled them again with FC (Fi
'     leCompare) in binary mode and it didn't 
'     find any differences. But you should kno
'     w that you are playing with files so don
'     't delete the origanal after you've chec
'     ked that you can re-assemble it ok.
'
' Side Effects:None that I know of... Th
'     is code can be a basis for a cool util (
'     You have to e-mail me that cool util .. 
'     riaana@hotmail.com)
'
'This code is copyrighted and has' limited warranties.Please see http://w
'     ww.Planet-Source-Code.com/vb/scripts/Sho
'     wCode.asp?txtCodeId=1662&lngWId;=1'for details.'**************************************

'***********************************
'*** 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 direct
    '     ory
    
    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 di
    '     rectory
    
    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 tha
    '     n 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