• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 3481
  • Last Modified:

Using function from DLLs (crypt32.dll) in Delphi

Hi,

Crypt32.dll has a function named CryptProtectData. I would like to use that function to encrypt something. But I have no idea how.

In Visual Basic, you'd use something like:

---

Private Declare Function CryptProtectData Lib "crypt32.dll" (ByRef r_udtDataIn As DATA_BLOB, ByVal v_sDataDescr As String, ByRef r_anyOptionalEntropy As Any, ByRef r_anyReserved As Any, ByRef r_anyPromptStruct As Any, ByVal v_lFlags As Long, ByRef r_udtDataOut As DATA_BLOB) As Long

    Dim udtDataOut      As DATA_BLOB
    Dim udtDataIn       As DATA_BLOB

Call CryptProtectData(udtDataIn, "", ByVal vbNullString, ByVal vbNullString, ByVal vbNullString, 0, udtDataOut)

---

But what to do in Delphi? Anyone any idea how to get the result?
0
TonyJix
Asked:
TonyJix
  • 5
  • 5
  • 2
  • +1
1 Solution
 
mikelittlewoodCommented:
It would be something along the lines of the function below but Im not sure of the parameters DATA_BLOB

function CryptProtectData(r_udtDataIn: Variant; v_sDataDescr: String; r_anyOptionalEntropy: Variant; r_anyReserved: Variant; r_anyPromptStruct: Variant; v_lFlags: Integer; r_udtDataOut: Variant): Integer; external 'Crypt32.dll' name 'CryptProtectData';
0
 
TonyJixAuthor Commented:
Thank you for the reply - I already figured it'd be something like that but I am not able to get it to return anything.

On this site you see official information on function CryptProtectData:

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/seccrypto/security/cryptprotectdata.asp

It also has link with more information about the DATA_BLOB type. But im not experienced enough to do something with that info.

As far as I can tell regarding the parameters, all of them may be empty, except the first one (data in).
"Data in" variable is some text encoded to base64. But that's not the probem really. First I need to know
how to even use this function and get any result.

Thank you to anyone in advance.
0
 
TonyJixAuthor Commented:
Ok I figured out the DATA_BLOB variables and everything.

I am ready to run the function, but it gives me an error when I use it:

It says Access Violation.

Any idea?

Greeting,
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
Russell LibbySoftware Engineer, Advisory Commented:

The correct definitions are listed below. If you have problems with the correct defines, I would need to see a code clip of what you are trying to do.

Regards,
Russell


type
  TLargeByteArray      =  Array [0..Pred(MaxInt)] of Byte;
  PLargeByteArray      =  ^TLargeByteArray;

type
  _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';


0
 
TonyJixAuthor Commented:
Hi,

thank you.. I guess it's like that.
Still when I call it, I get an access error.

Im just not able to get this stuff working, it's frustrating.

I have the full source of this program in Visual Basic where it all looks so easy to call the function, but it is just impossible in Delphi.
What CryptProtectData does is it accepts a string and then encrypts it and returns something.
This string is base64 encoded and then put into a Byte Array.
The PData_Blob variable is simply some kind of variable with 2 parts: one sets a length and second is a pointer to an array.
the Data_Blob variable is defined in WinCrypt.pas - a port from WinCrypt.H

Do you know Visual Basic? I'd pay $100 to anyone who could translate not even 10 lines of code into Delphi.

I appreciate the replies ;-)
0
 
Russell LibbySoftware Engineer, Advisory Commented:

First, to address the following:

>> thank you.. I guess it's like that.

Let me be clear.... it *IS*like that.

The "As Any" in VB translates to a pointer type declaration in C/C++/Delphi, not a variant like you had above. The stdcall was also missing on the function. And the second param, which is a PWideChar desc is required (null cannot be passed). I also know how the API works, and it doesn't require a base64 encoded string; the data can be anything you want, plaintext or otherwise. I also gave you the DATA_BLOB (and other) structure defs, so I am not sure why you are describing these things to me? And yes I know VB (and a half dozen other langs), but you don't need to pay anyone to do this for you, you just need to post the code to be translated, which is why I wrote:

>> I would need to see a code clip of what you are trying to do.

Which you did not provide. The only thing I can do at this point is to provide a Delphi example of both the en/decrypt functions. If you wish to provide the VB code, then I can help further.

Russell

---



unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

type
  TLargeByteArray      =  Array [0..Pred(MaxInt)] of Byte;
  PLargeByteArray      =  ^TLargeByteArray;

type
  _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}

// Helper functions for dealing with the blob structs
procedure FreeDataBlob(var Data: DATA_BLOB);
begin

  // Check pointer to data
  if Assigned(Data.pbData) then LocalFree(HLOCAL(Data.pbData));

  // Clear struct
  FillChar(Data, SizeOf(DATA_BLOB), 0);

end;

function GetDataBlobText(Data: DATA_BLOB): String;
begin

  // Check blob pointer
  if (Data.cbData > 0) and Assigned(Data.pbData) then
     // Set result string
     SetString(result, PChar(Data.pbData), Data.cbData)
  else
     // Set null result
     SetLength(result, 0);

end;

function SetDataBlobText(Text: String; var Data: DATA_BLOB): Boolean;
begin

  // Clear struct
  FillChar(Data, SizeOf(DATA_BLOB), 0);

  // Check passed text
  if (Length(Text) > 0) then
  begin
     // Allocate memory for text
     Data.pbData:=Pointer(LocalAlloc(LPTR, Succ(Length(Text))));
     // Check pointer
     if Assigned(Data.pbData) then
     begin
        // Copy data
        StrPCopy(PChar(Data.pbData), Text);
        // Set buffer length
        Data.cbData:=Length(Text);
        // Success
        result:=True;
     end
     else
        // Failed to allocate memory
        result:=False;
  end
  else
     // Nothing to copy over
     result:=True;

end;

// Encrypt and decrypt some data
procedure TForm1.Button1Click(Sender: TObject);
var  DataIn:        DATA_BLOB;
     DataOut:       DATA_BLOB;
     DataCheck:     DATA_BLOB;
     lpwszDesc:     PWideChar;
begin

  // Clear structs
  FillChar(DataIn, SizeOf(DATA_BLOB), 0);
  FillChar(DataOut, SizeOf(DATA_BLOB), 0);
  FillChar(DataCheck, SizeOf(DATA_BLOB), 0);

  // Set text to be encrypted
  if SetDataBlobText('Hello world this is a test!', DataIn) then
  begin
     // Resource protection
     try
        // Encrypt the data. NOTE: The description is REQUIRED and cannot be NULL per MSDN
        if CryptProtectData(@DataIn, PWideChar(WideString('Hello Test')), nil, nil, nil, 0, @DataOut) then
        begin
           // Display the encrypted data
           MessageBox(0, PChar(GetDataBlobText(DataOut)), PChar(Format('%d bytes returned', [DataOut.cbData])), MB_OK or MB_ICONINFORMATION);
           // Resource protection
           try
              // Unencrypt the data
              if CryptUnprotectData(@DataOut, lpwszDesc, nil, nil, nil, 0, @DataCheck) then
              begin
                 // Resource protection
                 try
                    // Display unencrypted text
                    MessageBox(0, PChar(GetDataBlobText(DataCheck)), PChar(String(WideString(lpwszDesc))), MB_OK or MB_ICONINFORMATION);
                 finally
                    // Clean up memory
                    LocalFree(HLOCAL(lpwszDesc));
                    FreeDataBlob(DataCheck);
                 end;
              end;
           finally
              // Clean up memory
              FreeDataBlob(DataIn);
           end;
        end;
     finally
        // Clean up memory
        FreeDataBlob(DataIn);
     end;
  end;

end;

end.
0
 
TonyJizCommented:
Russell,

You are definitely right. Sorry, I think I misunderstood you.

Your example is pretty much all I need. But if you are able to convert this VbCode (which should be easy since you know both well), then it's done:

-- Main --

Dim sUser As String
Dim sVal As String

sUser = Text1.Text    'Get the input (email address), for example: johnny@johnny.com

sVal = StdEncrypt(sUser & Chr$(0))      'Do the encryption, see this function below

BinaryValue(HKEY_CURRENT_USER, "Software\Program", "Result") = StrConv(sVal, vbFromUnicode)          'Write result as Binary to Key

-- StdEncrypt Function --

Public Function StdEncrypt(ByRef r_sData As String) As String
   
    Dim abytFileData()   As Byte
    Dim abytDataOut()    As Byte
    Dim udtDataOut      As DATA_BLOB
    Dim udtDataIn       As DATA_BLOB
    Dim udtPw           As DATA_BLOB
    Dim iFile           As Integer
    Dim sData As String
   
    sData = Base64_Encode(r_sData)
   
    If isNTKernel Then
        abytFileData = StrConv(sData, vbFromUnicode) & Chr$(0)
        MsgBox (abytFileData(1))
        udtDataIn.cbData = UBound(abytFileData) + 1
        udtDataIn.pbData = VarPtr(abytFileData(0))
       
        Call CryptProtectData(udtDataIn, "", ByVal vbNullString, ByVal vbNullString, ByVal vbNullString, 0, udtDataOut)
       
        ReDim abytDataOut(udtDataOut.cbData) As Byte
        Call CopyMemory(abytDataOut(0), ByVal udtDataOut.pbData, udtDataOut.cbData)
        StdEncrypt = Chr$(3) & Chr$(4) & StrConv(abytDataOut, vbUnicode)
       
    Else
        StdEncrypt = sData

    End If

End Function

---

That's it. So the result of all this is a Binary entry written to the Registry.
I would so appreciate it if you could translate the above code in Delphi.

Thank you alot,
0
 
TonyJizCommented:
Regarding the Base64 encode function that it calls...
I compared the result with Mime::Base64 module in Perl, and it's the same result. So it's really only encoding to Base64 in that function and not doing anything else with it.
0
 
Russell LibbySoftware Engineer, Advisory Commented:

Its going to take me some time (2 hours) to gve you a translation that captures the "true intent" of the above code, so please be patient. The above code is meant to work on all Win9X/NT based systems, so late binding is going to be required. And the encoding to Base64 is used as the "encryption" when running on systems less than Win2K (a check for NT is not enough). To be honest, the VB code listed above is extremely prone to errors, which is why I need a little bit of time to provide a clean/working example.

Regards,
Russell
0
 
TonyJixAuthor Commented:
I really appreciate your efforts!

I'm looking forward to the code, and please don't forget to include your paypal address since this solution is worth more than 500 points to me.

Thank you!
0
 
Russell LibbySoftware Engineer, Advisory Commented:

Couple of notes on the code first...

I don't check the system for being NT based, but instead attempt to loadlibrary/getprocaddress on the Crypt32 functions. By doing this, the application will run correctly regardless of crypt32.dll being available or not. If the crypt functions are not available, then the encode/decode routines will use base 64 encoding/decoding. Because there are a number of delphi source routines for base64 handling, I did not bother to write the routines but instead included (in the uses statement) the DIMime.pas unit. The source for that can be downloaded @:

http://www.zeitungsjunge.de/delphi/mime

The DIMime source files should be placed somewhere in Delphi's library path (..\LIB works well), or in the projects path in order to get this to compile. Feel free to replace the calls to MimeEncodeString / MimeDecodeString with whatever routines you want to use. The intent (of the VB code) was to provide some sort of encoding should the code be run on a system where the Crypto API was not available. When running on Win2K or above the code for alternative (base64) encoding will not get called.

Also, this site is not "rent a coder". If you feel the need to pay someone, go there and sure you find someone willing to accept your money <g>.

Example unit code and dfm are posted first, followed by the unit containing the encoding/decoding functions.

Russell

---- unit1.pas ----
unit Unit1;

interface

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

type
  TForm1         =  class(TForm)
     Button1:    TButton;
     Edit1:      TEdit;
     Button2:    TButton;
     procedure   Button1Click(Sender: TObject);
     procedure   Button2Click(Sender: TObject);
  private
     // Private declarations
  public
     // Public declarations
  end;

var
  Form1:         TForm1;

implementation
{$R *.DFM}

// Example to encrypt and store the data
procedure TForm1.Button1Click(Sender: TObject);
var  regCrypt:      TRegistry;
     szData:        String;
begin

  // Encrypt data
  szData:=CryptEncode(Edit1.Text);

  // Open / create registry key
  regCrypt:=TRegistry.Create;

  // Resource protection
  try
     regCrypt.RootKey:=HKEY_CURRENT_USER;
     regCrypt.OpenKey('Software\Program', True);
     if (Length(szData) = 0) then
        regCrypt.DeleteValue('Result')
     else
        regCrypt.WriteBinaryData('Result', szData[1], Length(szData));
  finally
     regCrypt.Free;
  end;

end;

// Example to load and decrypt the stored data
procedure TForm1.Button2Click(Sender: TObject);
var  regCrypt:      TRegistry;
     szData:        String;
     dwSize:        Integer;
begin

  // Open / create registry key
  regCrypt:=TRegistry.Create;

  // Resource protection
  try
     regCrypt.RootKey:=HKEY_CURRENT_USER;
     regCrypt.OpenKey('Software\Program', True);
     // Check the value
     if regCrypt.ValueExists('Result') then
     begin
        // Get data size
        dwSize:=regCrypt.GetDataSize('Result');
        // Check size
        if (dwSize > 0) then
        begin
           // Set data buffer size
           SetLength(szData, dwSize);
           // Read the binary data
           regCrypt.ReadBinaryData('Result', szData[1], dwSize);
           // Decrypt and show the data
           ShowMessage(CryptDecode(szData));
        end;
     end;
  finally
     regCrypt.Free;
  end;

end;

end.


---- unit1.dfm ----
object Form1: TForm1
  Left = 284
  Top = 114
  Width = 436
  Height = 243
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 16
    Top = 20
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Edit1: TEdit
    Left = 100
    Top = 24
    Width = 245
    Height = 21
    TabOrder = 1
    Text = #39'johnny@johnny.com'#39
  end
  object Button2: TButton
    Left = 16
    Top = 52
    Width = 75
    Height = 25
    Caption = 'Button2'
    TabOrder = 2
    OnClick = Button2Click
  end
end

---- CryptUtil.pas ----
unit CryptUtil;
////////////////////////////////////////////////////////////////////////////////
//
//   Unit        :  CryptUtil.pas
//   Author      :  rllibby
//   Date        :  06.05.2006
//   Description :  Sample unit that demonstrates using the Crypto API to
//                  (en/de)code data string values. If the Crypto API is not
//                  available, then Base64 encoding is used instead.
//
//   The DIMime.pas unit can be downloaded from:
//
//      http://www.zeitungsjunge.de/delphi/mime
//
////////////////////////////////////////////////////////////////////////////////
interface

////////////////////////////////////////////////////////////////////////////////
//   Include units
////////////////////////////////////////////////////////////////////////////////
uses
  Windows, SysUtils, DIMime;

////////////////////////////////////////////////////////////////////////////////
//   Constant declarations
////////////////////////////////////////////////////////////////////////////////
const
  CRYPT_HEADER      =  #3#4;
  CRYPT_LIBRARY     =  'Crypt32.dll';
  CRYPT_PROTECT     =  'CryptProtectData';
  CRYPT_UNPROTECT   =  'CryptUnprotectData';

////////////////////////////////////////////////////////////////////////////////
//   Type declarations
////////////////////////////////////////////////////////////////////////////////
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 prototypes
////////////////////////////////////////////////////////////////////////////////
type
  TCryptProtect     =  function(pDataIn:          PDATA_BLOB;
                                szDataDescr:      LPCWSTR;
                                pOptionalEntropy: PDATA_BLOB;
                                pReserved:        Pointer;
                                pPromptStruct:    PCRYPTPROTECT_PROMPTSTRUCT;
                                dwFlags:          DWORD;
                                pDataOut:         PDATA_BLOB): BOOL; stdcall;

  TCryptUnprotect   =  function(pDataIn:          PDATA_BLOB;
                                var ppszDataDescr:LPWSTR;
                                pOptionalEntropy: PDATA_BLOB;
                                pReserved:        Pointer;
                                pPromptStruct:    PCRYPTPROTECT_PROMPTSTRUCT;
                                dwFlags:          DWORD;
                                pDataOut:         PDATA_BLOB): BOOL; stdcall;


////////////////////////////////////////////////////////////////////////////////
//   Functions
////////////////////////////////////////////////////////////////////////////////
function   CryptEncode(Value: String): String;
function   CryptDecode(Value: String): String;

implementation

////////////////////////////////////////////////////////////////////////////////
//   Protected variables
////////////////////////////////////////////////////////////////////////////////
var
  hCryptLib:        THandle           =  0;
  CryptProtect:     TCryptProtect     =  nil;
  CryptUnprotect:   TCryptUnprotect   =  nil;

procedure FreeDataBlob(var Data: DATA_BLOB);
begin

  // Check pointer to data
  if Assigned(Data.pbData) then LocalFree(HLOCAL(Data.pbData));

  // Clear struct
  FillChar(Data, SizeOf(DATA_BLOB), 0);

end;

function GetDataBlobText(Data: DATA_BLOB): String;
begin

  // Check blob pointer
  if (Data.cbData > 0) and Assigned(Data.pbData) then
     // Set result string
     SetString(result, PChar(Data.pbData), Data.cbData)
  else
     // Set null result
     SetLength(result, 0);

end;

function SetDataBlobText(Text: String; var Data: DATA_BLOB): Boolean;
begin

  // Clear struct
  FillChar(Data, SizeOf(DATA_BLOB), 0);

  // Check passed text
  if (Length(Text) > 0) then
  begin
     // Allocate memory for text
     Data.pbData:=Pointer(LocalAlloc(LPTR, Succ(Length(Text))));
     // Check pointer
     if Assigned(Data.pbData) then
     begin
        // Set buffer length
        Data.cbData:=Length(Text);
        // Move data
        Move(Pointer(Text)^, Data.pbData^, Data.cbData);
        // Success
        result:=True;
     end
     else
        // Failed to allocate memory
        result:=False;
  end
  else
     // Nothing to copy over
     result:=True;

end;

function CryptDecode(Value: String): String;
var  DataIn:        DATA_BLOB;
     DataOut:       DATA_BLOB;
     lpwszDesc:     PWideChar;
begin

  // Check value
  if (Length(Value) = 0) then
     // No encoding
     result:=EmptyStr
  else
  begin
     // Check string header
     if not(Pos(CRYPT_HEADER, Value) = 1) then
        // Use Base64 decoding on the string
        result:=MimeDecodeString(Value)
     // Check function pointer
     else if Assigned(@CryptUnProtect) then
     begin
        // Clear structs
        FillChar(DataIn, SizeOf(DATA_BLOB), 0);
        FillChar(DataOut, SizeOf(DATA_BLOB), 0);
        // Set text to be decrypted
        if SetDataBlobText(Copy(Value, Succ(Length(CRYPT_HEADER)), MaxInt), DataIn) then
        begin
           // Resource protection
           try
              // Decrypt the data
              if CryptUnprotect(@DataIn, lpwszDesc, nil, nil, nil, 0, @DataOut) then
              begin
                 // Resource protection
                 try
                    // Set result string
                    result:=GetDataBlobText(DataOut);
                 finally
                    // Free memory
                    FreeDataBlob(DataOut);
                    LocalFree(HLOCAL(lpwszDesc));
                 end;
              end
              else
                 // Failure
                 SetLength(result, 0);
           finally
              // Free memory
              FreeDataBlob(DataIn);
           end;
        end
        else
           // Failure
           SetLength(result, 0);
     end
     else
        // Can't decrypt the value because the required function is not available
        SetLength(result, 0);
  end;

end;

function CryptEncode(Value: String): String;
var  DataIn:        DATA_BLOB;
     DataOut:       DATA_BLOB;
begin

  // Check value
  if (Length(Value) = 0) then
     // No encoding
     result:=EmptyStr
  else
  begin
     // Check function address
     if (@CryptProtect = nil) then
        // Use Base64 encoding on the string
        result:=MimeEncodeString(Value)
     else
     begin
        // Clear structs
        FillChar(DataIn, SizeOf(DATA_BLOB), 0);
        FillChar(DataOut, SizeOf(DATA_BLOB), 0);
        // Set text to be encrypted
        if SetDataBlobText(Value, DataIn) then
        begin
           // Resource protection
           try
              // Encrypt the data
              if CryptProtect(@DataIn, PWideChar(WideString(#0)), nil, nil, nil, 0, @DataOut) then
              begin
                 // Resource protection
                 try
                    // Set result string
                    result:=CRYPT_HEADER+GetDataBlobText(DataOut);
                 finally
                    // Free memory
                    FreeDataBlob(DataOut);
                 end;
              end
              else
                 // Failure
                 SetLength(result, 0);
           finally
              // Free memory
              FreeDataBlob(DataIn);
           end;
        end
        else
           // Failure
           SetLength(result, 0);
     end;
  end;

end;

initialization

  // Attempt to load the library
  hCryptLib:=LoadLibrary(CRYPT_LIBRARY);

  // Check library handle
  if (hCryptLib <> 0) then
  begin
     // Attempt to bind to the crypt functions
     @CryptProtect:=GetProcAddress(hCryptLib, CRYPT_PROTECT);
     @CryptUnprotect:=GetProcAddress(hCryptLib, CRYPT_UNPROTECT);
  end;

finalization

  // Clear function pointers
  @CryptProtect:=nil;
  @CryptUnprotect:=nil;

  // Check library handle
  if (hCryptLib <> 0) then
  begin
     // Unload the library
     FreeLibrary(hCryptLib);
     // Clear handle
     hCryptLib:=0;
  end;

end.
0
 
TonyJixAuthor Commented:
Absolutely superb. I have nothing else to say about this quality stuff.

You have no idea how much you helped me. Thank you very much. Great stuff.
0
 
Russell LibbySoftware Engineer, Advisory Commented:

Very glad to have helped,
Russell
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 5
  • 5
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now