For a big use vb to write a decryption code encrypted using these two functions!
CodePudding user response:
Private Type CRYPTPROTECT_PROMPTSTRUCTCbSize As Long
DwPromptFlags As Long
HWndApp As Long
SzPrompt As Long
End Type
Private Type DATA_BLOB
CbData As Long
PbData As Long
End Type
Private Declare Function CryptProtectData Lib "crypt32. DLL (_
ByRef pDataIn As DATA_BLOB, _
ByVal szDataDescr As String, _
ByRef pOptionalEntropy As Any, _
ByRef pvReserved As Any, _
ByRef pPromptStruct As Any, _
ByVal dwFlags As Long, _
ByRef pDataOut As Long As DATA_BLOB)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (_
HpvDest As Any, _
HpvSource As Any, _
ByVal cbCopy As Long)
'the CodePage
Private Const CP_ACP=0 'ANSI
Private Const CP_MACCP Mac
=2 'Private Const CP_OEMCP=1 'OEM
Private Const CP_UTF7=65000
Private Const CP_UTF8=65001
'dwFlags
Private Const WC_NO_BEST_FIT_CHARS=& amp; H400
Private Const WC_COMPOSITECHECK=& amp; H200
Private Const WC_DISCARDNS=& amp; H10
Private Const WC_SEPCHARS=& amp; H20 'Default
Private Const WC_DEFAULTCHAR=& amp; H40
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByVal lpWideCharStr As Long, _
ByVal cchWideChar As Long, _
ByVal lpMultiByteStr As Long, _
ByVal cbMultiByte As Long, _
ByVal lpDefaultChar As Long, _
ByVal lpUsedDefaultChar As Long As Long)
'
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
The Public Function CryptRDPPassword (ByVal spPassword As String) As String
Dim aDataIn () As Byte
Dim udtDataIn As DATA_BLOB
Dim r As Long
Dim udtDataOut As DATA_BLOB
Dim aDataOut () As Byte
Dim s $, i&
Dim szDataDesc As String
Dim strTMP As String
Const CRYPTPROTECT_UI_FORBIDDEN=1
'the code below DID NOT WORK as byte length was twice as big on Windows 7 64 - bit!
'aDataIn=StrConv (spPassword vbUnicode)
ADataIn=StringToByteArray (spPassword)
With udtDataIn
CbData=https://bbs.csdn.net/topics/(UBound (aDataIn) + 1)
PbData=https://bbs.csdn.net/topics/VarPtr (aDataIn (0))
End With
SzDataDesc=StrConv (PSW, vbUnicode)
R=CryptProtectData (_
UdtDataIn, _
SzDataDesc, _
ByVal vbNullString, _
ByVal vbNullString, _
ByVal vbNullString, _
CRYPTPROTECT_UI_FORBIDDEN, _
UdtDataOut)
If r Then
ReDim Preserve aDataOut (udtDataOut cbData)
CopyMemory aDataOut (0), ByVal udtDataOut. PbData, udtDataOut. CbData
S=""
For I=0 To udtDataOut. CbData - 1
'the code below DID NOT WORK since Hex (122) should="7 a and formatted" returned "00"
's=s & amp; Format (Hex (aDataOut (I)), and "00")
StrTMP=Hex (aDataOut (I))
If Len (strTMP)=1 Then strTMP="0" & amp; StrTMP
S=s & amp; StrTMP
Next
CryptRDPPassword=s
The Else
CryptRDPPassword="Nothing"
End the If
End the Function
Home 'Helper function using StConv
'
Private Function StringToByteArray (strInput As String, _
Optional bReturnAsUnicode As Boolean=True, _
Optional bAddNullTerminator As Boolean=False) As Byte ()
Dim lRet As Long
Dim bytBuffer () As Byte
Dim lLenB As Long
If bReturnAsUnicode Then
'the Number of bytes
LLenB=LenB (strInput)
'the Resize the buffer, do we want terminating null?
If bAddNullTerminator Then
ReDim bytBuffer (lLenB)
The Else
ReDim bytBuffer (lLenB - 1)
End the If
'Copy characters from a string to byte array
CopyMemory bytBuffer (0), ByVal StrPtr (strInput), lLenB
The Else
'the Num of characters
LLenB=Len (strInput)
If bAddNullTerminator Then
ReDim bytBuffer (lLenB)
The Else
ReDim bytBuffer (lLenB - 1)
End the If
LRet=WideCharToMultiByte (CP_ACP, 0 & amp; , ByVal StrPtr (strInput), 1, ByVal VarPtr (bytBuffer (0)), lLenB, 0 & amp; , 0 & amp;)
End the If
StringToByteArray=bytBuffer
End the Function
'the sample
Sub main ()
End Sub
Private Sub Form_Load ()
Dim retSTR As String
RetSTR=CryptRDPPassword (" sr123456. ")
Text1. Text retSTR=
'the output from my machine...
'01000000 d08c9ddf0115d1118c7a00c04fc297eb010000009cf58531d06e9f49a61bd864ed7090b90000000008000000700073007700000003660000c000000010000000b873812af748ebfeb771062ddc11c1070000000004800000a000000010000000e37108e248ef890516a1b3987d3136c218000000cc1666dd310330b3e1b2e77f6956ff3a93e94c5f493cc13e140000005360605d9f45077e3d99d86643c2149a33082c1c
End Sub
Already solved! Sealing!