Native App VB Code to split files by any size

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

' #VBIDEUtils#********************************************
' * Programmer Name  : Waty Thierry
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : waty.thierry@usa.net
' * Date             : 23/09/1999
' * Time             : 16:52
' *****************************************************
' * Comments         : Large File Splitter
' *
*****************************************************************
Option Explicit

Private Const GENERIC_WRITE = &H40000000
Private Const GENERIC_READ = &H80000000
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const CREATE_ALWAYS = 2
Private Const OPEN_ALWAYS = 4
Private Const INVALID_HANDLE_VALUE = -1

Private Declare Function ReadFile Lib "kernel32" _
    (ByVal hFile As Long, lpBuffer As Any, _
    ByVal nNumberOfBytesToRead As Long, _
    lpNumberOfBytesRead As Long, _
    ByVal lpOverlapped As Long) As Long


Private Declare Function CloseHandle Lib "kernel32" _
    (ByVal hObject As Long) As Long

Private Declare Function WriteFile Lib "kernel32" _
   (ByVal hFile As Long, lpBuffer As Any, _
    ByVal nNumberOfBytesToWrite As Long, _
    lpNumberOfBytesWritten As Long, _
    ByVal lpOverlapped As Long) As Long
    
Private Declare Function CreateFile Lib _
   "kernel32" Alias "CreateFileA" _
   (ByVal lpFileName As String, _
   ByVal dwDesiredAccess As Long, _
   ByVal dwShareMode As Long, _
   ByVal lpSecurityAttributes As Long, _
   ByVal dwCreationDisposition As Long, _
   ByVal dwFlagsAndAttributes As Long, _
   ByVal hTemplateFile As Long) As Long
   
Private Declare Function FlushFileBuffers Lib "kernel32" _
   (ByVal hFile As Long) As Long

 1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192

Public Function SplitFiles(ByVal inputFilename As String, _
     newFileSizeBytes As Long) As Boolean

'PURPOSE: Split File inputFileName into SubFiles that are
'newFileSizeBytes long.  A numeric extension, indicating the
'position of the subfile within the original file, is added
'to the name of each subfile, e.g.,

'SplitFiles("C:\MyText.txt", 1000)

'Assuming MyText.txt's size is 2500 bytes, you will
'end up with 3 files: MyText.txt.1, MyText.txt.2,
'and MyText.txt.3

Dim fReadHandle As Long
Dim fWriteHandle As Long
Dim fSuccess As Long
Dim lBytesWritten As Long
Dim lBytesRead As Long
Dim ReadBuffer() As Byte
Dim TotalCount As Long
Dim Count As Integer
Count = 1
' Resize Byte Array for Read
ReDim ReadBuffer(0 To newFileSizeBytes)

' Open Read File Handle
fReadHandle = CreateFile(inputFilename, _
   GENERIC_WRITE Or GENERIC_READ, 0, 0, OPEN_ALWAYS, _
   FILE_ATTRIBUTE_NORMAL, 0)

' If Successful read, continue
If fReadHandle <> INVALID_HANDLE_VALUE Then
   ' Read First File Block
   fSuccess = ReadFile(fReadHandle, _
       ReadBuffer(0), UBound(ReadBuffer), _
       lBytesRead, 0)

   ' Loop while not EOF
   Do While lBytesRead > 0

      ' Open Write File Handle
      If Dir(inputFilename & "." & Count) <> "" Then
         Kill inputFilename & "." & Count
      End If
      fWriteHandle = CreateFile(inputFilename & "." & Count, _
         GENERIC_WRITE Or GENERIC_READ, 0, 0, _
         OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
      ' If Successful Write, Continue
      
      If fWriteHandle <> INVALID_HANDLE_VALUE Then
         ' Write Data Block to File
         fSuccess = WriteFile(fWriteHandle, ReadBuffer(0), _
            lBytesRead, lBytesWritten, 0)
         If fSuccess <> 0 Then
            ' Required to Write to File
            fSuccess = FlushFileBuffers(fWriteHandle)
            ' Close Write File
            fSuccess = CloseHandle(fWriteHandle)
         Else
            ' On Failure Quit

            SplitFiles = False
            Exit Function
         End If
      Else
         ' On Failure Quit
         SplitFiles = False
         Exit Function
      End If
      ' Get the next Read Block
      fSuccess = ReadFile(fReadHandle, ReadBuffer(0), _
          UBound(ReadBuffer), lBytesRead, 0)
  
      ' Increment Count
      Count = Count + 1
   Loop
   ' Close Read File
   fSuccess = CloseHandle(fReadHandle)
Else
  
   SplitFiles = False
   Exit Function
End If
   SplitFiles = True

End Function

Public Function JoinFiles(ByVal inputFilename As String) As _
    Boolean

'Purpose: Rejoins files split by SplitFile Function above.


Dim fReadHandle As Long
Dim fWriteHandle As Long
Dim fSuccess As Long
Dim lBytesWritten As Long
Dim lBytesRead As Long
Dim ReadBuffer() As Byte
Dim TotalCount As Long
Dim Count As Integer
Dim FileName As String
Dim ret As Integer

' Check for existing Output File
If Dir(inputFilename) <> "" Then
   ret = MsgBox("Output file (" & inputFilename & _
     ") already exists." & vbCrLf & _
     "Are you sure you want to overwrite it?", _
    vbYesNo + vbQuestion, "Overwrite Warning")
   If ret = vbNo Then
  
      JoinFiles = False
      Exit Function
   Else
      Kill inputFilename
   End If
End If

' Determine how many split files are contained in the entire set
Count = 1
FileName = Dir(inputFilename & ".1")

'No files to join
If FileName = "" Then
   JoinFiles = False
   Exit Function
End If

Do While FileName <> ""
   Count = Count + 1
   FileName = Dir(inputFilename & "." & Count)
  Loop
TotalCount = Count - 1

'
' Open Write File Handle
fWriteHandle = CreateFile(inputFilename, _
   GENERIC_WRITE Or GENERIC_READ, 0, 0, _
   OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)

' If Successful Write, Continue
If fWriteHandle <> INVALID_HANDLE_VALUE Then

   For Count = 1 To TotalCount
      ' Open Read File Handle
      ReDim ReadBuffer(0 To FileLen(inputFilename & "." & Count))
      fReadHandle = CreateFile(inputFilename & "." & Count, _
      GENERIC_WRITE Or GENERIC_READ, 0, 0, _
      OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)

      ' If Successful read, continue
      If fReadHandle <> INVALID_HANDLE_VALUE Then
         ' Read First File Block
         fSuccess = ReadFile(fReadHandle, ReadBuffer(0), _
         UBound(ReadBuffer), lBytesRead, 0)

         ' Write Data Block to File
         fSuccess = WriteFile(fWriteHandle, ReadBuffer(0), _
         UBound(ReadBuffer), lBytesWritten, 0)
         
         If fSuccess <> 0 Then
            ' Required to Write to File
            fSuccess = FlushFileBuffers(fWriteHandle)
         Else
            ' On Failure Quit
            JoinFiles = False
            Exit Function
         End If

         fSuccess = CloseHandle(fReadHandle)

      Else
         ' On Failure Quit
    
         JoinFiles = False
         Exit Function
      End If

   Next Count
Else
   ' On Failure Quit
   JoinFiles = False
   Exit Function
End If

' Close Write File
fSuccess = CloseHandle(fWriteHandle)
JoinFiles = True

End Function