Declaration
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 |
Code
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 |
Reference : http://hilite.me
https://www.freevbcode.com/ShowCode.asp?ID=449
Comment 0
No. | Subject | Author | Date | Views |
---|---|---|---|---|
6 | PDF Form With Bar-code Encoding | Jokerham | 2021.07.20 | 166 |
5 | Using GitHub from Xcode | Jokerham | 2021.02.20 | 225 |
» | VB Code to split files by any size | Jokerham | 2021.02.04 | 236 |
3 | Libraries | Jokerham | 2020.12.02 | 300 |
2 | Windows Scheduler | Jokerham | 2020.07.22 | 308 |
1 | Execute batch in background | Jokerham | 2020.06.30 | 307 |