注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

BCB-DG's Blog

...

 
 
 

日志

 
 

CryptProtectData & CryptUnprotectData  

2010-07-07 19:04:21|  分类: Delphi |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;

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

  _CRYPTOAPI_BLOB = packed record
    cbData: DWORD;
    pbData: PLargeByteArray;
  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;

procedure TForm1.Button1Click(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;

end.


============================================

function EncryptPassword(Password: string): string;
var
  DataIn: DATA_BLOB;
  dwFlags: DWORD;
  DataOut: DATA_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: DATA_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;
  评论这张
 
阅读(1702)| 评论(0)
推荐 转载

历史上的今天

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017