|
-
November 22nd, 2006, 06:19 PM
#1
Reading chunks from large files
Hi, the code below works fine with files smaller than 2GB, but it also needs to be abe to handle larger files. I need to change the code to API but I have never really worked with those API before, only to get the size of files bigger than 2GB.
EOF doesn't work and I think I also need to use SetFilePointer, but it turns into a mess.
Can anyone please have a look at the code and tell what to change exactly? Thank you.
Original code:
Code:
Public Function HashFile(ByVal strFilename As String)
Dim fFile As String, sTheString As String, sTheHash As String, sFinalHash As String
Dim FF As Long, cCount As Long, cFile As Long, i As Integer
Dim b() As Byte
Const CHUNK_SIZE As Long = 9728000
Dim cCrypto As CryptKci.clsCryptoAPI
Set cCrypto = New CryptKci.clsCryptoAPI
sTheHash = ""
cFile = FileLen(strFilename)
FF = FreeFile()
ReDim b(0 To CHUNK_SIZE - 1)
Open strFilename For Binary Access Read Lock Write As #FF
Do While Not EOF(FF)
i = i + 1
If cFile < CHUNK_SIZE Then
ReDim b(0 To cFile - 1)
Get #FF, , b()
sTheString = StrConv(b(), vbUnicode)
sTheHash = sTheHash & cCrypto.CreateHash(sTheString, 2)
frmMain.txtHashSet.Text = frmMain.txtHashSet.Text & i & " - " & cCrypto.CreateHash(sTheString, 2) & " - " & cFile & vbCrLf
Exit Do
Else
Get #FF, , b()
sTheString = StrConv(b(), vbUnicode)
sTheHash = sTheHash & cCrypto.CreateHash(sTheString, 2)
frmMain.txtHashSet.Text = frmMain.txtHashSet.Text & i & " - " & cCrypto.CreateHash(sTheString, 2) & " - " & "9728000" & vbCrLf
End If
cFile = cFile - CHUNK_SIZE
DoEvents
Loop
Close #FF
sFinalHash = cCrypto.ConvertStringFromHex(sTheHash)
frmMain.txtHash.Text = cCrypto.CreateHash(sFinalHash, 2)
Set cCrypto = Nothing
End Function
New code:
Code:
Const FILE_BEGIN = 0
Const FILE_SHARE_READ = &H1
Const FILE_SHARE_WRITE = &H2
Const OPEN_EXISTING = 3
Const GENERIC_READ = &H80000000
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) 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 Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Public Function HashFile(ByVal strFilename As String)
Dim sTheString As String, sTheHash As String, sFinalHash As String
Dim i As Integer, b() As Byte
Dim hFile As Long, FileLenght As Long, Result As Long
Dim cCrypto As CryptKci.clsCryptoAPI
Set cCrypto = New CryptKci.clsCryptoAPI
Const CHUNK_SIZE As Long = 9728000
hFile = CreateFile(strFilename, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
sTheHash = ""
FileLenght = GetFileSize(hFile, 0)
SetFilePointer hFile, 0, 0, FILE_BEGIN
ReDim b(0 To CHUNK_SIZE - 1)
Do While Not EOF(hFile)
i = i + 1
If FileLenght < CHUNK_SIZE Then
ReDim b(0 To FileLenght - 1)
ReadFile hFile, b(1), UBound(b), Result, ByVal 0&
sTheString = StrConv(b(), vbUnicode)
sTheHash = sTheHash & cCrypto.CreateHash(sTheString, 2)
frmMain.txtHashSet.Text = frmMain.txtHashSet.Text & i & " - " & cCrypto.CreateHash(sTheString, 2) & " - " & FileLenght & vbCrLf
Exit Do
Else
ReadFile hFile, b(1), UBound(b), Result, ByVal 0&
sTheString = StrConv(b(), vbUnicode)
sTheHash = sTheHash & cCrypto.CreateHash(sTheString, 2)
frmMain.txtHashSet.Text = frmMain.txtHashSet.Text & i & " - " & cCrypto.CreateHash(sTheString, 2) & " - " & "9728000" & vbCrLf
End If
FileLenght = FileLenght - CHUNK_SIZE
DoEvents
Loop
sFinalHash = cCrypto.ConvertStringFromHex(sTheHash)
frmMain.txtHash.Text = cCrypto.CreateHash(sFinalHash, 2)
CloseHandle hFile
Set cCrypto = Nothing
End Function
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|