Registriert seit: 06.12.2015
Version(en): 2016
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)
Registriert seit: 21.12.2017
Version(en): MS 365 Family (6 User x 5 Geräte für jeden) Insider-Beta
Was ist denn eine AV? Anwenderverwaltung?
Registriert seit: 06.12.2015
Version(en): 2016
Mit 'AV' meinte ich 'Anti-Virus'-Software.
Registriert seit: 21.12.2017
Version(en): MS 365 Family (6 User x 5 Geräte für jeden) Insider-Beta
Und was ist ein PS-Script?
Registriert seit: 28.07.2015
Version(en): 365
Hallo return,
hier findest Du ein simples Beispiel.
VG Carsten
Registriert seit: 06.12.2015
Version(en): 2016
23.10.2022, 22:28
(Dieser Beitrag wurde zuletzt bearbeitet: 23.10.2022, 22:29 von 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
Registriert seit: 28.07.2015
Version(en): 365
Moin Moin,
dann sehr wahrscheinlich bitte mal hier nachlesen.
VG Carsten
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
@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
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 06.12.2015
Version(en): 2016
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.
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
24.10.2022, 15:58
(Dieser Beitrag wurde zuletzt bearbeitet: 24.10.2022, 16:00 von schauan.)
Hab mal nachgeschaut, gibt's schon seit 2006, und gab's damals auch für XP SP2... (PS v1, aktuell ist v3)
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
|