Hi friends
i have a code for creating hash code from password (for remote desktop ) . this code use CryptProtectData from Crypt32.dll
this is that code :
i want to convert this to vb6 code
here is some conversion by me : but the return hash code is not valid . i dont why
here is site of original source code : remkoweijnen program works well , but my program in vb6 does not work .
Masters of vb6 and api please help me
i have a code for creating hash code from password (for remote desktop ) . this code use CryptProtectData from Crypt32.dll
this is that code :
i want to convert this to vb6 code
Code:
unit uRDPHash;
interface
uses Windows, Sysutils {$ifndef FPC}, JwaWinCrypt{$endif}, JwaWinType;
{$ifdef FPC}
type
TBlobData = record
cbData : DWORD;
pbData : LPBYTE;
end;
DATA_BLOB = TBlobData;
PBlobData = ^TBlobData;
{$endif}
function CryptRDPPassword(sPassword: string): string;
{$ifndef FPC}function DecryptRDPPassword(sPasswordHash: string): string;{$endif}
function BlobDataToHexStr(P: PByte; I: Integer): string;
function PasswordHashToBlobData(sPasswordHash: string): DATA_BLOB;
implementation
{$ifdef FPC}
const
CRYPTPROTECT_UI_FORBIDDEN = 1;
type
LPLPWSTR = ^LPWSTR;
function CryptProtectData(pDataIn: PBlobData; szDataDescr: LPCWSTR;
pOptionalEntropy: PBlobData; pvReserved: Pointer;
pPromptStruct: Pointer; dwFlags: DWORD; pDataOut: PBlobData): BOOL; stdcall; external 'coredll' name 'CryptProtectData';
function CryptUnprotectData(pDataIn: PBlobData; ppszDataDescr: LPLPWSTR;
pOptionalEntropy: PBlobData; pvReserved: Pointer;
pPromptStruct: Pointer; dwFlags: DWORD; pDataOut: PBlobData): BOOL; stdcall; external 'coredll' name 'CryptUnProtectData';
{$endif}
{***********************************************************}
{ HexToByte: Converts Hex value to Byte }
{ Found this somewhere on the internet }
{***********************************************************}
function HexToByte(s : String) : Byte;
const
cs = '0123456789ABCDEF';
begin
result := 0;
if (length(s) = 2) and
(s[1] in ['0'..'9','A'..'F']) and
(s[2] in ['0'..'9','A'..'F']) then
result := ((pos(s[1],cs)-1) *16) + (pos(s[2],cs)-1)
else raise EConvertError.CreateFmt('%s is not a Hexformatstring',[s]);
end;
{***********************************************************}
{ PasswordHashToBlobData: Converts a RDP password Hash to }
{ a DATA_BLOB structure }
{ sPasswordHash : RDP Password Hash (HEX String }
{***********************************************************}
function PasswordHashToBlobData(sPasswordHash: string): DATA_BLOB;
var Buf: array of Byte;
dwBufSize: Cardinal;
i: Cardinal;
j: Cardinal;
dwHashSize: Cardinal;
begin
dwBufSize := Length(sPassWordHash) DIV 2;
dwHashSize := Length(sPasswordHash);
SetLength(Buf, dwBufSize);
i := 1;
j := 0;
while i < dwHashSize do begin
Buf[j] := HexToByte(sPassWordHash[i] + sPassWordHash[i+1]);
Inc(i, 2);
Inc(j);
end;
GetMem(Result.pbData, dwBufSize);
Result.cbData := dwBufSize;
Result.pbData := LPBYTE(Buf);
end;
{***********************************************************}
{ BlobDataToHexStr: Converts a PByte from a DATA_BLOB }
{ to a Hex String so it can be saved in }
{ an RDP file }
{ P : PByte (pbData) from DATA_BLOB }
{ I : Integer (cbData) from DATA_BLOB }
{***********************************************************}
function BlobDataToHexStr(P: PByte; I: Integer): string;
var HexStr: string;
begin
HexStr := '';
while (I > 0) do begin
Dec(I);
HexStr := HexStr + IntToHex(P^, 2);
Inc(P);
end;
Result := HexStr;
end;
{***********************************************************}
{ CryptRDPPassword: Converts a plaintext password to }
{ encrypted password hash }
{ an RDP file }
{ sPassword: plaintext password }
{***********************************************************}
function CryptRDPPassword(sPassword: string): string;
var DataIn: DATA_BLOB;
DataOut: DATA_BLOB;
pwDescription: PWideChar;
PwdHash: string;
begin
PwdHash := '';
DataOut.cbData := 0;
DataOut.pbData := nil;
// RDP uses UniCode
DataIn.pbData := Pointer(WideString(sPassword));
DataIn.cbData := Length(sPassword) * SizeOf(WChar);
// RDP always sets description to psw
pwDescription := WideString('psw');
if CryptProtectData(@DataIn,
pwDescription,
nil,
nil,
nil,
CRYPTPROTECT_UI_FORBIDDEN, // Never show interface
@DataOut) then
begin
PwdHash := BlobDataToHexStr(PByte(DataOut.pbData), DataOut.cbData);
end;
Result := PwdHash;
// Cleanup
LocalFree(Cardinal(DataOut.pbData));
LocalFree(Cardinal(DataIn.pbData));
end;
{***********************************************************}
{ DecryptRDPPassword: Converts an RDP Password Hash back }
{ to it's original password. }
{ Note that this only works for the user}
{ who encrypted the password (or on the }
{ same computer in case it was encrypted}
{ with the computerkey }
{ sPasswordHash: Password hash (string) }
{***********************************************************}
{$ifndef FPC}
function DecryptRDPPassword(sPasswordHash: string): string;
var DataIn: DATA_BLOB;
DataOut: DATA_BLOB;
sPassword: string;
pwDecrypted: PWideChar;
pwDescription: PWideChar;
begin
DataIn := PasswordHashToBlobData(sPasswordHash);
DataOut.cbData := 0;
DataOut.pbData := nil;
if CryptUnprotectData(@DataIn,
@pwDescription,
nil,
nil,
nil,
CRYPTPROTECT_UI_FORBIDDEN, // Never show interface
@DataOut) then
begin
Getmem(pwDecrypted, DataOut.cbData);
lstrcpynW(pwDecrypted, PWideChar(DataOut.pbData), (DataOut.cbData DIV 2) + 1);
sPassword := pwDecrypted;
FreeMem(pwDecrypted);
end
else
begin
raise EConvertError.CreateFmt('Error decrypting: %s',[SysErrorMessage(GetLastError)]);
end;
Result := sPassword;
// Cleanup
if DataOut.cbData > 0 then
begin
LocalFree(Cardinal(DataOut.pbData));
end;
end;
{$endif}
end.Code:
Public CryptRDPPassword As String
Private Type CRYPTPROTECT_PROMPTSTRUCT
cbSize As Long
dwPromptFlags As ProtectDataPromptFlags 'CrypyProtectPromptFlags
hwndApp As Long
szPrompt As Long
End Type
Private Type CRYPTOAPI_BLOB
cbData As Long
pbData As Long
End Type
Private Declare Function CryptProtectData Lib "crypt32.dll" ( _
pDataIn As Any, _
ByVal szDataDescr As Long, _
pOptionalEntropy As Any, _
ByVal pvReserved As Long, _
pPromptStruct As Any, _
ByVal dwFlags As ProtectDataFlags, _
pDataOut As Any) As Long
'CryptProtect,
Private Declare Function CryptUnprotectData Lib "crypt32.dll" ( _
pDataIn As Any, _
ppszDataDescr As Long, _
pOptionalEntropy As Any, _
ByVal pvReserved As Long, _
pPromptStruct As Any, _
ByVal dwFlags As Long, _
pDataOut As Any) As Long
Private Declare Sub MoveMemory Lib "kernel32" _
Alias "RtlMoveMemory" ( _
Dest As Any, Src As Any, ByVal Ln As Long)
Private Declare Function LocalFree Lib "kernel32" (ByVal Ptr As Long) As Long
Enum ProtectDataPromptFlags
PromptOnUnprotect = &H1
PromptOnProtect = &H2
Strong = &H8
RequireStrong = &H10
End Enum
Enum ProtectDataFlags
UIForbidden = &H1
LocalMachine = &H4
CredSync = &H8
Audit = &H10
NoRecovery = &H20
VerifyProtection = &H40
CredRegenerate = &H80
End Enum
Public Function ProtectData( _
Data() As Byte, _
ByVal DataDescription As String, _
Optional ByVal ParentWnd As Long, _
Optional ByVal DialogTitle As String, _
Optional ByVal Flags As ProtectDataFlags = LocalMachine, _
Optional ByVal PromptFlags As ProtectDataPromptFlags)
Dim tBlobIn As CRYPTOAPI_BLOB
Dim tBlobOut As CRYPTOAPI_BLOB
Dim tPS As CRYPTPROTECT_PROMPTSTRUCT
Dim abEnc() As Byte
Dim lRes As Long
' Fill the blob structure
With tBlobIn
.cbData = UBound(Data) - LBound(Data) + 1
.pbData = VarPtr(Data(0))
End With
With tPS
.cbSize = Len(tPS)
.hwndApp = ParentWnd
.dwPromptFlags = PromptFlags
If Len(DialogTitle) Then .szPrompt = StrPtr(DialogTitle)
End With
CryptRDPPassword = ""
lRes = CryptProtectData(tBlobIn, StrPtr(DataDescription), 0, 0, 0, 5, tBlobOut)
If lRes = 0 Then Err.Raise &H80070000 Or Err.LastDllError
' Copy the encrypted data to a byte array
ReDim abEnc(0 To tBlobOut.cbData - 1)
MoveMemory abEnc(0), ByVal tBlobOut.pbData, tBlobOut.cbData
' Return the encrypted data
'ProtectData = abEnc
' Release the returned data
s = ""
s = ByteArrayToHexStr(abEnc())
CryptRDPPassword = s
CryptRDPPassword = Replace(s, " ", "")
LocalFree tBlobOut.pbData
End Function
Function ByteArrayToHexStr(b() As Byte) As String
Dim n As Long, i As Long
ByteArrayToHexStr = Space$(3 * (UBound(b) - LBound(b)) + 2)
n = 1
For i = LBound(b) To UBound(b)
Mid$(ByteArrayToHexStr, n, 2) = Right$("00" & Hex$(b(i)), 2)
n = n + 3
Next
End Function
Private Sub Command1_Click()
Text1.Text = ""
Dim aDataIn() As Byte
Dim udtDataIn As CRYPTOAPI_BLOB
Dim r As Long
Dim udtDataOut As CRYPTOAPI_BLOB
Dim aDataOut() As Byte
Dim spPassword As String
spPassword = "1234"
aDataIn = StrConv(spPassword, vbUnicode)
ProtectData aDataIn, "psw", , , , Strong
Text1.Text = CryptRDPPassword
End SubMasters of vb6 and api please help me
Code:
http://www.remkoweijnen.nl/blog/2007/10/18/how-rdp-passwords-are-encrypted/