10-06-2011، 10:44 AM
eng
Fa :
با سورس زیر میتونید فایلهای حتی به حجم 1 گیگابایت هم به راحتی از هم جدا کنید یه فایل رو بهم اتصال بدید در واقع همون splite file
کد پیاچپی:
More information: This snippet contains two functions: 1 to split files into smaller "sub-files", and one to join those files back to the original file. The split is based on a byte size you specify as the second parameter of the SplitFile function. Refer to the comments for an example.
با سورس زیر میتونید فایلهای حتی به حجم 1 گیگابایت هم به راحتی از هم جدا کنید یه فایل رو بهم اتصال بدید در واقع همون splite file
کد:
' #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
'Public : Www.ParsiCoders.Com
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
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
Private Sub Form_Load()
Call SplitFiles("C:\2\2.txt", "3")
End Sub