api - Use CryptProtectData & CryptUnprotectData in Delphi -

i want use cryptunprotectdata & cryptprotectdata in crypt32.dll.

my code :

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)     localfree(hlocal(data.pbdata));   fillchar(data, sizeof(data_blob), 0); end;  function getdatablobtext(data: data_blob): string; begin   if (data.cbdata > 0) , assigned(data.pbdata)     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)   begin     data.pbdata := pointer(localalloc(lptr, succ(length(text))));     if assigned(data.pbdata)     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)   begin     p := dataout.pbdata;     := dataout.cbdata;     result := inttohex(i, 8);     while (i > 0)     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)   begin     datain.cbdata := strtointdef('$' + copy(password, 1, 8), 0);     if (datain.cbdata > 0)     begin       getmem(datain.pbdata, datain.cbdata);       := datain.cbdata;       j := 9;       p := datain.pbdata;       while (i > 0) , (j < length(password))       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)       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 test!', datain)   begin     try       if cryptprotectdata(@datain, pwidechar(widestring('hello test')), nil, nil, nil, 0, @dataout)       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)           begin             try               messagebox(0, pchar(getdatablobtext(datacheck)), pchar(string(widestring(lpwszdesc))), mb_ok or mb_iconinformation);                           localfree(hlocal(lpwszdesc));               freedatablob(datacheck);             end;           end;                   freedatablob(datain);         end;       end;           freedatablob(datain);     end;   end;  end;  procedure tform1.btn2click(sender: tobject); begin   showmessage(decryptpassword(edt1.text)); end;  end. 

but have error in 2 buttons , cant real string.

btn1 error:

--------------------------- project1 --------------------------- access violation @ address 76f2e23e in module 'ntdll.dll'. read of address 22481a56. --------------------------- ok    --------------------------- 

btn2 after decrypt show null , show me error :

--------------------------- project1 --------------------------- access violation @ address 00000000. read of address 00000000. --------------------------- ok    --------------------------- 

what problems ?

your code formatted next impossible read , analyse. if better formatted think you'd more comprehensive answers. here's can see:

1. the records should not packed.
2. the second parameter cryptunprotectdata should not var parameter. making var parameter force pass it. since don't want use it, should declare pointer pwidechar can opt not use it.
3. in btn1click did not assign lpwszdesc. what's more passed localfree.
4. you using unicode delphi , have no reason use widestring here. cast string, utf-16, pwidechar.
5. you not allowing fact sizeof(char) 2 in unicode delphi. treatment of cbdata in wrong.
6. decryptpassword passed unitialised pointer cryptunprotectdata.
7. decryptpassword leaks memory allocated getmem.
8. i don't know decryptpassword attempting do, it's broken. can't fix since i've no idea goals are.

---

however, i'm sure there more problems. have general advice you. there code in question. should remove as possible. should make smallest possible sscce. should simple console application. code should formatted readable, , preferably without resort horizontal scrolling. as helps us.

the point searching errors. if cut code down simple possible, there less check. if code visible , layed out neatly, easier check.

as getting specific details right, general principle of knowing how make code readable , concise more important here.

so, show mean, here original post converted sscce, , number of 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)     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   begin     data.cbdata := sizeof(char)*length(text);     data.pbdata := pointer(localalloc(lptr, data.cbdata));     if assigned(data.pbdata)     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)   begin     datain.cbdata := strtointdef('$' + copy(password, 1, 8), 0);     if (datain.cbdata > 0)     begin       getmem(datain.pbdata, datain.cbdata);       := datain.cbdata;       j := 9;       p := datain.pbdata;       while (i > 0) , (j < length(password))       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)             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 test!', datain)   begin     try       if cryptprotectdata(@datain, pchar('hello test'), nil,         nil, nil, 0, @dataout)       begin         writeln(getdatablobtext(dataout));         writeln(format('%d bytes returned', [dataout.cbdata]));         try           if cryptunprotectdata(@dataout, nil, nil, nil, nil, 0,             @datacheck)           begin             try               writeln(getdatablobtext(datacheck));                           freedatablob(datacheck);             end;           end;                   freedatablob(datain);         end;       end;           freedatablob(datain);     end;   end; end;  procedure test2; begin   writeln(decryptpassword('1111')); end;  begin   try     test1;     test2;   except     on e: exception       writeln(e.classname, ': ', e.message);   end; end. 

i used code formatting feature of delphi ide lay code out in readable style. , converted console application have single file contains entire program.

this version @ least run , not raise access violations. it's make want do.