求救:crypt32.dll在VB6.0中怎么使用?

ccc598914010 2021-04-04 07:38:30
crypt32.dll的API函数CryptProtectData和CryptUnprotectData!分别是加密解密!在MSDN上只有C++例子,看不到!
求个大佬能用vb写一个使用这2个函数的加密解密代码!
...全文
242 1 打赏 收藏 举报
写回复
1 条回复
切换为时间正序
请发表友善的回复…
发表回复
ccc598914010 2021-04-04
Private Type CRYPTPROTECT_PROMPTSTRUCT cbSize 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 DATA_BLOB) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _ hpvDest As Any, _ hpvSource As Any, _ ByVal cbCopy As Long) 'CodePage Private Const CP_ACP = 0 'ANSI Private Const CP_MACCP = 2 'Mac Private Const CP_OEMCP = 1 'OEM Private Const CP_UTF7 = 65000 Private Const CP_UTF8 = 65001 'dwFlags Private Const WC_NO_BEST_FIT_CHARS = &H400 Private Const WC_COMPOSITECHECK = &H200 Private Const WC_DISCARDNS = &H10 Private Const WC_SEPCHARS = &H20 'Default Private Const WC_DEFAULTCHAR = &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 ' '******************************************* 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 Win7 64 bit! 'aDataIn = StrConv(spPassword, vbUnicode) aDataIn = StringToByteArray(spPassword) With udtDataIn .cbData = (UBound(aDataIn) + 1) .pbData = 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 = "7A" and formatted returned "00" 's = s & Format(Hex(aDataOut(i)),"00") strTMP = Hex(aDataOut(i)) If Len(strTMP) = 1 Then strTMP = "0" & strTMP s = s & strTMP Next CryptRDPPassword = s Else CryptRDPPassword = "Nothing" End If End Function 'Helper function instead of 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 'Number of bytes lLenB = LenB(strInput) 'Resize buffer, do we want terminating null? If bAddNullTerminator Then ReDim bytBuffer(lLenB) Else ReDim bytBuffer(lLenB - 1) End If 'Copy characters from string to byte array CopyMemory bytBuffer(0), ByVal StrPtr(strInput), lLenB Else 'Num of characters lLenB = Len(strInput) If bAddNullTerminator Then ReDim bytBuffer(lLenB) Else ReDim bytBuffer(lLenB - 1) End If lRet = WideCharToMultiByte(CP_ACP, 0&, ByVal StrPtr(strInput), -1, ByVal VarPtr(bytBuffer(0)), lLenB, 0&, 0&) End If StringToByteArray = bytBuffer End Function 'sample Sub main() End Sub Private Sub Form_Load() Dim retSTR As String retSTR = CryptRDPPassword("sr123456.") Text1.Text = retSTR 'output from my machine ... '01000000D08C9DDF0115D1118C7A00C04FC297EB010000009CF58531D06E9F49A61BD864ED7090B90000000008000000700073007700000003660000C000000010000000B873812AF748EBFEB771062DDC11C1070000000004800000A000000010000000E37108E248EF890516A1B3987D3136C218000000CC1666DD310330B3E1B2E77F6956FF3A93E94C5F493CC13E140000005360605D9F45077E3D99D86643C2149A33082C1C End Sub 已经解决!封帖!
  • 打赏
  • 举报
回复
发帖
API
加入

1472

社区成员

VB API
社区管理员
  • API
申请成为版主
帖子事件
创建了帖子
2021-04-04 07:38
社区公告
暂无公告