'Form Kodları
Option Explicit
Private Sub cmdSplit_Click()
Dim err_descr As String

    If Not SplitFile(txtFileName.Text, 0, err_descr, CLng(txtFileLength.Text)) Then
        MsgBox err_descr
    Else
        MsgBox "İşlem Tamamlandı. Bölme Başarılı." + Chr(10) + Chr(13) + "It's OK. It's Successful.", vbOKOnly + vbSystemModal, "Birleştir"
    End If
End Sub
Private Sub cmdUnsplit_Click()
Dim err_descr As String

    If Not ReassembleFile(txtTemplateName.Text, False, txtOutputFile.Text) Then
        MsgBox err_descr
    Else
        MsgBox "İşlem Tamamlandı. Birleştirme Başarılı." + Chr(10) + Chr(13) + "It's OK. It's Successful.", vbOKOnly + vbSystemModal, "Birleştir"
    End If
End Sub
Private Sub Combo1_Change()
txtFileLength.Text = "1457664"
End Sub
Private Sub Combo1_Click()
txtFileLength.Text = "1457664"
End Sub
Private Sub Command1_Click()
comdlg.DialogTitle = "Bölmek İçin Bir Dosya Seçiniz."
comdlg.Filter = "Çalıştırılabilir Dosyalar|*.exe|Kütüphane Dosyaları|*.dll|Visual Basic Kontrolleri|*.ocx|Metin Dosyaları|*.txt|Microsoft Word Dosyaları(DOC)|*.doc|Microsoft Excel Dosyaları(XLS)|*.xls|Bütün Dosyalar|*.*||"
comdlg.ShowOpen
txtFileName.Text = comdlg.FileName
End Sub
Private Sub Timer1_Timer()
Label3.Caption = Label3.Caption + 1
End Sub




'Modül Kodları
Option Explicit

Type FileSection
    Bytes() As Byte
    FileLen As Long
End Type
Type SectionedFile
    Files() As FileSection
    NumberOfFiles As Long
End Type
Type FileInfo
    OrigProjSize As Long
    OrigFileName As String
    FileCount As Integer
    FileStartNum As Long
End Type
Type CommReturn
    FileName As String
    Extention As String
    FilePath As String
End Type
 
Public Function Save_Load_File(ShowSave As Boolean, ComDlgCnt As CommonDialog, Filter As String, Flags As Long, DialogTitle As String, Optional FilterIndex As Long) As CommReturn
    On Error Resume Next
    ComDlgCnt.FileName = ""
    ComDlgCnt.Filter = Filter
    ComDlgCnt.Flags = Flags
    ComDlgCnt.FilterIndex = FilterIndex
    ComDlgCnt.DialogTitle = DialogTitle
    If ShowSave Then
        ComDlgCnt.ShowSave
        If Err = cdlCancel Then Exit Function
    Else
        ComDlgCnt.ShowOpen
        If Err = cdlCancel Then Exit Function
    End If
    Save_Load_File.FileName = RetFileName(ComDlgCnt.FileName)
    Save_Load_File.Extention = ReturnExtention(ComDlgCnt.FileName, False)
    Save_Load_File.FilePath = FilePath(ComDlgCnt.FileName)
End Function
Public Function ReturnExtention(FileName As String, ReturnFilename As Boolean) As String
    Dim Buffer1 As String, m_LngLoop As Long, StartPos As Long
    Buffer1 = FileName
    For m_LngLoop = 1 To Len(Buffer1)
        If Mid(Buffer1, m_LngLoop, 1) = "." Then
            StartPos = m_LngLoop
        End If
    Next m_LngLoop
    If StartPos = 0 Then ReturnExtention = ""
    If ReturnFilename = True Then
        ReturnExtention = Mid(Buffer1, 1, StartPos - 1)
    Else
        ReturnExtention = Mid(Buffer1, StartPos + 1)
    End If
End Function
Sub SplitDirName(DirName As String, Lines() As String)
'SplitDirName
'Created By Allen
    If DirName = "" Then Exit Sub
    Dim Text As String, CurNum As Long, TotalNum As Long, CurPos As Long
    Text = DirName
    CurNum = 1
    CurPos = 1
    TotalNum = GetCount(Text, "\")
    ReDim Lines(1 To TotalNum)
    Do Until CurNum = TotalNum + 1
        Lines(CurNum) = Mid(Text, 1, InStr(CurPos, Text, "\") - 1)
        Text = Mid(Text, Len(Lines(CurNum)) + 2)
        CurNum = CurNum + 1
    Loop
End Sub
Public Function GetCount(Text As String, Search As String)
    Dim CCnt As Long, m_LngLoop As Long
    For m_LngLoop = 1 To Len(Text)
        If Mid(Text, m_LngLoop, Len(Search)) = Search Then
            CCnt = CCnt + 1
        End If
    Next
    GetCount = CCnt
End Function
 Public Function FilePath(FileName As String) As String
    Dim XText As String, DFileName As String, m_LngLoop As Long, DLines() As String
    XText = FileName
    If Not Right(XText, 1) = "\" Then XText = XText & "\"
    SplitDirName CStr(XText), DLines()
    For m_LngLoop = 1 To UBound(DLines) - 1
        DFileName = DFileName & DLines(m_LngLoop) & "\"
    Next
    FilePath = DFileName
End Function
Public Function SplitFile(SplitFileName As String, BeginningNumber As Long, ReturnErrorDes As String, Optional Split As Long = 1439865) As Boolean
    Dim SaveName As String
    Dim fnum As Integer
    
    SplitFile = True 'Assume Success
    On Error GoTo CleanUp
    Dim CurrentFile As SectionedFile, m_lngNumFil As Long, m_LngLoop As Long, FilesLen As Long
    FilesLen = FileLen(SplitFileName)
    If FilesLen <= Split + 1 Then
        SplitFile = False 'If the File
        ' Name is Smaller than the Split Ratio then
        ' The Function Doesnt Need Called So it Fails.
        ReturnErrorDes = "Dosya Çok Küçük.(The file is too small for split.)"
        Exit Function
    End If
    
    fnum = FreeFile
    Open SplitFileName For Binary As fnum
        If CInt(FilesLen / Split) >= _
        FilesLen / Split Or CInt(FilesLen / Split) _
        = FilesLen / Split Then
            m_lngNumFil = CInt(FilesLen _
            / Split)  ' If VB heightened(or if they _
            were equal) the length of the file _
            divided by the total Split ratio then _
            nothing needs To Do anything.
        ElseIf CInt(FilesLen / Split) <= _
        FilesLen / Split Then
            m_lngNumFil = CInt(FilesLen / _
            Split) + 1 ' If VB Lowered The _
            Length Of the File Divided by the Total _
            Split Ratio then it Will Need To Correct _
            it.
        End If
        ReDim CurrentFile.Files(1 To m_lngNumFil)
        For m_LngLoop = 1 To m_lngNumFil - 1
            ReDim CurrentFile.Files(m_LngLoop) _
                .Bytes(1 To Split) 'Re-Define(Re _
                Dimention) the Number Of Bytes Per _
                File
            CurrentFile.Files(m_LngLoop) _
                .FileLen = UBound(CurrentFile.Files _
                (m_LngLoop).Bytes) 'Just For Reference
        Next
        For m_LngLoop = 1 To m_lngNumFil
            Get #fnum, , CurrentFile.Files(m_LngLoop) _
            .Bytes
        Next
        ReDim CurrentFile.Files(m_lngNumFil) _
            .Bytes(1 To FilesLen - ((m_lngNumFil _
            - 1) * Split)) 'ReDefine the Number of _
            bytes for the last file since in many cases _
            it will not be at the Split ratio.
        CurrentFile.NumberOfFiles = m_lngNumFil
        Get #fnum, , CurrentFile.Files(m_lngNumFil) _
        .Bytes
        CurrentFile.Files(m_lngNumFil) _
        .FileLen = UBound(CurrentFile.Files _
        (m_lngNumFil).Bytes)
    Close #fnum 'Close File
    For m_LngLoop = 1 To CurrentFile.NumberOfFiles _
    'Save What We Have Done Into Seperate Files
        SaveName = SplitFileName & "." & Format(BeginningNumber - 1 + m_LngLoop, _
        "00#")
        fnum = FreeFile
        Open SaveName For Binary As fnum
            Put #fnum, 1, CurrentFile.Files(m_LngLoop)
        Close #fnum
    Next
    Dim FileInfoFile As FileInfo
    FileInfoFile.FileCount = m_lngNumFil
    FileInfoFile.OrigFileName = SplitFileName
    FileInfoFile.OrigProjSize = FileLen(SplitFileName)
    FileInfoFile.FileStartNum = BeginningNumber
    SaveName = SplitFileName & ".tpl"
    fnum = FreeFile
    Open SaveName For Binary As #fnum
        Put #fnum, , FileInfoFile
    Close #fnum
    Exit Function
CleanUp:
    ReturnErrorDes = Err.Description
    SplitFile = False
    '©Copyright Allen Clark Copeland Jr. 1998
End Function
Public Function ReassembleFile(TemplateFileName As String, Optional UseOldFilename As Boolean = True, Optional OutPutName = "C:\Filname.Extention") As Boolean
    Dim FileInfo As FileInfo, OutName As String, _
    File As SectionedFile, m_LngLoop As Long, OpenName
    Dim fnum As Integer
    
    ReassembleFile = True
    fnum = FreeFile
    Open TemplateFileName For Binary As #fnum
        Get #fnum, , FileInfo
    Close #fnum 'Get Information on the         Previously Saved File(s)
    If UseOldFilename Then
        OutName = FileInfo.OrigFileName
    Else
        OutName = OutPutName
    End If
    ReDim File.Files(1 To FileInfo.FileCount)
    For m_LngLoop = 1 To FileInfo.FileCount
        OpenName = FileInfo.OrigFileName & "." & _
        Format((FileInfo.FileStartNum - 1 + _
        m_LngLoop), "00#")
        fnum = FreeFile
        Open OpenName For Binary As #fnum
            Get #fnum, 1, File.Files(m_LngLoop)
        Close #fnum
    Next
    fnum = FreeFile
    Open OutName For Binary As #fnum
        For m_LngLoop = 1 To FileInfo.FileCount
            Put #fnum, , File.Files(m_LngLoop).Bytes
        Next
    Close #fnum
End Function
Public Function RetFileName(Text As String)
    Dim XText As String, DLines() As String
    XText = Text
    If Not Right(XText, 1) = "\" Then XText = XText & "\"
    SplitDirName CStr(XText), DLines()
    RetFileName = DLines(UBound(DLines))
End Function