VB icon

Split any file into smaller files

Email
Submitted on: 1/2/2015 3:42:00 AM
By: Riaan Aspeling (from psc cd)  
Level: Not Given
User Rating: By 101 Users
Compatibility: VB 5.0, VB 6.0
Views: 3687
 
     This code will read any large file and split it into smaller chuncks so you can copy to stiffy,e-mail or ftp it. This code is for you out there playing with file management etc. This code is very basic but it does some cool things. It will leave the source file and will create a bunch of smaller files in the same directory.. This code can be modified to output directly to the stiffy drive if you want.
 

Windows API/Global Declarations:

Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
'**************************************
'Windows API/Global Declarations for :Split any file into smaller files
'**************************************
'*************************************
'*** PASTE THIS CODE INTO A MODULE ***
'*************************************
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
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: Split any file into smaller files
' Description:This code will read any large file and split it into smaller chuncks so you can copy to stiffy,e-mail or ftp it. This code is for you out there playing with file management etc. This code is very basic but it does some cool things. It will leave the source file and will create a bunch of smaller files in the same directory.. This code can be modified to output directly to the stiffy drive if you want.
' By: Riaan Aspeling (from psc cd)
'
' Inputs:Create a new form and drop four Command Buttons on it (Command1 to Command4). Also drop a Textbox on it (Text1) and a Combobox (Combo1). You can (if you want) place a label above the textbox and change it's caption to "Source File" and 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 from Myfile.000 to MyFile.999
'
' Assumes:If checked the split files after I've Assembled them again with FC (FileCompare) in binary mode and it didn't find any differences. But you should know that you are playing with files so don't delete the origanal after you've checked that you can re-assemble it ok.
'
' Side Effects:None that I know of... This code can be a basis for a cool util (You have to e-mail me that cool util .. riaana@hotmail.com)
'**************************************

'***********************************
'*** 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


Other 13 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Not Given category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.