api - Use CryptProtectData & CryptUnprotectData in Delphi

Question

I want to use CryptUnprotectData & CryptProtectData in Crypt32.dll.

my code is :

unit Unit1;

interface

uses   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type   TForm1 = class(TForm)
    btn1: TButton;
    btn2: TButton;
    edt1: TEdit;
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);   private
    { Private declarations }   public
    { Public declarations }   end;

var   Form1: TForm1; const CRYPTPROTECT_LOCAL_MACHINE = 4 ;

type   TLargeByteArray = array [0..Pred(MaxInt)] of byte;   PLargeByteArray = ^TLargeByteArray;

  _CRYPTOAPI_BLOB = packed record
    cbData: DWORD;
    pbData: PByte;   end;   TCryptoApiBlob     = _CRYPTOAPI_BLOB;   PCrypyoApiBlob     = ^TCryptoApiBlob;   CRYPT_INTEGER_BLOB =
_CRYPTOAPI_BLOB;   PCRYPT_INTEGER_BLOB = ^CRYPT_INTEGER_BLOB;   CRYPT_UINT_BLOB    = _CRYPTOAPI_BLOB;   PCRYPT_UINT_BLOB   = ^CRYPT_INTEGER_BLOB;   CRYPT_OBJID_BLOB   = _CRYPTOAPI_BLOB;   PCRYPT_OBJID_BLOB  = ^CRYPT_INTEGER_BLOB;   CERT_NAME_BLOB     =
_CRYPTOAPI_BLOB;   PCERT_NAME_BLOB    = ^CRYPT_INTEGER_BLOB;   CERT_RDN_VALUE_BLOB = _CRYPTOAPI_BLOB;   PCERT_RDN_VALUE_BLOB = ^CRYPT_INTEGER_BLOB;   CERT_BLOB          = _CRYPTOAPI_BLOB;   PCERT_BLOB         = ^CRYPT_INTEGER_BLOB;   CRL_BLOB           =
_CRYPTOAPI_BLOB;   PCRL_BLOB          = ^CRYPT_INTEGER_BLOB;   DATA_BLOB          = _CRYPTOAPI_BLOB;   PDATA_BLOB         = ^CRYPT_INTEGER_BLOB;   CRYPT_DATA_BLOB    = _CRYPTOAPI_BLOB;   PCRYPT_DATA_BLOB   = ^CRYPT_INTEGER_BLOB;   CRYPT_HASH_BLOB    =
_CRYPTOAPI_BLOB;   PCRYPT_HASH_BLOB   = ^CRYPT_INTEGER_BLOB;   CRYPT_DIGEST_BLOB  = _CRYPTOAPI_BLOB;   PCRYPT_DIGEST_BLOB = ^CRYPT_INTEGER_BLOB;   CRYPT_DER_BLOB     = _CRYPTOAPI_BLOB;   PCRYPT_DER_BLOB    = ^CRYPT_INTEGER_BLOB;   CRYPT_ATTR_BLOB    =
_CRYPTOAPI_BLOB;   PCRYPT_ATTR_BLOB   = ^CRYPT_INTEGER_BLOB;

type   _CRYPTPROTECT_PROMPTSTRUCT = packed record
    cbSize:        DWORD;
    dwPromptFlags: DWORD;
    hwndApp:       HWND;
    szPrompt:      LPCWSTR;   end;   TCryptProtectPromptStruct  = _CRYPTPROTECT_PROMPTSTRUCT;   PCryptProtectPromptStruct  = ^TCryptProtectPromptStruct;   CRYPTPROTECT_PROMPTSTRUCT  =
_CRYPTPROTECT_PROMPTSTRUCT;   PCRYPTPROTECT_PROMPTSTRUCT = ^_CRYPTPROTECT_PROMPTSTRUCT;

function CryptProtectData(pDataIn: PDATA_BLOB; szDataDescr: LPCWSTR {PWideChar}; pOptionalEntropy: PDATA_BLOB; pReserved: Pointer;   pPromptStruct: PCRYPTPROTECT_PROMPTSTRUCT; dwFlags: DWORD; pDataOut: PDATA_BLOB): BOOL; stdcall; external 'Crypt32.dll';

function CryptUnprotectData(pDataIn: PDATA_BLOB; var ppszDataDescr: LPWSTR; pOptionalEntropy: PDATA_BLOB; pReserved: Pointer;   pPromptStruct: PCRYPTPROTECT_PROMPTSTRUCT; dwFlags: DWORD; pDataOut: PDATA_BLOB): BOOL; stdcall; external 'Crypt32.dll';

implementation {$R *.DFM}

procedure FreeDataBlob(var Data: DATA_BLOB); begin   if Assigned(Data.pbData) then
    LocalFree(HLOCAL(Data.pbData));   FillChar(Data, SizeOf(DATA_BLOB), 0); end;

function GetDataBlobText(Data: DATA_BLOB): string; begin   if (Data.cbData > 0) and Assigned(Data.pbData) then
    SetString(Result, PChar(Data.pbData), Data.cbData)   else
    SetLength(Result, 0); end;

function SetDataBlobText(Text: string; var Data: DATA_BLOB): boolean; begin   FillChar(Data, SizeOf(DATA_BLOB), 0);   if (Length(Text) > 0) then   begin
    Data.pbData := Pointer(LocalAlloc(LPTR, Succ(Length(Text))));
    if Assigned(Data.pbData) then
    begin
      StrPCopy(PChar(Data.pbData), Text);
      Data.cbData := Length(Text);
      Result := True;
    end
    else
      Result := False;   end   else
    Result := True; end;






{============================================     }

function EncryptPassword(Password: string): string; var   DataIn: DATA_BLOB;   dwFlags: DWORD;   DataOut: PDATA_BLOB;   I: Integer;   P: PByte; begin   Result := '';   DataIn.cbData := Length(Password);   DataIn.pbData := Pointer(PChar(Password));   dwFlags := CRYPTPROTECT_LOCAL_MACHINE;   if CryptProtectData(@DataIn, 'Password', nil, nil, nil, dwFlags, DataOut) then   begin
    P := DataOut.pbData;
    I := DataOut.cbData;
    Result := IntToHex(I, 8);
    while (I > 0) do
    begin
      Dec(I);
      Result := Result + IntToHex(P^, 2);
      Inc(P);
    end;
    LocalFree(Cardinal(DataOut.pbData));   end; end;

function DecryptPassword(Password: string): string; var   DataIn: DATA_BLOB;   dwFlags: DWORD;   DataOut: PDATA_BLOB;   I, J: Integer;   P: PByte;   DataDescr: LPWSTR; begin   Result := '';   if (Length(Password) > 0) then   begin
    DataIn.cbData := StrToIntDef('$' + Copy(Password, 1, 8), 0);
    if (DataIn.cbData > 0) then
    begin
      GetMem(DataIn.pbData, DataIn.cbData);
      I := DataIn.cbData;
      J := 9;
      P := DataIn.pbData;
      while (I > 0) and (J < Length(Password)) do
      begin
        Dec(I);
        P^ := StrToInt('$' + Copy(Password, J, 2));
        Inc(P);
        Inc(J, 2);
      end;
      dwFlags := CRYPTPROTECT_LOCAL_MACHINE;
      if CryptUnprotectData(@DataIn, DataDescr, nil, nil, nil, dwFlags, DataOut) then
      begin
        Result := Copy(string(DataOut.pbData), 0, DataOut.cbData);
        LocalFree(Cardinal(DataOut.pbData));
      end;
    end;   end; end;

procedure TForm1.btn1Click(Sender: TObject); var   DataIn:  DATA_BLOB; DataOut: DATA_BLOB;   DataCheck: DATA_BLOB;   lpwszDesc: PWideChar; begin   FillChar(DataIn, SizeOf(DATA_BLOB), 0);   FillChar(DataOut, SizeOf(DATA_BLOB), 0);   FillChar(DataCheck, SizeOf(DATA_BLOB), 0);   if SetDataBlobText('Hello world this is a test!', DataIn) then   begin
    try
      if CryptProtectData(@DataIn, PWideChar(WideString('Hello Test')), nil, nil, nil, 0, @DataOut) then
      begin
        MessageBox(0, PChar(GetDataBlobText(DataOut)), PChar(Format('%d bytes returned', [DataOut.cbData])), MB_OK or MB_ICONINFORMATION);
        try
          if CryptUnprotectData(@DataOut, lpwszDesc, nil, nil, nil, 0, @DataCheck) then
          begin
            try
              MessageBox(0, PChar(GetDataBlobText(DataCheck)), PChar(string(WideString(lpwszDesc))), MB_OK or MB_ICONINFORMATION);
            finally
              LocalFree(HLOCAL(lpwszDesc));
              FreeDataBlob(DataCheck);
            end;
          end;
        finally
          FreeDataBlob(DataIn);
        end;
      end;
    finally
      FreeDataBlob(DataIn);
    end;   end;

end;

procedure TForm1.btn2Click(Sender: TObject); begin   ShowMessage(DecryptPassword(edt1.Text)); end;

end.

But I have error in 2 buttons and cant get the real string.

btn1 error:

---------------------------
Project1
---------------------------
Access violation at address 76F2E23E in module 'ntdll.dll'. Read of address 22481A56.
---------------------------
OK   
---------------------------

btn2 after decrypt show null and show me this error :

---------------------------
Project1
---------------------------
Access violation at address 00000000. Read of address 00000000.
---------------------------
OK   
---------------------------

What is the problems ?

Answer 1

Your code is formatted so that it is next to impossible to read and analyse. If it was better formatted then I think you'd get more comprehensive answers. Here's what I can see:

1. The records should not be packed.
2. The second parameter to CryptUnprotectData should not be a var parameter. By making it a var parameter you force yourself to pass it. Since you don't want to use it, you should declare it as a pointer to PWideChar so that you can opt not to use it.
3. In btn1Click you did not assign anything to lpwszDesc. What's more you then passed it to LocalFree.
4. You are using a Unicode Delphi and so have no reason to use WideString here. Simply cast a string, which is already UTF-16, to PWideChar.
5. You are not allowing for the fact that SizeOf(Char) is 2 in your Unicode Delphi. So your treatment of cbData in wrong.
6. DecryptPassword passed an unitialised pointer to CryptUnprotectData.
7. DecryptPassword leaks the memory allocated with GetMem.
8. I don't really know what DecryptPassword is attempting to do, but it's clearly broken. I can't fix it since I've no idea what your goals are.

---

However, I'm sure there are more problems. I have some general advice for you. There is too much code in the question. You should remove as much as possible. You should make the smallest possible SSCCE. This should be a simple console application. The code should be formatted to be readable, and preferably without resort to horizontal scrolling. This will help you as much as it helps us.

The point is that you are searching for errors. If you cut the code down to be as simple as possible, then there is less to check. If the code is visible and layed out neatly, it is easier to check.

As much as getting the specific details right, the general principle of knowing how to make your code readable and concise is much more important here.

So, just to show you what I mean, here is your original post converted into an SSCCE, and with a number of the bugs fixed:

program SO17823083;

{$APPTYPE CONSOLE}

uses
  System.SysUtils, Winapi.Windows;

const
  CRYPTPROTECT_LOCAL_MACHINE = 4;

type
  TLargeByteArray = array [0 .. Pred(MaxInt)] of byte;
  PLargeByteArray = ^TLargeByteArray;

  _CRYPTOAPI_BLOB = record
    cbData: DWORD;
    pbData: PByte;
  end;

  DATA_BLOB = _CRYPTOAPI_BLOB;
  PDATA_BLOB = ^DATA_BLOB;

type
  _CRYPTPROTECT_PROMPTSTRUCT = record
    cbSize: DWORD;
    dwPromptFlags: DWORD;
    hwndApp: HWND;
    szPrompt: PWideChar;
  end;

  CRYPTPROTECT_PROMPTSTRUCT = _CRYPTPROTECT_PROMPTSTRUCT;
  PCRYPTPROTECT_PROMPTSTRUCT = ^CRYPTPROTECT_PROMPTSTRUCT;

function CryptProtectData(pDataIn: PDATA_BLOB;
  szDataDescr: PWideChar; pOptionalEntropy: PDATA_BLOB;
  pReserved: Pointer; pPromptStruct: PCRYPTPROTECT_PROMPTSTRUCT; dwFlags: DWORD;
  pDataOut: PDATA_BLOB): BOOL; stdcall; external 'Crypt32.dll';

function CryptUnprotectData(pDataIn: PDATA_BLOB; ppszDataDescr: PPWideChar;
  pOptionalEntropy: PDATA_BLOB; pReserved: Pointer;
  pPromptStruct: PCRYPTPROTECT_PROMPTSTRUCT; dwFlags: DWORD;
  pDataOut: PDATA_BLOB): BOOL; stdcall; external 'Crypt32.dll';

procedure FreeDataBlob(var Data: DATA_BLOB);
begin
  if Assigned(Data.pbData) then
    LocalFree(HLOCAL(Data.pbData));
  FillChar(Data, SizeOf(DATA_BLOB), 0);
end;

function GetDataBlobText(Data: DATA_BLOB): string;
begin
  SetString(Result, PChar(Data.pbData), Data.cbData div SizeOf(Char))
end;

function SetDataBlobText(const Text: string; var Data: DATA_BLOB): boolean;
begin
  FillChar(Data, SizeOf(DATA_BLOB), 0);
  if Length(Text) > 0 then
  begin
    Data.cbData := SizeOf(Char)*Length(Text);
    Data.pbData := Pointer(LocalAlloc(LPTR, Data.cbData));
    if Assigned(Data.pbData) then
    begin
      Move(Pointer(Text)^, Data.pbData^, Data.cbData);
      Result := True;
    end
    else
      Result := False;
  end
  else
    Result := True;
end;

function DecryptPassword(Password: string): string;
var
  DataIn: DATA_BLOB;
  dwFlags: DWORD;
  DataOut: DATA_BLOB;
  I, J: Integer;
  P: PByte;
begin
  Result := '';
  if (Length(Password) > 0) then
  begin
    DataIn.cbData := StrToIntDef('$' + Copy(Password, 1, 8), 0);
    if (DataIn.cbData > 0) then
    begin
      GetMem(DataIn.pbData, DataIn.cbData);
      I := DataIn.cbData;
      J := 9;
      P := DataIn.pbData;
      while (I > 0) and (J < Length(Password)) do
      begin
        Dec(I);
        P^ := StrToInt('$' + Copy(Password, J, 2));
        Inc(P);
        Inc(J, 2);
      end;
      dwFlags := CRYPTPROTECT_LOCAL_MACHINE;
      if CryptUnprotectData(@DataIn, nil, nil, nil, nil, dwFlags, @DataOut)
      then
      begin
        Result := GetDataBlobText(DataOut);
        LocalFree(Cardinal(DataOut.pbData));
      end;
      FreeMem(DataIn.pbData);
    end;
  end;
end;

procedure Test1;
var
  DataIn: DATA_BLOB;
  DataOut: DATA_BLOB;
  DataCheck: DATA_BLOB;
begin
  if SetDataBlobText('Hello world this is a test!', DataIn) then
  begin
    try
      if CryptProtectData(@DataIn, PChar('Hello Test'), nil,
        nil, nil, 0, @DataOut) then
      begin
        Writeln(GetDataBlobText(DataOut));
        Writeln(Format('%d bytes returned', [DataOut.cbData]));
        try
          if CryptUnprotectData(@DataOut, nil, nil, nil, nil, 0,
            @DataCheck) then
          begin
            try
              Writeln(GetDataBlobText(DataCheck));
            finally
              FreeDataBlob(DataCheck);
            end;
          end;
        finally
          FreeDataBlob(DataIn);
        end;
      end;
    finally
      FreeDataBlob(DataIn);
    end;
  end;
end;

procedure Test2;
begin
  Writeln(DecryptPassword('1111'));
end;

begin
  try
    Test1;
    Test2;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

I used the code formatting feature of the Delphi IDE to lay the code out in a readable style. And I converted it to a console application so that you have a single file that contains the entire program.

This version does at least run and not raise access violations. Now it's up to you to make it actually do what you want it to do.