Clever-Excel-Forum

Seiten: 1 2

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)

Was ist denn eine AV? Anwenderverwaltung?

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

Und was ist ein PS-Script?

Hallo return,

hier findest Du ein simples Beispiel.

VG Carsten

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

Moin Moin,

dann sehr wahrscheinlich bitte mal hier nachlesen.

VG Carsten

@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

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.

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

Seiten: 1 2

Fennek

LCohen

Fennek

LCohen

DbSam

Fennek

DbSam

schauan

Fennek

schauan