[RESOLVED] [HELP] Unicode Problem : Get File Checksum

Hey Guys,, i have coded to get file checksum with my algorithm, of course.

but, i got problem when it try to check file that have unicode filepath or unicode filename. ex. path :C:\®âHN.txt

this is some code that i have read : :duck:

1. CRC From String Module

Code:

---

Private Function BuildTable() As Boolean
    Dim intBytePos As Integer
    Dim bBitPos As Byte
   
    Const lngLimit = &HEDB88320
   
    Dim lngCRC As Long
   
    For intBytePos = 0 To 255 Step 1
        lngCRC = intBytePos
       
        For bBitPos = 0 To 7 Step 1
            If lngCRC And 1 Then
              lngCRC = (((lngCRC And &HFFFFFFFE) \ 2) And &H7FFFFFFF) Xor lngLimit
            Else
              lngCRC = ((lngCRC And &HFFFFFFFE) \ 2) And &H7FFFFFFF
            End If
        Next bBitPos
       
        lngArrayCRCByte(intBytePos) = lngCRC
    Next intBytePos
   
    BuildTable = True
End Function

Private Function CRCFromString(ByVal strBuffer As String) As String
On Error GoTo Err:
   
    Dim lngBytes As Long, CurrentByte As Byte
    Dim lngTemp, lngCRC32 As Long
   
    If Len(strBuffer) <= 0 Then GoTo Err:
   
    If Not bolTableReady Then bolTableReady = BuildTable
   
    For lngBytes = 1 To Len(strBuffer)
       
        CurrentByte = CByte(Asc(Mid$(strBuffer, lngBytes, 1)))
        lngTemp = (((lngTemp And &HFFFFFF00) \ &H100) And &HFFFFFF) Xor (lngArrayCRCByte((lngTemp And &HFF) Xor CurrentByte))
   
    Next
   
    lngCRC32 = lngTemp Xor &HFFFFFFFF
   
    CRCFromString = Right$("00000000" & Hex$(lngCRC32), 8)
   
    Exit Function
   
Err:
    CRCFromString = "00000000"

End Function

---

2. Get Checksum File

Code:

---

Private Function GetDNA(sFile As String) As String
    On Error GoTo ErrHandle
   
    Dim buff As String
    Dim cb(0 To 23) As Byte
     
    If GetInputState = 0 Then
    SetFileAtt sFile, &H80

    Open sFile For Binary Access Read As #1
        buff$ = Space$(1)
        Get #1, , buff
    Close #1
 
    Open sFile For Binary Access Read As #2
        Get #2, 512, cb(0)
        Get #2, 1024, cb(1)
        Get #2, 2048, cb(2)
        Get #2, 3000, cb(3)
        Get #2, 4096, cb(4)
        Get #2, 5000, cb(5)
        Get #2, 6000, cb(6)
        Get #2, 7000, cb(7)
        Get #2, 8192, cb(8)
        Get #2, 9000, cb(9)
        Get #2, 10000, cb(10)
        Get #2, 11000, cb(11)
        Get #2, 12288, cb(12)
        Get #2, 13000, cb(13)
        Get #2, 14000, cb(14)
        Get #2, 15000, cb(15)
        Get #2, 16384, cb(16)
        Get #2, 17000, cb(17)
        Get #2, 18000, cb(18)
        Get #2, 19000, cb(19)
        Get #2, 20480, cb(20)
        Get #2, 21000, cb(21)
        Get #2, 22000, cb(22)
        Get #2, 23000, cb(23)
    Close #2
    buff$ = cb(0)
    buff$ = buff$ & cb(1)
    buff$ = buff$ & cb(2)
    buff$ = buff$ & cb(3)
    buff$ = buff$ & cb(4)
    buff$ = buff$ & cb(5)
    buff$ = buff$ & cb(6)
    buff$ = buff$ & cb(7)
    buff$ = buff$ & cb(8)
    buff$ = buff$ & cb(9)
    buff$ = buff$ & cb(10)
    buff$ = buff$ & cb(11)
    buff$ = buff$ & cb(12)
    buff$ = buff$ & cb(13)
    buff$ = buff$ & cb(14)
    buff$ = buff$ & cb(15)
    buff$ = buff$ & cb(16)
    buff$ = buff$ & cb(17)
    buff$ = buff$ & cb(18)
    buff$ = buff$ & cb(19)
    buff$ = buff$ & cb(20)
    buff$ = buff$ & cb(21)
    buff$ = buff$ & cb(22)
    buff$ = buff$ & cb(23)
    GetDNA = CRCFromString(buff)
    Exit Function
    End If
ErrHandle:
    Close #2
    Exit Function
End Function

---

it's success when get file checksum in normal path name / file name.
where is the mistake ?

do you have any idea ?

VB file input/ouput, for the large part, is not compatible with unicode files or path names. Use APIs instead. Here is a similar topic I responded to recently, that will show how to open, read, close a file using APIs.

here is my code from my run time module

Code:

---

Public Const FILE_SHARE_READ = &H1
Public Const FILE_SHARE_WRITE = &H2
Public Const CREATE_NEW = 1
Public Const CREATE_ALWAYS = 2
Public Const OPEN_EXISTING = 3
Public Const OPEN_ALWAYS = 4
Public Const TRUNCATE_EXISTING = 5
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000

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
Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
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
Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Public Function vbCreateFile(ByVal Str1 As String) As Integer
  Dim File1 As Long

  vbCreateFile = -1

  On Error GoTo Error0000

  File1 = FreeFile
  Open Str1 For Binary Access Write As File1
  vbCreateFile = File1
Error0000:
End Function

Public Function vbOpenFile(ByVal Str1 As String) As Integer
  Dim File1 As Long

  vbOpenFile = -1

  On Error GoTo Error0000

  File1 = FreeFile
  Open Str1 For Binary Access Read As File1
  vbOpenFile = File1
Error0000:
End Function

Public Function apiCreateFile(ByVal Str1 As String) As Long
    apiCreateFile = CreateFile(Str1, GENERIC_READ + GENERIC_WRITE, 0, ByVal 0&, OPEN_ALWAYS, 0, 0)
End Function

Public Function apiOpenFile(ByVal Str1 As String) As Long
    apiOpenFile = CreateFile(Str1, GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
End Function

Public Function apiReadFile(ByVal Hwnd As Long, bBuf() As Byte, ByVal Num1 As Long) As Long
    Dim Ret As Long

    Call ReadFile(Hwnd, bBuf(0), Num1, Ret, ByVal 0&)
    apiReadFile = Ret
End Function

Public Function apiWriteFile(ByVal Hwnd As Long, bBuf() As Byte, ByVal Num1 As Long) As Long
    Dim Ret As Long

    Call WriteFile(Hwnd, bBuf(0), Num1, Ret, ByVal 0&)
    apiWriteFile = Ret
End Function

Public Function apiFileLen(ByVal Str1 As String) As Long
    Dim Hwnd As Long

    Hwnd = apiOpenFile(Str1)
    apiFileLen = GetFileSize(Hwnd, 0)
    Call CloseHandle(Hwnd)
End Function

---

you have vb function and api function
i usually try to work with api because it can be easly
converted to other languages.

whatsup, that won't work for the problem described. Your code only handles ANSI paths/filenames, not unicode.
To make it unicode compatible, CreateFileW & DeleteFileW would be required.

ok sir, thank you very much for clearing that.
BTW also thank you very much for your gdi modules,
i hope programmers start to use them.
i saw some great open source apps,
but can't handle images, especially transparent as, your modules.

nice, thank you ... i think it'll work .. :thumb: