VBcoders Guest



Don't have an account yet? Register
 


Forgot Password?



file splitter/assembler

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

Rate 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




Download this snippet    Add to My Saved Code

file splitter/assembler Comments

No comments have been posted about file splitter/assembler. Why not be the first to post a comment about file splitter/assembler.

Post your comment

Subject:
Message:
0/1000 characters