Access-o-Mania

Hallo zusammen,

ich hoffe ihr könnt mir einen Tipp geben bei meinem Problem.

Hier schonmal der Code:

Function GetHash(baData() As Byte, ByVal eType As UcsHashAlgorithmType) _
         As String
  Dim hBaseProvider As LongPtr
  Dim hHash    As LongPtr
  Dim lSize    As LongPtr
  Dim baBuffer() As Byte
  Dim lIdx     As Integer

  If CryptAcquireContext(hBaseProvider, 0, StrPtr(MS_DEFAULT_PROVIDER), _
                         PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) <> 0 Then
    If CryptCreateHash(hBaseProvider, eType, 0, 0, hHash) <> 0 Then
      If CryptHashData(hHash, baData(0), UBound(baData) + 1, 0) <> 0 Then
        If CryptGetHashParam(hHash, HP_HASHSIZE, lSize, 4, 0) <> 0 Then
          ReDim baBuffer(0 To lSize - 1) As Byte
          If CryptGetHashParam(hHash, HP_HASHVAL, baBuffer(0), lSize, 0) _
             <> 0 Then
            For lIdx = 0 To UBound(baBuffer)
              GetHash = GetHash & Right$("0" & Hex(baBuffer(lIdx)), 2)
            Next lIdx
          End If
        End If
      End If
      Call CryptDestroyHash(hHash)
    End If
    Call CryptReleaseContext(hBaseProvider, 0)
  End If
End Function

Ich muss dazu sagen, das ich iwann diesen Code bekommen hatte und der Teil einer Benutzersteuerung ist.

Speziell der Teil, soll die Eingaben Decodieren der Name des Modules lauter "EncodDecodePW".

Ich habe versucht nach gefunden Vorgaben, folgende Änderungen durch zu führen:

- alle Datentypen von Long auf LongPtr geändert
- Declare Function über eine #If VBA7 Abfrage ggf. zu Declare PtrSafe Function zu ändern.

Mit dem Kompilieren bin ich dann meinen Code durch gegangen und habe alles bereinigt bis auf die eine Stelle:

ReDim baBuffer(0 To lSize - 1) As Byte     

Hier hat er ein Problem mit dem "-" es kommt der Fehler: Typen unverträglich

Wenn meine mittelmäßigen Kenntnisse nicht falsch sind, kann er von LongPtr nichts abziehen?

Ich habe auch gesehen, das eben baBuffer vom Type Byte ist und wenn ich lSize als Integer setze, mosert der Kompilierer nicht mehr, aber steigt dann eine Zeile Später aus bei:

If CryptGetHashParam(hHash, HP_HASHVAL, baBuffer(0), lSize, 0) _

Das seltsame war, zuvor ging alles bei 32Bit super wo es als Long deklariert war jetzt mit LongPtr stört es auf einmal.

Ich hoffe, ich konnte mein Problem schildern und brauche dringend eure Hilfe.

Bei Fragen werde ich versuchen bestmöglichst zu Antworten.

Vielen Dank

Zitat von: Hias90 am Juni 30, 2023, 09:35:23Ich habe versucht nach gefunden Vorgaben, folgende Änderungen durch zu führen:

- alle Datentypen von Long auf LongPtr geändert

Das ist so pauschal aber nicht richtig. Du musst nur die Deklarationen ändern, die tatsächlich LongPtr sind.
Das Argument pdwDataLen für CryptGetHashParam ist ein DWORD und somit auch auf der 64bit-Plattform ein Long.

Zitat von: Hias90 am Juni 30, 2023, 09:35:23ReDim baBuffer(0 To lSize - 1) As Byte     

Hier hat er ein Problem mit dem "-" es kommt der Fehler: Typen unverträglich

Es ist kein Problem von einem LongPtr (Long oder LongLong) eine Ganzzahl abzuziehen. Es könnte aber sein, dass die Deklaration des Array mit einem LongLong als Obergrenze nicht zulässig ist. - Ich habe gerade keine 64bit Installation im direkten Zugriff um das zu testen.

Zitat von: PhilS am Juni 30, 2023, 12:01:37Es könnte aber sein, dass die Deklaration des Array mit einem LongLong als Obergrenze nicht zulässig ist.

Genau so ist es.

Hallo,

konnte leider jetzt erst die Vorschläge testen.

Hab nochmal alles zurück gesetzt auf Long und nur die Funktionen mit einer Abfrage nach VBA7 und Win64 mit PtrSafe ergänzt.

Jetzt bekomme ich ein Problem mit der Funktion StrPtr (Typen unverträglich).

Ich komme einfach nicht dahinter, wie ich das abstellen kann =(.


Hier nochmal der Code, so wie er jetzt ist:

Option Compare Database
Option Explicit

Public GlobalUsername As String
Public Zwischenspeicher As String
'Public pubEQnummerID_f As Long
'Public pubEQnummer As String
'Public pubKstID_f As Long
'Public pubBnummer As String
'Public pubArtikelID As Long
'Public pubArtikelID_f As Long
'Public pubAnlageID As Long
Public GlobalerStatus As Long

'von Nouba - www.office-loesung.de
'-- für CryptAcquireContext
Public Const MS_DEFAULT_PROVIDER As String = _
        "Microsoft Base Cryptographic Provider v1.0"
Public Const PROV_RSA_FULL           As Long = 1
Public Const CRYPT_VERIFYCONTEXT     As Long = &HF0000000
'-- für CryptGetHashParam
Public Const HP_HASHVAL              As Long = 2
Public Const HP_HASHSIZE             As Long = 4

#If VBA7 Or Win64 Then
  Public Declare PtrSafe Function CryptAcquireContext Lib "Advapi32" _
          Alias "CryptAcquireContextW" ( _
          phProv As Long, ByVal pszContainer As Long, _
          ByVal pszProvider As Long, ByVal dwProvType As Long, _
          ByVal dwFlags As Long) As Long
  Public Declare PtrSafe Function CryptReleaseContext Lib "Advapi32" ( _
          ByVal hProv As Long, ByVal dwFlags As Long) As Long
  Public Declare PtrSafe Function CryptCreateHash Lib "Advapi32" ( _
          ByVal hProv As Long, ByVal AlgId As Long, _
          ByVal hKey As Long, ByVal dwFlags As Long, phHash As Long) As Long
  Public Declare PtrSafe Function CryptHashData Lib "Advapi32" ( _
          ByVal hHash As Long, pbData As Any, ByVal dwDataLen As Long, _
          ByVal dwFlags As Long) As Long
  Public Declare PtrSafe Function CryptDestroyHash Lib "Advapi32" ( _
          ByVal hHash As Long) As Long
  Public Declare PtrSafe Function CryptGetHashParam Lib "Advapi32" ( _
          ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, _
          pdwDataLen As Long, ByVal dwFlags As Long) As Long
#Else
  Public Declare Function CryptAcquireContext Lib "Advapi32" _
          Alias "CryptAcquireContextW" ( _
          phProv As Long, ByVal pszContainer As Long, _
          ByVal pszProvider As Long, ByVal dwProvType As Long, _
          ByVal dwFlags As Long) As Long
  Public Declare Function CryptReleaseContext Lib "Advapi32" ( _
          ByVal hProv As Long, ByVal dwFlags As Long) As Long
  Public Declare Function CryptCreateHash Lib "Advapi32" ( _
          ByVal hProv As Long, ByVal AlgId As Long, _
          ByVal hKey As Long, ByVal dwFlags As Long, phHash As Long) As Long
  Public Declare Function CryptHashData Lib "Advapi32" ( _
          ByVal hHash As Long, pbData As Any, ByVal dwDataLen As Long, _
          ByVal dwFlags As Long) As Long
  Public Declare Function CryptDestroyHash Lib "Advapi32" ( _
          ByVal hHash As Long) As Long
  Public Declare Function CryptGetHashParam Lib "Advapi32" ( _
          ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, _
          pdwDataLen As Long, ByVal dwFlags As Long) As Long
#End If

Public Enum UcsHashAlgorithmType
  CALG_MD5 = &H8003&
  CALG_SHA1 = &H8004&
End Enum

Function GetHash(baData() As Byte, ByVal eType As UcsHashAlgorithmType) _
         As String
  Dim hBaseProvider As Long
  Dim hHash    As Long
  Dim lSize    As Long
  Dim baBuffer() As Byte
  Dim lIdx     As Long

  If CryptAcquireContext(hBaseProvider, 0, StrPtr(MS_DEFAULT_PROVIDER), _
                         PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) <> 0 Then
    If CryptCreateHash(hBaseProvider, eType, 0, 0, hHash) <> 0 Then
      If CryptHashData(hHash, baData(0), UBound(baData) + 1, 0) <> 0 Then
        If CryptGetHashParam(hHash, HP_HASHSIZE, lSize, 4, 0) <> 0 Then
          ReDim baBuffer(0 To lSize - 1) As Byte
          If CryptGetHashParam(hHash, HP_HASHVAL, baBuffer(0), lSize, 0) _
             <> 0 Then
            For lIdx = 0 To UBound(baBuffer)
              GetHash = GetHash & Right$("0" & Hex(baBuffer(lIdx)), 2)
            Next lIdx
          End If
        End If
      End If
      Call CryptDestroyHash(hHash)
    End If
    Call CryptReleaseContext(hBaseProvider, 0)
  End If
End Function

'Sub TestHash()
'  Dim s() As Byte
'
'  s = StrConv("derArb", vbFromUnicode) '-- ==>
'  Debug.Print "MDA5:  " & GetHash(s, CALG_MD5)  '-- ==> MD5-Digest
'  Debug.Print "SHA-1: " & GetHash(s, CALG_SHA1) '-- ==> SHA1-Digest
'
'  s = "derArb"
'  Debug.Print "MDA5:  " & GetHash(s, CALG_MD5)  '-- ==> MD5-Digest
'  Debug.Print "SHA-1: " & GetHash(s, CALG_SHA1) '-- ==> SHA1-Digest
'End Sub

''TempVar-Variable "TestVariable" erstellen
'TempVars.Add "globalerBearbeiter", 0
'
''Der TempVar-Variable "TestVariable" den Wert "Test" übergeben
''TempVars("globalerBearbeiter").Value = "Test"
'
''Den Wert der TempVar-Variable "TestVariable" in einem ungebundenen Textfeld "TempVarAnzeigen" anzeigen.
''Me!TempVarAnzeigen = TempVars("TestVariable").Value


Selbst wenn ich die Zeile:

  If CryptAcquireContext(hBaseProvider, 0, StrPtr(MS_DEFAULT_PROVIDER), _
                         PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) <> 0 Then

ausblende (+ 1x End If) läuft zwar der Code durch, aber er bringt mir keinen Treffer beim eingeben meiner Anmeldedaten.

Unter Win 32 Office 2016 läuft es super, nur eben jetzt unter Win 64 und Office 365 nicht mehr.

Zitat von: Hias90 am Juli 06, 2023, 13:42:21Hab nochmal alles zurück gesetzt auf Long und nur die Funktionen mit einer Abfrage nach VBA7 und Win64 mit PtrSafe ergänzt.

Jetzt bekomme ich ein Problem mit der Funktion StrPtr (Typen unverträglich).

Ich komme einfach nicht dahinter, wie ich das abstellen kann =(.

Das war aber nicht mein Vorschlag!
Ich schrieb:

ZitatDu musst nur die Deklarationen ändern, die tatsächlich LongPtr sind.

Wenn du die StrPtr-Funktion verwendest, bekommst du einen LongPtr zurück, der unter 64bit ein LongLong ist und somit als Datentyp "nicht verträglich" mit dem vom dir deklarierten pszProvider As Long ist.

Hallo zusammen,

ich habe mich jetzt nochmal dran gemacht und hab immer nur das zu LongPtr, wo es ein Problem gab.

Ich fürchte meine Kenntnisse reichen nicht aus um hier wirklich weiter zu kommen.

Oder ich verstehe eure Tipps einfach nicht wirklich =(.

Jetzt bin ich wieder soweit wie oben, das er ein Problem mit dem - hat.

Wenn ich es richtig verstanden hatte, war es ja das Problem von lSize wo ich als LongPtr gesetzt habe und somit -1 nicht mehr geht.

Wenn ich aber lSize nicht als LongPtr setze, dann bekomme ich für lSize ein Problem, da dies in der Funktion zuvor auch verwendet wird und ein LongPtr dann sein muss.

Das ist ein Teufelskreis, wieso muss es nur so kompliziert sein das mit 64Bit und Office 365 zu nutzen =(.

Kann mir bitte bitte jemand helfen das in Griff zu bekommen? Brauche das echt dringend wieder =(

Hier mal der aktuelle Stand des Codes:

Option Compare Database
Option Explicit

Public GlobalUsername As String
Public Zwischenspeicher As String
'Public pubEQnummerID_f As Long
'Public pubEQnummer As String
'Public pubKstID_f As Long
'Public pubBnummer As String
'Public pubArtikelID As Long
'Public pubArtikelID_f As Long
'Public pubAnlageID As Long
Public GlobalerStatus As Long

'von Nouba - www.office-loesung.de
'-- für CryptAcquireContext
Public Const MS_DEFAULT_PROVIDER As String = _
        "Microsoft Base Cryptographic Provider v1.0"
Public Const PROV_RSA_FULL          As Long = 1
Public Const CRYPT_VERIFYCONTEXT    As Long = &HF0000000
'-- für CryptGetHashParam
Public Const HP_HASHVAL              As Long = 2
Public Const HP_HASHSIZE            As Long = 4

#If VBA7 Or Win64 Then
  Public Declare PtrSafe Function CryptAcquireContext Lib "Advapi32" _
          Alias "CryptAcquireContextW" ( _
          phProv As Long, ByVal pszContainer As Long, _
          ByVal pszProvider As Long, ByVal dwProvType As Long, _
          ByVal dwFlags As Long) As Long
  Public Declare PtrSafe Function CryptReleaseContext Lib "Advapi32" ( _
          ByVal hProv As Long, ByVal dwFlags As Long) As Long
  Public Declare PtrSafe Function CryptCreateHash Lib "Advapi32" ( _
          ByVal hProv As LongPtr, ByVal AlgId As LongPtr, _
          ByVal hKey As LongPtr, ByVal dwFlags As LongPtr, phHash As LongPtr) As LongPtr
  Public Declare PtrSafe Function CryptHashData Lib "Advapi32" ( _
          ByVal hHash As LongPtr, pbData As Any, ByVal dwDataLen As Long, _
          ByVal dwFlags As Long) As LongPtr
  Public Declare PtrSafe Function CryptDestroyHash Lib "Advapi32" ( _
          ByVal hHash As Long) As Long
  Public Declare PtrSafe Function CryptGetHashParam Lib "Advapi32" ( _
          ByVal hHash As LongPtr, ByVal dwParam As LongPtr, pbData As Any, _
          pdwDataLen As LongPtr, ByVal dwFlags As LongPtr) As LongPtr
#Else
  Public Declare Function CryptAcquireContext Lib "Advapi32" _
          Alias "CryptAcquireContextW" ( _
          phProv As Long, ByVal pszContainer As Long, _
          ByVal pszProvider As Long, ByVal dwProvType As Long, _
          ByVal dwFlags As Long) As Long
  Public Declare Function CryptReleaseContext Lib "Advapi32" ( _
          ByVal hProv As Long, ByVal dwFlags As Long) As Long
  Public Declare Function CryptCreateHash Lib "Advapi32" ( _
          ByVal hProv As Long, ByVal AlgId As Long, _
          ByVal hKey As Long, ByVal dwFlags As Long, phHash As Long) As Long
  Public Declare Function CryptHashData Lib "Advapi32" ( _
          ByVal hHash As Long, pbData As Any, ByVal dwDataLen As Long, _
          ByVal dwFlags As Long) As Long
  Public Declare Function CryptDestroyHash Lib "Advapi32" ( _
          ByVal hHash As Long) As Long
  Public Declare Function CryptGetHashParam Lib "Advapi32" ( _
          ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, _
          pdwDataLen As Long, ByVal dwFlags As Long) As Long
#End If

Public Enum UcsHashAlgorithmType
  CALG_MD5 = &H8003&
  CALG_SHA1 = &H8004&
End Enum

Function GetHash(baData() As Byte, ByVal eType As UcsHashAlgorithmType) _
        As String
  Dim hBaseProvider As LongPtr
  Dim hHash    As LongPtr
  Dim lSize    As LongPtr
  Dim baBuffer() As Byte
  Dim lIdx    As Long

'  If CryptAcquireContext(hBaseProvider, 0, StrPtr(MS_DEFAULT_PROVIDER), _
'                        PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) <> 0 Then
    If CryptCreateHash(hBaseProvider, eType, 0, 0, hHash) <> 0 Then
      If CryptHashData(hHash, baData(0), UBound(baData) + 1, 0) <> 0 Then
        If CryptGetHashParam(hHash, HP_HASHSIZE, lSize, 4, 0) <> 0 Then
          ReDim baBuffer(0 To lSize - 1) As Byte
          If CryptGetHashParam(hHash, HP_HASHVAL, baBuffer(0), lSize, 0) _
            <> 0 Then
            For lIdx = 0 To UBound(baBuffer)
              GetHash = GetHash & Right$("0" & Hex(baBuffer(lIdx)), 2)
            Next lIdx
          End If
        End If
      End If
      Call CryptDestroyHash(hHash)
    End If
    Call CryptReleaseContext(hBaseProvider, 0)
'  End If
End Function 

Zitat von: Hias90 am Juli 11, 2023, 14:43:45Oder ich verstehe eure Tipps einfach nicht wirklich =(.

Es scheint so. Ich verstehe nur nicht warum, weil die meisten doch klar formuliert waren.
Hier nochmal eine Zusammenfassung:

• Es gibt kein Problem mit dem -, sondern es ist nicht möglich ein Array mit einen LongPtr (LongLong) als Größenangabe zu deklarieren. Das ist aber kein Problem weil ....
• Das Argument pdwDataLen für CryptGetHashParam ist ein DWORD und somit auch auf der 64bit-Plattform ein Long.
• Das Argument pszProvider für die Funktion CryptAcquireContext muss ein LongPtr sein, weil du dort einen Zeiger (Pointer, Ptr) auf den String mit dem Namen des Providers übergibst.

Versuch das doch mal Schritt für Schritt umzusetzen.

Es gibt evtl. noch weitere Probleme mit den Funktionen. - Die werden aber erst zutage treten, wenn du die bisherigen Probleme behoben hast.

Hallo PhilS,

Mein Problem war, das ich das versucht hatte und dann weiter versucht habe wo Fehler kamen einfach mit LongPtr zu umgehen ect. Bis ich wieder an einem Punkt ankam.

Werde jetzt Stück für Stück machen was du meintest.

Habe meinen zuletzt geposteten Code mit deinen Hinweise angepasst.

Leider kommt wieder der Fehler bei lSize - 1.

Option Compare Database
Option Explicit

Public GlobalUsername As String
Public Zwischenspeicher As String
'Public pubEQnummerID_f As Long
'Public pubEQnummer As String
'Public pubKstID_f As Long
'Public pubBnummer As String
'Public pubArtikelID As Long
'Public pubArtikelID_f As Long
'Public pubAnlageID As Long
Public GlobalerStatus As Long

'von Nouba - www.office-loesung.de
'-- für CryptAcquireContext
Public Const MS_DEFAULT_PROVIDER As String = _
        "Microsoft Base Cryptographic Provider v1.0"
Public Const PROV_RSA_FULL           As Long = 1
Public Const CRYPT_VERIFYCONTEXT     As Long = &HF0000000
'-- für CryptGetHashParam
Public Const HP_HASHVAL              As Long = 2
Public Const HP_HASHSIZE             As Long = 4

#If VBA7 Or Win64 Then
  Public Declare PtrSafe Function CryptAcquireContext Lib "Advapi32" _
          Alias "CryptAcquireContextW" ( _
          phProv As Long, ByVal pszContainer As Long, _
          ByVal pszProvider As LongPtr, ByVal dwProvType As Long, _
          ByVal dwFlags As Long) As Long
  Public Declare PtrSafe Function CryptReleaseContext Lib "Advapi32" ( _
          ByVal hProv As Long, ByVal dwFlags As Long) As Long
  Public Declare PtrSafe Function CryptCreateHash Lib "Advapi32" ( _
          ByVal hProv As LongPtr, ByVal AlgId As LongPtr, _
          ByVal hKey As LongPtr, ByVal dwFlags As LongPtr, phHash As LongPtr) As LongPtr
  Public Declare PtrSafe Function CryptHashData Lib "Advapi32" ( _
          ByVal hHash As LongPtr, pbData As Any, ByVal dwDataLen As Long, _
          ByVal dwFlags As Long) As LongPtr
  Public Declare PtrSafe Function CryptDestroyHash Lib "Advapi32" ( _
          ByVal hHash As Long) As Long
  Public Declare PtrSafe Function CryptGetHashParam Lib "Advapi32" ( _
          ByVal hHash As LongPtr, ByVal dwParam As LongPtr, pbData As Any, _
          pdwDataLen As Long, ByVal dwFlags As LongPtr) As LongPtr
#Else
  Public Declare Function CryptAcquireContext Lib "Advapi32" _
          Alias "CryptAcquireContextW" ( _
          phProv As Long, ByVal pszContainer As Long, _
          ByVal pszProvider As Long, ByVal dwProvType As Long, _
          ByVal dwFlags As Long) As Long
  Public Declare Function CryptReleaseContext Lib "Advapi32" ( _
          ByVal hProv As Long, ByVal dwFlags As Long) As Long
  Public Declare Function CryptCreateHash Lib "Advapi32" ( _
          ByVal hProv As Long, ByVal AlgId As Long, _
          ByVal hKey As Long, ByVal dwFlags As Long, phHash As Long) As Long
  Public Declare Function CryptHashData Lib "Advapi32" ( _
          ByVal hHash As Long, pbData As Any, ByVal dwDataLen As Long, _
          ByVal dwFlags As Long) As Long
  Public Declare Function CryptDestroyHash Lib "Advapi32" ( _
          ByVal hHash As Long) As Long
  Public Declare Function CryptGetHashParam Lib "Advapi32" ( _
          ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, _
          pdwDataLen As Long, ByVal dwFlags As Long) As Long
#End If

Public Enum UcsHashAlgorithmType
  CALG_MD5 = &H8003&
  CALG_SHA1 = &H8004&
End Enum

Function GetHash(baData() As Byte, ByVal eType As UcsHashAlgorithmType) _
         As String
  Dim hBaseProvider As LongPtr
  Dim hHash    As LongPtr
  Dim lSize    As LongPtr
  Dim baBuffer() As Byte
  Dim lIdx     As Long

  If CryptAcquireContext(hBaseProvider, 0, StrPtr(MS_DEFAULT_PROVIDER), _
                         PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) <> 0 Then
    If CryptCreateHash(hBaseProvider, eType, 0, 0, hHash) <> 0 Then
      If CryptHashData(hHash, baData(0), UBound(baData) + 1, 0) <> 0 Then
        If CryptGetHashParam(hHash, HP_HASHSIZE, lSize, 4, 0) <> 0 Then
          ReDim baBuffer(0 To lSize - 1) As Byte
          If CryptGetHashParam(hHash, HP_HASHVAL, baBuffer(0), lSize, 0) _
             <> 0 Then
            For lIdx = 0 To UBound(baBuffer)
              GetHash = GetHash & Right$("0" & Hex(baBuffer(lIdx)), 2)
            Next lIdx
          End If
        End If
      End If
      Call CryptDestroyHash(hHash)
    End If
    Call CryptReleaseContext(hBaseProvider, 0)
  End If
End Function

Oder meintest du den Ursprünglichen Code (alles Long außer pszProvider):

Option Compare Database
Option Explicit

Public GlobalUsername As String
Public Zwischenspeicher As String
'Public pubEQnummerID_f As Long
'Public pubEQnummer As String
'Public pubKstID_f As Long
'Public pubBnummer As String
'Public pubArtikelID As Long
'Public pubArtikelID_f As Long
'Public pubAnlageID As Long
Public GlobalerStatus As Long

'von Nouba - www.office-loesung.de
'-- für CryptAcquireContext
Public Const MS_DEFAULT_PROVIDER As String = _
        "Microsoft Base Cryptographic Provider v1.0"
Public Const PROV_RSA_FULL           As Long = 1
Public Const CRYPT_VERIFYCONTEXT     As Long = &HF0000000
'-- für CryptGetHashParam
Public Const HP_HASHVAL              As Long = 2
Public Const HP_HASHSIZE             As Long = 4

#If VBA7 Or Win64 Then
  Public Declare PtrSafe Function CryptAcquireContext Lib "Advapi32" _
          Alias "CryptAcquireContextW" ( _
          phProv As Long, ByVal pszContainer As Long, _
          ByVal pszProvider As LongPtr, ByVal dwProvType As Long, _
          ByVal dwFlags As Long) As Long
  Public Declare PtrSafe Function CryptReleaseContext Lib "Advapi32" ( _
          ByVal hProv As Long, ByVal dwFlags As Long) As Long
  Public Declare PtrSafe Function CryptCreateHash Lib "Advapi32" ( _
          ByVal hProv As Long, ByVal AlgId As Long, _
          ByVal hKey As Long, ByVal dwFlags As Long, phHash As Long) As Long
  Public Declare PtrSafe Function CryptHashData Lib "Advapi32" ( _
          ByVal hHash As Long, pbData As Any, ByVal dwDataLen As Long, _
          ByVal dwFlags As Long) As Long
  Public Declare PtrSafe Function CryptDestroyHash Lib "Advapi32" ( _
          ByVal hHash As Long) As Long
  Public Declare PtrSafe Function CryptGetHashParam Lib "Advapi32" ( _
          ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, _
          pdwDataLen As Long, ByVal dwFlags As Long) As Long
#Else
  Public Declare Function CryptAcquireContext Lib "Advapi32" _
          Alias "CryptAcquireContextW" ( _
          phProv As Long, ByVal pszContainer As Long, _
          ByVal pszProvider As Long, ByVal dwProvType As Long, _
          ByVal dwFlags As Long) As Long
  Public Declare Function CryptReleaseContext Lib "Advapi32" ( _
          ByVal hProv As Long, ByVal dwFlags As Long) As Long
  Public Declare Function CryptCreateHash Lib "Advapi32" ( _
          ByVal hProv As Long, ByVal AlgId As Long, _
          ByVal hKey As Long, ByVal dwFlags As Long, phHash As Long) As Long
  Public Declare Function CryptHashData Lib "Advapi32" ( _
          ByVal hHash As Long, pbData As Any, ByVal dwDataLen As Long, _
          ByVal dwFlags As Long) As Long
  Public Declare Function CryptDestroyHash Lib "Advapi32" ( _
          ByVal hHash As Long) As Long
  Public Declare Function CryptGetHashParam Lib "Advapi32" ( _
          ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, _
          pdwDataLen As Long, ByVal dwFlags As Long) As Long
#End If

Public Enum UcsHashAlgorithmType
  CALG_MD5 = &H8003&
  CALG_SHA1 = &H8004&
End Enum

Function GetHash(baData() As Byte, ByVal eType As UcsHashAlgorithmType) _
         As String
  Dim hBaseProvider As Long
  Dim hHash    As Long
  Dim lSize    As Long
  Dim baBuffer() As Byte
  Dim lIdx     As Long

  If CryptAcquireContext(hBaseProvider, 0, StrPtr(MS_DEFAULT_PROVIDER), _
                         PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) <> 0 Then
    If CryptCreateHash(hBaseProvider, eType, 0, 0, hHash) <> 0 Then
      If CryptHashData(hHash, baData(0), UBound(baData) + 1, 0) <> 0 Then
        If CryptGetHashParam(hHash, HP_HASHSIZE, lSize, 4, 0) <> 0 Then
          ReDim baBuffer(0 To lSize - 1) As Byte
          If CryptGetHashParam(hHash, HP_HASHVAL, baBuffer(0), lSize, 0) _
             <> 0 Then
            For lIdx = 0 To UBound(baBuffer)
              GetHash = GetHash & Right$("0" & Hex(baBuffer(lIdx)), 2)
            Next lIdx
          End If
        End If
      End If
      Call CryptDestroyHash(hHash)
    End If
    Call CryptReleaseContext(hBaseProvider, 0)
  End If
End Function
Hier kommt erstmal keine Fehlermeldung, aber beim Eingabe des Usernamens, findet er keinen Treffer.

Der Username ist aber vorhanden und geht unter 32 Bit Office 2016 tadellos.

Hast du hier eine Idee?

Habe noch die 32Bit / 2016 Version mit der 64Bit/ 365 Version parallel im Code verglichen und bei der Zeile:

    If CryptCreateHash(hBaseProvider, eType, 0, 0, hHash) <> 0 Then

Gibt es schon den ersten Unterschied:

                                           32Bit/2016:                64Bit/365:

hBaseProvider =              241496232                -1082755856
hHash =                             286921960                0                                               
 

Zitat von: Hias90 am Juli 12, 2023, 15:07:26Leider kommt wieder der Fehler bei lSize - 1.

Wie bereits erwähnt, entsteht dieser Fehler deshalb, weil du weiterhin eine LongPtr-Variable für die Dimensionierung des Arrays verwendest.

Zitat von: Hias90 am Juli 12, 2023, 15:07:26Oder meintest du den Ursprünglichen Code (alles Long außer pszProvider):

Ich habe für die konkret genannten Funktionen/Argumente mehrfach geschrieben, was ich meine.
Alles darüber hinaus muss man einzeln anschauen und dann für jeden einzelnen Fall entweder entsprechend ändern oder nicht.

Du hast aber Glück. Die ursprünglichen Funktionen waren überschaubar und das Thema noch nicht so intensiv anderswo behandelt, deshalb habe ich den Code von Nouba, denn du verwendest überarbeitet und in folgenden Kontext zum Download bereitgestellt. ->MD5 and SHA-1 Hashes in VBA (https://codekabinett.com/rdumps.php?Lang=2&targetDoc=vba-crypto-api-hash)

@Hias90,
also wenn man sich mit solchen Aufgaben beschäftigt, muss man sich mit Grundlagen beschäftigen oder man bezahlt wenn, der bereit ist, sich Wissen anzueignen.

Hier eine perfekte Anleitung zu dem Thema auf der Website von PhilS.

https://codekabinett.com/rdumps.php?Lang=1&targetDoc=windows-api-deklaration-vba-64-bit

Da kannst du dich einlesen.

Aber ohne Anstrengung wird das nichts...

Hallo zusammen,

@PhilS Vielen Dank das hat super geklappt, musste nur den Functionsnamen wieder anpassen.
Und ich hab wirklich versucht alles nach Anleitung von dir zu machen, hab mich sogar am Wochenende 4h mit jemand unterhalten, um all das besser zu verstehen.
Aber von dem Expertenwissen bin ich noch weit weg, was ich auf jedenfall ändern möchte.

@markusxy Wie ich beschrieben hatte, wollte ich mir damals eine Benutzerverwaltung erstellen und bekam dann freundlicherweise diesen Code und musste in der Programmierung von diesem nie etwas ändern.
Das heißt aber nicht, das ich mein Wissen nicht gerne aufstocken will, werde mir den Link sorgfältig durchlesen.

Zitat von: Hias90 am Juli 17, 2023, 08:29:35Das heißt aber nicht, das ich mein Wissen nicht gerne aufstocken will, werde mir den Link sorgfältig durchlesen.

Kann ich nur empfehlen, die beste Anleitung die mir bis heute untergekommen ist.