Kryptographie

[Fennek]

Hallo,

Windows bietet ua folgende API für das Ver- und Entschlüsseln von relativ kurzen Strings an:

https://learn.microsoft.com/en-us/windows/win32/api/dpapi/nf-dpapi-cryptprotectdata
https://learn.microsoft.com/en-us/windows/win32/api/dpapi/nf-dpapi-cryptunprotectdata

also:

DPAPI_IMP BOOL CryptUnprotectData(
[in] DATA_BLOB *pDataIn,
[out, optional] LPWSTR *ppszDataDescr,
[in, optional] DATA_BLOB *pOptionalEntropy,
PVOID pvReserved,
[in, optional] CRYPTPROTECT_PROMPTSTRUCT *pPromptStruct,
[in] DWORD dwFlags,
[out] DATA_BLOB *pDataOut
);

Ist das auch mit VBA zu nutzen?

Danke

mfg

PS: mit Powershell:

# encrypt password
$pwd='Pas@$*Wrd(*' | ConvertTo-SecureString -AsPlainText -Force

# decrypt password
$bstr=[System.Runtime.InteropServices.Marshal]::SecureStringToBSTR($pwd)
$bstr # .GetType() -> IntPtr

Write-Host ('Password is:'+[System.Runtime.InteropServices.Marshal]::PtrToStringAuto($bstr))-fore green

Write-Host ('Password is:'+[System.Runtime.InteropServices.Marshal]::PtrToStringAuto(1579692422952))-fore green

(sofern die AV mitmacht, kann VBA auch PS-Scripts starten)

[LCohen]

Was ist denn eine AV? Anwenderverwaltung?

[Fennek]

Mit 'AV' meinte ich 'Anti-Virus'-Software.

[LCohen]

Und was ist ein PS-Script?

[DbSam]

Hallo return,

hier findest Du ein simples Beispiel.


VG Carsten

[Fennek]

Hallo Carsten,

vielen Dank.

Nach Einfügen von "PtrSafe" gab es einen Fehler bei "StrPtr". Diese Funktion gibt die Speicheradresse der Variablen an (??).

Der Test war mit Office 2019 64bit auf Windows 10 Pro.

Code:

'http://exceldevelopmentplatform.blogspot.com/2017/11/user-winapi-crypt32-to-convert-string.html

Option Explicit
Option Private Module

Private Declare PtrSafe Function CryptBinaryToString Lib "Crypt32.dll" Alias _
                        "CryptBinaryToStringW" (ByRef pbBinary As Byte, _
                        ByVal cbBinary As Long, ByVal dwFlags As Long, _
                        ByVal pszString As Long, ByRef pcchString As Long) As Long

Private Declare PtrSafe Function CryptStringToBinary Lib "Crypt32.dll" Alias _
                        "CryptStringToBinaryW" (ByVal pszString As Long, _
                        ByVal cchString As Long, ByVal dwFlags As Long, _
                        ByVal pbBinary As Long, ByRef pcbBinary As Long, _
                        ByRef pdwSkip As Long, ByRef pdwFlags As Long) As Long


'* Refactored from vbforums.com -
'* VB6 - Base64 Encoding -
'* http://www.vbforums.com/showthread.php?850055-VB6-Base64-Encoding
'*
'* with thanks to users  "J.A. Coutts" and "LaVolpe"

Private Sub TestBase64Encode()
    
    Dim sPlainText As String
    sPlainText = "Hello world"
    
    Dim byt() As Byte
    byt = StrConv(sPlainText, vbFromUnicode)
    Dim sEncoded As String
    sEncoded = Base64Encode(byt)
    
    Dim sAnswer As String
    sAnswer = "SGVsbG8gd29ybGQ="
    Debug.Assert Len(sEncoded) = Len(sAnswer)
    Debug.Assert sEncoded = sAnswer
    'Dim lPos
    'For lPos = 1 To Len(sEncoded)
    '    Debug.Assert Mid$(sEncoded, lPos, 1) = Mid$(sEncoded, lPos, 1)
    'Next
    
    
    Dim bytDecoded() As Byte
    bytDecoded = Base64Decode(sEncoded)
    
    Dim sDecoded As String
    sDecoded = StrConv(bytDecoded, vbUnicode)
    
    Debug.Assert sPlainText = sDecoded
    
    Stop

End Sub


Private Function Base64Encode(ByRef byt() As Byte) As String
    Const CRYPT_STRING_BASE64 As Long = 1
    Const CBS As String = "CryptBinaryToString"
    Const Routine As String = "Base64.Base64Encode"
    Dim lLen As Long
    'Determine Base64 output String length required.
    If CryptBinaryToString(byt(0), UBound(byt) + 1, CRYPT_STRING_BASE64, StrPtr(vbNullString), lLen) = 0 Then
        'RaiseEvent Error(Err.LastDllError, CBS, Routine)
        Err.Raise Err.LastDllError, CBS, Routine
        GoTo ReleaseHandles
    End If
    'Convert binary to Base64.
    Dim sBase64Buf As String
    sBase64Buf = String$(lLen - 1, Chr$(0))
    If CryptBinaryToString(byt(0), UBound(byt) + 1, CRYPT_STRING_BASE64, StrPtr(sBase64Buf), lLen) = 0 Then
        'RaiseEvent Error(Err.LastDllError, CBS, Routine)
        Err.Raise Err.LastDllError, CBS, Routine
        GoTo ReleaseHandles
    End If
    Base64Encode = Left$(sBase64Buf, lLen - 2)
ReleaseHandles:
End Function

Private Function Base64Decode(ByVal sBase64Buf As String) As Byte()
    Const CRYPT_STRING_BASE64 As Long = 1
    Const CSB As String = "CryptStringToBinary"
    Const Routine As String = "Base64.Base64Decode"
    
    Const CRYPT_STRING_NOCRLF As Long = &H40000000
    
    Dim bTmp() As Byte
    Dim lLen As Long
    Dim dwActualUsed As Long
    'Get output buffer length
    If CryptStringToBinary(StrPtr(sBase64Buf), Len(sBase64Buf), CRYPT_STRING_BASE64, StrPtr(vbNullString), lLen, 0&, dwActualUsed) = 0 Then
        'RaiseEvent Error(Err.LastDllError, CSB, Routine)
        Err.Raise Err.LastDllError, CSB, Routine
        GoTo ReleaseHandles
    End If
    'Convert Base64 to binary.
    ReDim bTmp(lLen - 1)
    If CryptStringToBinary(StrPtr(sBase64Buf), Len(sBase64Buf), CRYPT_STRING_BASE64, VarPtr(bTmp(0)), lLen, 0&, dwActualUsed) = 0 Then
        'RaiseEvent Error(Err.LastDllError, CSB, Routine)
        Err.Raise Err.LastDllError, CSB, Routine
        GoTo ReleaseHandles
    Else

        Base64Decode = bTmp
    End If
ReleaseHandles:
End Function

mfg

[DbSam]

Moin Moin,

dann sehr wahrscheinlich bitte mal hier nachlesen.


VG Carsten

[schauan]

@Lcohen
Ps - Powershell - ist eine neuere Scriptsprache die wohl mal als Nachfolger zu wscript angedacht war. Die kann deutlich mehr. Im Gegensatz zu wscript kann man die jedoch nicht direkt in VBA einbinden sondern muss Ergebnisse z. B. über andere Ausgabemöglichkeiten austauschen. Fileextention ist ps1

[Fennek]

Hallo,

ja, PS: Powershell ist der Nachfolger des CMD, aber da es auf .Net bassiert geeignet für die Konfiguration nicht nur Windows, sondern auch anderer M$-Produkte wie z.B ExChange-Server.

Es ist eine recht moderne und sehr leistungsstarke Programmiersprache.

[schauan]

Hab mal nachgeschaut, gibt's schon seit 2006, und gab's damals auch für XP SP2... (PS v1, aktuell ist v3)