pgpkeygenerate.pas

来自「用DELPHI实现的 PGP 加密算法」· PAS 代码 · 共 659 行 · 第 1/2 页

{$J+,Z4}
unit PGPKeyGenerate;

{------------------------------------------------------------------------------}
{                                                                              }
{                 This unit is partly based on Steve Heller's                  }
{         SPGP sources available from http://www.oz.net/~srheller/spgp/        }
{                                                                              }
{                Portions created by Michael in der Wiesche are                }
{              Copyright (C) 2001-2003 by Michael in der Wiesche               }
{                                                                              }
{------------------------------------------------------------------------------}

interface

uses
  Windows,
  Classes,
  SysUtils,
  KeyPropTypes,
  UTF8,
  pgpBase,
  pgpErrors,
  pgpPubTypes,
  pgpUtilities,
  pgpOptionList,
  pgpRandomPool,
  pgpMemoryMgr,
  pgpEvents,
  pgpKeys,
  pgpTLS,
  pgpUI,
  pgpSC,
  KeyFuncs,
  PrefFuncs,
  PGPDialogs;

type
  TKeySize = 512..2048;
  TSubKeySize = 512..4096;
  TMinPassLen = 0..255;
  TMinPassQual = 0..100;
  TCipherCount = 0..ord(high(TCipherAlgorithm));

  TOnEnterPassphrase = procedure(const Passphrase: PChar; const MasterKeyProps: TKeyPropsRec;
				 MinPassLen: TMinPassLen; MinPassQual: TMinPassQual;
				 var Cancel: Longbool) of Object;
  TOnGetUserNameAddress = procedure(var UserName, EmailAddress: String) of Object;
  TOnKeyGeneration = procedure(const NewHexID: String; MasterKeyProps: TKeyPropsRec; Aborted: Longbool) of Object;
  TOnShowState = procedure(State: Char; var Cancel: Longbool) of Object;
  TPGPKeysGenerateCustom = Class(TComponent)
  private
    FAborted: Longbool;
    FContext: pPGPContext;
    FKeySetMain: pPGPKeySet;
    FPubKeyAlgorithm: TKeyAlgorithm;
    FCipherAlgorithm: TCipherAlgorithm;
    FCipherAlgorithmList: Array[TCipherCount] of TCipherAlgorithm;
    FExpires: Longint;
    FFastGenerate: Longbool;
    FFailNoEntropy: Longbool;
    FLegacyKey: Longbool;
    FMinPassLen: TMinPassLen;
    FMinPassQual: TMinPassQual;
    FPassphrase: PChar;
    FUserID: String;
    FNewHexID: String;
    FUserName: String;
    FEmailAddress: String;
    FMasterKeyHexID: String;
    FNewKeyHexID: String;
    FNewSubKeyHexID: String;
    FKeySize: TKeySize;
    FSubKeySize: TSubKeySize;
    FParentHandle: THandle;
    FKeyDlgPrompt: String;
    FPassDlgPrompt: String;
    FOnEnterPassphrase: TOnEnterPassphrase;
    FOnGetUserNameAddress: TOnGetUserNameAddress;
    FOnKeyGeneration: TOnKeyGeneration;
    FOnShowState: TOnShowState;
    function InitKeyGen: PGPError;
    procedure FinitKeyGen(var Result: PGPError);
    function GetUserID: String;
    function GetMasterKeyHexID: Longint;
    function GetUserNameAddress: Longint;
    function GetPassphrase(OfMasterKey: Longbool): PGPError;
    function GetEntropy(IncludeSubKey: Longbool): PGPError;
    function KeyGenerate(IncludeSubKey: Longbool): PGPError;
    function SubKeyGenerate(ForOldMasterKey: Longbool): PGPError;
  protected
    procedure SetUserName(const Name: String);
    procedure SetEmailAddress(const Address: String);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetCipherAlgPrefs(const CipherAlgList: Array of TCipherAlgorithm);
    function DHDSSKeyGenerate: Longint; virtual;
    function DHSubKeyGenerate: Longint; virtual;
    function DSAKeyGenerate: Longint; virtual;
    function RSASubKeyGenerate: Longint; virtual;
    function RSAKeyGenerate(Legacy: Longbool): Longint; virtual;
    property ParentHandle: THandle
      read FParentHandle
      write FParentHandle;
  published
    property CipherAlgorithm: TCipherAlgorithm
      read FCipherAlgorithm
      write FCipherAlgorithm;
    property Expires: Longint
      read FExpires
      write FExpires;
    property FastGenerate: Longbool
      read FFastGenerate
      write FFastGenerate;
    property FailNoEntropy: Longbool
      read FFailNoEntropy
      write FFailNoEntropy;
    property MinPassLen: TMinPassLen
      read FMinPassLen
      write FMinPassLen;
    property MinPassQual: TMinPassQual
      read FMinPassQual
      write FMinPassQual;
    property UserName: String
      read FUserName
      write SetUserName;
    property EmailAddress: String
      read FEmailAddress
      write SetEmailAddress;
    property MasterKeyHexID: String
      read FMasterKeyHexID
      write FMasterKeyHexID;
    property KeySize: TKeySize
      read FKeySize
      write FKeySize;
    property SubKeySize: TSubKeySize
      read FSubKeySize
      write FSubKeySize;
    property KeyDlgPrompt: String
      read FKeyDlgPrompt
      write FKeyDlgPrompt;
    property PassDlgPrompt: String
      read FPassDlgPrompt
      write FPassDlgPrompt;
    property OnEnterPassphrase: TOnEnterPassphrase
      read FOnEnterPassphrase
      write FOnEnterPassphrase;
    property OnGetUserNameAddress: TOnGetUserNameAddress
      read FOnGetUserNameAddress
      write FOnGetUserNameAddress;
    property OnKeyGeneration: TOnKeyGeneration
      read FOnKeyGeneration
      write FOnKeyGeneration;
    property OnShowState: TOnShowState
      read FOnShowState
      write FOnShowState;
  end;

implementation

function EventHandler(Context: pPGPContext; Event: pPGPEvent; UserValue: PGPUserValue): PGPError; cdecl;
var
  Cancel	: Longbool;
begin
  Result:=0;
  Cancel:=false;
  with TPGPKeysGenerateCustom(UserValue) do begin
    case Event^.EType of
      kPGPEvent_KeyGenEvent: begin
	if TMethod(FOnShowState).Code<>nil then with Event^.EData.KeyGenData do begin
	  FOnShowState(chr(State), Cancel);
	  if Cancel then begin
	    Result:=kPGPError_UserAbort;
	    FAborted:=true;
	  end;
	end;
	ProcessMessages;
      end;
    end;
  end;
end;

constructor TPGPKeysGenerateCustom.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFastGenerate:=true;
  FMinPassLen:=10;
  FMinPassQual:=100;
  FKeySize:=1024;
  FSubKeySize:=1024;
end;

destructor TPGPKeysGenerateCustom.Destroy;
begin
  inherited Destroy;
end;

function TPGPKeysGenerateCustom.InitKeyGen: PGPError;
begin
  FUserID:='';
  FNewHexID:='';
  FAborted:=false;
  FLegacyKey:=true;
  FPassphrase:=nil;
  FNewKeyHexID:='';
  FNewSubKeyHexID:='';
  Result:=KeyRings.InitKeyRings(FContext, FKeySetMain);
end;

procedure TPGPKeysGenerateCustom.FinitKeyGen(var Result: PGPError);
var
  KeyPropsList	: TKeyPropsList;
begin
  PGPFreeData(FPassphrase);
  KeyRings.FreeKeyRings;
  try
    if not FAborted then begin
      KeyPropsList:=nil;
      FindKeyProps(FMasterKeyHexID, KeyPropsList,
		   spgpKeyPropFlag_IDComplete,
		   KeyFilterFlag_CanSign,
		   Any_Ordering);
    end
    else Result:=kPGPError_UserAbort;
    if Assigned(FOnKeyGeneration) then FOnKeyGeneration(FNewHexID, pKeyPropsRec(KeyPropsList.Objects[0])^, Result<>0);
  finally
    KeyPropsList.Free;
  end;
end;

procedure TPGPKeysGenerateCustom.SetUserName(const Name: String);
var
  ErrorStr	: String;
begin
  if Name<>FUserName then begin
    if pos('@', Name)=0 then
      FUserName:=Trim(Name)
    else begin
      SetLength(ErrorStr, 255);
      PGPGetErrorString(kPGPError_BadParams, 255, PChar(ErrorStr));
      SetLength(ErrorStr, StrLen(PChar(ErrorStr)));
      MessageBox(FParentHandle, PChar(ErrorStr + ': ' + Name), 'PGP', MB_ICONERROR);
    end;
  end;
end;

procedure TPGPKeysGenerateCustom.SetEmailAddress(const Address: String);
var
  ErrorStr	: String;
begin
  if Address<>FEmailAddress then begin
    if (Address='') or (pos('@', Address)<>0) then
      FEmailAddress:=Trim(Address)
    else begin
      SetLength(ErrorStr, 255);
      PGPGetErrorString(kPGPError_BadParams, 255, PChar(ErrorStr));
      SetLength(ErrorStr, StrLen(PChar(ErrorStr)));
      MessageBox(FParentHandle, PChar(ErrorStr + ': ' + Address), 'PGP', MB_ICONERROR);
    end;
  end;
end;

function TPGPKeysGenerateCustom.GetUserID: String;
begin
  if FEmailAddress<>'' then begin
    Result:='<' + FEmailAddress + '>';
    if FUserName<>'' then Result:=FUserName + ' ' + Result;
  end
  else Result:=FUserName;
end;

function TPGPKeysGenerateCustom.GetMasterKeyHexID: Longint;
var
  KeyPropsList	: TKeyPropsList;
begin
  KeyPropsList:=nil;
  try
    Result:=FindKeyProps(FMasterKeyHexID,
			 KeyPropsList,
			 spgpKeyPropFlag_KeyID,
			 KeyFilterFlag_CanSign or KeyFilterFlag_V4,
			 Any_Ordering);
    if Result=0 then begin
      Result:=kPGPError_SecretKeyNotFound;
      Exit;
    end
    else if Result<>1 then begin
      if KeyPropsList<>nil then KeyPropsList.Clear;
      Result:=SelectKeysDialog(FKeyDlgPrompt, KeyPropsList, true, spgpKeyPropFlag_KeyID,
			       KeyFilterFlag_CanSign or KeyFilterFlag_V4, FParentHandle);
      if Result=0 then FMasterKeyHexID:=KeyPropsList.Strings[0];
    end
    else begin
      FMasterKeyHexID:=KeyPropsList.Strings[0];
      Result:=0;
    end;
  finally
    KeyPropsList.Free;
  end;
end;

function TPGPKeysGenerateCustom.GetUserNameAddress: Longint;
begin
  Result:=0;
  if (FUserName='') or (FEmailAddress='') then begin
    if Assigned(FOnGetUserNameAddress) then FOnGetUserNameAddress(FUserName, FEmailAddress);
  end;
  if FUserName='' then Result:=kPGPError_BadParams;
end;

function TPGPKeysGenerateCustom.GetPassphrase(OfMasterKey: Longbool): PGPError;
var
  Cancel	: Longbool;
  KeySetFound	: pPGPKeySet;
  PassBufSize	: Cardinal;
  PassLength	: Longint;
  KeyPropsRec	: TKeyPropsRec;
  KeyPropsList	: TKeyPropsList;
begin
  Result:=0;
  Cancel:=false;
  KeySetFound:=nil;
  PassBufSize:=MaxUTF8Length;
  if Assigned(FOnEnterPassphrase) then begin
    FillChar(KeyPropsRec, SizeOf(TKeyPropsRec), 0);
    KeyPropsList:=nil;
    try
      if OfMasterKey then begin
	if FindKeyProps(FMasterKeyHexID, KeyPropsList, spgpKeyPropFlag_IDComplete,