Nullstring in Basic

[Marchert]

Guten Abend,

bei dem Versuch eine VBA-Funktion (erzeugen eines SHA-1 Hash) in Basic zu verwenden, stoße ich auf ein Problem. Die folgende Codezeile soll eine Variable mit Nullwerten (vbNullChar) vorbelegen:

Code: Alles auswählen

strHash = String(lngHashLen + 1, Chr$(0))

Das funktioniert auch in VBA:

Wert der Variablen unter VBA

vba.jpg (13.44 KiB) 814 mal betrachtet

In Basic erhalte ich dagegen eine leere Variable:

Wert der Variablen unter BASIC

basic.jpg (8.65 KiB) 814 mal betrachtet

In beiden Fällen ist "lngHashLen" 20.

Falls das ganze Modul benötigt wird, kann ich es auch posten.

Gruß
Peter

[F3K Total]

Hallo Peter,
dein Problem kann ich nicht nachvollziehen, die Funktion tut doch was sie soll:

strHash.png (21.51 KiB) 796 mal betrachtet

Gruß R

[Marchert]

Danke für Deine Antwort. Stimmt schon, wenn man sich die Länge ausgeben lässt, dann steht da etwas drin. Da hat mich der Debugger in die Irre geführt.

Trotzdem klappt die Funktion nicht. Kopiere ich sie 1:1 z. B. nach Excel, so erhalte ich einen korrekten SHA-1 Hash zurück. In Basic erhalte ich immer nur 40x die Null.

Nach dem die nächste Zeile, in welcher der eigentliche Hash ermittelt wird, eben diese Nuller anstatt eines Hashes zurückgegeben wird, war es für mich folgerichtig, dass es an der vermeintlichen Nichtbelegung der Variablen "strHash" liegt.

Also ich poste jetzt einmal das ganze Modul und wäre dankbar, wenn das jemand bei sich testen würde, ob es dort funktioniert. Ich arbeite hier mit OO Portable 3.2.0 Build 9483 unter Windows 7 64-bit.

Code: Alles auswählen

Option Explicit

Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" ( _
      ByRef phProv As Long, _
      ByVal pszContainer As String, _
      ByVal pszProvider As String, _
      ByVal dwProvType As Long, _
      ByVal dwFlags As Long _
   ) As Long

Private Declare Function CryptCreateHash Lib "advapi32.dll" ( _
      ByVal hProv As Long, _
      ByVal Algid As Long, _
      ByVal hSessionKey As Long, _
      ByVal dwFlags As Long, _
      ByRef phHash As Long _
   ) As Long

Private Declare Function CryptHashData Lib "advapi32.dll" ( _
      ByVal hHash As Long, _
      ByVal pbData As String, _
      ByVal dwDataLen As Long, _
      ByVal dwFlags As Long _
   ) As Long

Private Declare Function CryptDestroyHash Lib "advapi32.dll" ( _
      ByVal hHash As Long _
   ) As Long

Private Declare Function CryptReleaseContext Lib "advapi32.dll" ( _
      ByVal hProv As Long, _
      ByVal dwFlags As Long _
   ) As Long

Private Declare Function CryptGetHashParam Lib "advapi32.dll" ( _
      ByVal hHash As Long, _
      ByVal dwParam As Long, _
      ByVal pbData As String, _
      ByRef pdwDataLen As Long, _
      ByVal dwFlags As Long _
   ) As Long

Private Const SERVICE_PROVIDER As String = "Microsoft Base Cryptographic Provider v1.0"

Private Const KEY_CONTAINER As String = "MyHashKey"
Private Const PROV_RSA_FULL As Long = 1
Private Const ALG_CLASS_DATA_ENCRYPT As Long = 24576
Private Const ALG_CLASS_HASH As Long = 32768
Private Const ALG_TYPE_ANY As Long = 0
Private Const ALG_TYPE_STREAM As Long = 2048
Private Const ALG_SID_SHA As Long = 4
Private Const CALG_SHA As Long = ((ALG_CLASS_HASH Or ALG_TYPE_ANY) Or ALG_SID_SHA)
Private Const HP_HASHVAL As Long = 2

Private m_lngCryptProvider As Long

Public Function GetSHA1(ByVal strKey As String) As String
   
    Dim strHash As String
    
    On Error Resume Next
    
    ' Crpytoprovider initialisieren
    Call CryptAcquireContext(m_lngCryptProvider, KEY_CONTAINER, SERVICE_PROVIDER, PROV_RSA_FULL, 0)
    
    ' Hash ermitteln
    strHash = Str2Hex(GetPasswordHash(strKey))
    
    ' Ist der Hash nicht 40 Zeichen lang?
    If Len(strHash) <> 40 Then Exit Function
    
    ' Hash zurückgeben
    GetSHA1 = strHash
    
    ' Cryptoprovider loslassen
    Call CryptReleaseContext(m_lngCryptProvider, 0)
    
End Function

Private Function GetPasswordHash(ByVal strKey As String) As String

    Dim strHash As String
    Dim lngHashLen As Long
    Dim lngHash As Long
    
    On Error Resume Next
    
    ' Hash erzeugen
    If CryptCreateHash(m_lngCryptProvider, CALG_SHA, 0, 0, lngHash) = 0 Then Exit Function
    
    ' Daten ermitteln
    If CryptHashData(lngHash, strKey, Len(strKey), 0) = 0 Then Exit Function
    
    ' Länge des Hash ermitteln
    Call CryptGetHashParam(lngHash, HP_HASHVAL, 1, lngHashLen, 0) ' 1 = vbNull
    
    ' String auf ermittelte Länge setzen
    strHash = String(lngHashLen + 1, Chr$(0))

    ' Hash ermitteln
    If CryptGetHashParam(lngHash, HP_HASHVAL, strHash, lngHashLen, 0) = 0 Then Exit Function

    ' Hash zerstören
    If lngHash <> 0 Then Call CryptDestroyHash(lngHash)
    
    ' Hash zurückgeben
    GetPasswordHash = strHash
    
End Function '

Private Function Str2Hex(ByVal strHash As String) As String

    Dim i As Long
    
    Str2Hex = ""
    
    For i = 1 To Len(strHash) - 1
        Str2Hex = Str2Hex & Right$("0" & Hex$(Asc(Mid$(strHash, i, 1))), 2)
    Next i

End Function

Falls jemand meint, dass ich mir die Arbeit sparen kann, weil es dafür schon eine Erweiterung gibt: Ich habe sie ausprobiert und habe auch das selbe Problem wie der letzte Kommentar, dass manchmal nur 39 Stellen zurückgegeben werden.

[Marchert]

Wenn keiner mehr eine Idee hat, frage ich im englischen Forum nach.

[balu]

Hallo Marchert,

Also ich poste jetzt einmal das ganze Modul und wäre dankbar, wenn das jemand bei sich testen würde, ...

Neue und leere Datei in Calc erstellt, deinen Code kopiert und in die IDE eingefügt.
Ausführen-Button in der IDE betätigt, und nichts passiert, nicht mal ne Fehlermeldung.

... ob es dort funktioniert.

Wie soll ich dir sagen ob es funktioniert, wenn nichts passiert? Und außerdem, wo soll den etwas geschehen?
Und nun?
Was bringt dir das?

Ich arbeite hier mit OO Portable 3.2.0 Build 9483 unter Windows 7 64-bit.

Getestet unter WinXP mit OOo 3.2.1 (Festinstallation) so wie mit 3.3.0 Portable.

Wäre es nicht sinnvoller eine richtige Beispieldatei hier anzuhängen, anstatt nur uns den Code zu posten und dann sinngemäß zu sagen: "Hier habt ihr Code, und nun sieht zu." (net bös gemeint). Woher sollen wir denn wissen wie, wo und was passieren soll? Es fehlen einfach noch weitere Details und Infos, die in einer richtigen Beispieldatei von dir schon eingebaut sein könnten.



Gruß
balu