SplittingFile

Function Find_And_Replace(ByRef TextLine As String, _
        ByRef SourceStr As String, _
        ByRef ReplaceStr As String) As String
    On Error Goto handelfindandreplace
    Dim DoAnother As Boolean, PosFound As Integer, ReturnStr As String
    DoAnother = True
    ReturnStr = TextLine
    While DoAnother
        PosFound = InStr(1, ReturnStr, SourceStr)
        If PosFound > 0 Then
            ReturnStr = Mid$(ReturnStr, 1, PosFound - 1) & _
                ReplaceStr & Mid$(ReturnStr, PosFound + Len(SourceStr))
        Else
            DoAnother = False
        End If
    Wend
    Find_And_Replace = ReturnStr
    handelfindandreplace:
    Exit Function
End Function

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

Option Explicit
Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Declare Function GetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Public Type SHITEMID
mkidcb As Long
abID As Byte
End Type
Public Type ITEMIDLIST
idlmkid As SHITEMID
End Type
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
Public Const BIF_RETURNONLYFSDIRS = &H1
Function GetOpenFileNameDLG(Filter As String, Title As String, _
DefaultExt As String, WindowHnd As Long) As String
On Error Goto handelopenfile
Dim OpenFile As OPENFILENAME, Tempstr As String
Dim Success As Long, FileTitleLength%
Filter = Find_And_Replace(Filter, "|", Chr(0))
If Right$(Filter, 1) <> Chr(0) Then Filter = Filter & Chr(0)
OpenFile.lStructSize = Len(OpenFile)
OpenFile.hwndOwner = WindowHnd
OpenFile.hInstance = App.hInstance
OpenFile.lpstrFilter = Filter
OpenFile.nFilterIndex = 1
OpenFile.lpstrFile = String(257, 0)
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
OpenFile.lpstrTitle = Title
OpenFile.lpstrDefExt = DefaultExt
OpenFile.flags = 0
Success = GetOpenFileName(OpenFile)
If Success = 0 Then
GetOpenFileNameDLG = ""
Else
Tempstr = OpenFile.lpstrFile
GetOpenFileNameDLG = Trim(Tempstr)
End If
Exit Function
handelopenfile:
MsgBox Err.Description, 16, "Error " & Err.Number
Exit Function
End Function

Function Find_And_Replace(ByRef TextLine As String, _
ByRef SourceStr As String, _
ByRef ReplaceStr As String) As String
On Error Goto handelfindandreplace
Dim DoAnother As Boolean, PosFound As Integer, ReturnStr As String
DoAnother = True
ReturnStr = TextLine
While DoAnother
PosFound = InStr(1, ReturnStr, SourceStr)
If PosFound > 0 Then
ReturnStr = Mid$(ReturnStr, 1, PosFound - 1) & _
ReplaceStr & Mid$(ReturnStr, PosFound + Len(SourceStr))
Else
DoAnother = False
End If
Wend
Find_And_Replace = ReturnStr
handelfindandreplace:
Exit Function
End Function

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