testunit.pas

用DELPHI实现的 PGP 加密算法

{$A+,B-,C-,D+,E-,F-,G+,H+,I+,J+,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z4}
{$MINSTACKSIZE $00004000}
{$MAXSTACKSIZE $00100000}
{$IMAGEBASE $00400000}
{$APPTYPE GUI}

// huge strings enabled!

unit TestUnit;

{
This sample provides code for implementing some of the PGP functions using
the TPGP-components provided with PGPcomp. It's been written carefully
to avoid any problems that might compromise running systems, but
it doesn't contain a sufficient error handling for every possible situation
as it only should serve for demonstration purposes. So be careful when using
parts of it in your own applications.

Michael in der Wiesche, March 17th, 2002
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls, PGP2Comp, pgpKeyGenerate, pgpEncode, pgpDecode, KeyPropTypes;

type
  TPGPDemo = class(TForm)
    pnFrame: TPanel;
    reResults: TRichEdit;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    PGPPreferences: TPGPPreferences;
    PGPKeyServer: TPGPKeyServer;
    PGPGetKeyProps: TPGPGetKeyProps;
    PGPSetKeyProps: TPGPSetKeyProps;
    PGPKeysGenerate: TPGPKeysGenerate;
    PGPKeyImport: TPGPKeyImport;
    PGPKeyExport: TPGPKeyExport;
    PGPEncode: TPGPEncode;
    PGPDecode: TPGPDecode;
    cbxUserIDs: TComboBox;
    btnKeyGenerate: TButton;
    btnEncode: TButton;
    btnDecode: TButton;
    btnExportKey: TButton;
    btnImportKey: TButton;
    btnFingerprint: TButton;
    procedure FormActivate(Sender: TObject);
    procedure cbxUserIDsChange(Sender: TObject);
    procedure PGPFailure(ErrorCode: Longint; const ErrorMsg: string);
    procedure ShowCodingProgress(BytesProcessed, BytesTotal: Longint);
    procedure btnEncodeClick(Sender: TObject);
    procedure PGPEncodeGetInputFileName(var SuggestedName: string);
    procedure PGPEncodeGetOutputFileName(var SuggestedName: string);
    procedure PGPEncodeEncoded(const BufferOut, FileOut: string);
    procedure btnDecodeClick(Sender: TObject);
    procedure PGPDecodeGetInputFileName(var SuggestedName: string);
    procedure PGPDecodeGetOutputFileName(var SuggestedName: string);
    procedure PGPDecodeDecoded(const BufferOut, FileOut: string;
			       const SigPropsRec: TSigPropsRec;
			       const KeyPropsList: TKeyPropsList);
    procedure btnExportKeyClick(Sender: TObject);
    procedure PGPKeyExportKeyExported(const KeyPropsList: TKeyPropsList; const KeyData, FileOut: string);
    procedure btnImportKeyClick(Sender: TObject);
    procedure PGPKeyImportGetFileIn(var FileIn: string);
    procedure PGPKeyImportKeyImported(const KeyPropsList: TKeyPropsList; KeysImported: Longint);
    procedure btnFingerprintClick(Sender: TObject);
    procedure PGPGetKeyPropsGetKeyProps(const RingPropsList: TKeyPropsList);
    procedure btnKeyGenerateClick(Sender: TObject);
    procedure PGPKeysGenerateShowState(State: Char; var Cancel: Longbool);
    procedure PGPKeysGenerateKeyGeneration(const NewHexID: string; MasterKeyProps: TKeyPropsRec; Aborted: Longbool);
  private
    sDots: String;
    procedure UpdateComboBox;
    procedure AppOnMessage(var Msg: TMsg; var Handled: Boolean);
  public
  end;

var
  PGPDemo: TPGPDemo;

const
  E = '';
  SP = ' ';
  CR = #13;
  LF = #10;
  DOT = '.';
  CRLF = #13#10;
  LFLF = #10#10;

implementation

{$R *.DFM}

// update ID lists on keyring changes

procedure TPGPDemo.UpdateComboBox;
var PreviousCursor: TCursor;
begin
  Application.ProcessMessages;
  PreviousCursor:=Screen.Cursor;
  Screen.Cursor:=crHourGlass;
  PGPGetKeyProps.Update;
  with cbxUserIDs do if Items.Count<>0 then begin
    ItemIndex:=0;
    Hint:=GetShortHexID(PGPGetKeyProps.RingPropsList.Strings[ItemIndex]);
  end;
  Screen.Cursor:=PreviousCursor;
end;

procedure TPGPDemo.AppOnMessage(var Msg: TMsg; var Handled: Boolean);
begin
  with Msg do begin
    if (Message=WM_PGP_ReloadPrefs) or (Message=WM_PGP_ReloadKeyring) then
      UpdateComboBox
    else inherited;
  end;
end;

// initialize and load ID lists

procedure TPGPDemo.FormActivate(Sender: TObject);
begin
  Application.OnMessage:=AppOnMessage;
  UpdateComboBox;
end;

// show hex ID as hint

procedure TPGPDemo.cbxUserIDsChange(Sender: TObject);
begin
  with cbxUserIDs do if ItemIndex<>-1 then
    Hint:=GetShortHexID(PGPGetKeyProps.RingPropsList.Strings[ItemIndex])
  else Hint:=E;
end;

// common FailProc for PGPErrors

procedure TPGPDemo.PGPFailure(ErrorCode: Longint; const ErrorMsg: string);
begin
  MessageDlg(ErrorMsg + ' (' + IntToStr(ErrorCode) + ')', mtError, [mbOK], 0);
end;

// show coding progress

procedure TPGPDemo.ShowCodingProgress(BytesProcessed, BytesTotal: Longint);
begin
  reResults.Text:='Progress: ' + IntToStr(round(BytesProcessed*100/BytesTotal)) + '%';
end;

// start encoding process

procedure TPGPDemo.btnEncodeClick(Sender: TObject);
begin
  with reResults do begin
    Clear;
    Refresh;
    Alignment:=taLeftJustify;
  end;
  PGPEncode.SignKeyID:=E;
  PGPEncode.OutputFileName:=E;
  PGPEncode.EncryptKeyIDs.Clear;
  PGPEncode.KeyEncryptFile(E, true);
end;

// select DataFile for encryption

procedure TPGPDemo.PGPEncodeGetInputFileName(var SuggestedName: string);
begin
  with OpenDialog do begin
    FileName:=SuggestedName;
    Title:='Open file to encode:';
    InitialDir:=ExtractFilePath(FileName);
    if InitialDir=E then InitialDir:=ExtractFilePath(Application.ExeName);
    Filter:='All Files (*.*)|*.*';
    if Execute then
      SuggestedName:=FileName
    else SuggestedName:=E;
  end;
  Refresh;
end;

// select OutputFile for encrypted/signed data

procedure TPGPDemo.PGPEncodeGetOutputFileName(var SuggestedName: string);
begin
  with SaveDialog do begin
    FileName:=SuggestedName;
    Title:='Select file for encrypted data:';
    InitialDir:=ExtractFilePath(FileName);
    if InitialDir=E then InitialDir:=ExtractFilePath(Application.ExeName);
    Filter:='PGP Files (*.pgp)|*.pgp|All Files (*.*)|*.*';
    if Execute then
      SuggestedName:=FileName
    else SuggestedName:=E;
  end;
  Refresh;
end;

// show name of file containing encoded data

procedure TPGPDemo.PGPEncodeEncoded(const BufferOut, FileOut: string);
begin
  with reResults, Lines do begin
    SetFocus;
    Text:='Encoded data in file ' + LFLF + '"' + FileOut + '"';
  end;
  PGPEncode.EncryptKeyIDs.Clear;
end;

// start decoding process

procedure TPGPDemo.btnDecodeClick(Sender: TObject);
begin
  with reResults do begin
    Clear;
    Refresh;
    Alignment:=taLeftJustify;
  end;
  PGPDecode.OutputFileName:=E;
  PGPDecode.DecodeFile(E);
  Invalidate;
end;

// select DataFile for decoding

procedure TPGPDemo.PGPDecodeGetInputFileName(var SuggestedName: string);
begin
  with OpenDialog do begin
    FileName:=SuggestedName;
    Title:='Open file to decode:';
    FileName:=SuggestedName;
    InitialDir:=ExtractFilePath(FileName);
    if InitialDir=E then InitialDir:=ExtractFilePath(Application.ExeName);
    Filter:='PGP Files (*.asc, *.pgp, *.sig)|*.asc;*.pgp;*.sig|All Files (*.*)|*.*';
    if Execute then
      SuggestedName:=FileName
    else SuggestedName:=E;
  end;
  Refresh;
end;

// select OutputFile for decrypted/verified data

procedure TPGPDemo.PGPDecodeGetOutputFileName(var SuggestedName: string);
begin
  with SaveDialog do begin
    FileName:=SuggestedName;
    Title:='Select file for decoded data:';
    FileName:=SuggestedName;
    InitialDir:=ExtractFilePath(FileName);
    if InitialDir=E then InitialDir:=ExtractFilePath(Application.ExeName);
    Filter:='All Files (*.*)|*.*';
    if Execute then
      SuggestedName:=FileName
    else SuggestedName:=E;
  end;
  Refresh;
end;

// show decoded data and signature status on success

procedure TPGPDemo.PGPDecodeDecoded(const BufferOut, FileOut: string;
				    const SigPropsRec: TSigPropsRec;
				    const KeyPropsList: TKeyPropsList);
begin
  if BufferOut<>E then with reResults, Lines do begin
    SetFocus;
    Text:=BufferOut;
  end;
end;

// start extracting keys

procedure TPGPDemo.btnExportKeyClick(Sender: TObject);
begin
  with reResults do begin
    Clear;
    Refresh;
    Alignment:=taLeftJustify;
  end;
  PGPKeyExport.FileOut:=E;
  PGPKeyExport.DoKeyExport;
  Invalidate;
end;

// show number and data of exported keys on success

procedure TPGPDemo.PGPKeyExportKeyExported(const KeyPropsList: TKeyPropsList; const KeyData, FileOut: string);
begin
  with reResults do begin
    SetFocus;
    Text:=IntToStr(KeyPropsList.Count) + ' exported key(s):' + LFLF + KeyData;
  end;
end;

// start importing keys

procedure TPGPDemo.btnImportKeyClick(Sender: TObject);
begin
  with reResults do begin
    Clear;
    Refresh;
    Alignment:=taLeftJustify;
  end;
  PGPKeyImport.FileIn:=E;
  PGPKeyImport.KeyData:=E;
  PGPKeyImport.DoKeyImportFile;
  Invalidate;
end;


// select file containing KeyData

procedure TPGPDemo.PGPKeyImportGetFileIn(var FileIn: string);
begin
  with OpenDialog do begin
    Title:='Open a key file:';
    InitialDir:=ExtractFilePath(Application.ExeName);
    Filter:='Key files (*.asc, *.pgp)|*.asc;*.pgp|All Files (*.*)|*.*';
    if Execute then FileIn:=FileName;
  end;
  Refresh;
end;

// show UserIDs of imported key(s)

procedure TPGPDemo.PGPKeyImportKeyImported(const KeyPropsList: TKeyPropsList; KeysImported: Longint);
var KeyCount: Integer;
begin
  with reResults do begin
    SetFocus;
    Text:='The following key(s) have been successfully imported:' + LFLF;
    for KeyCount:=0 to pred(KeyPropsList.Count) do begin
      Lines.Add(KeyPropsList.KeyProps[KeyCount].kUserID + ' (' + KeyPropsList.KeyProps[KeyCount].kHexID + ')');
    end;
  end;
end;

// get fingerprint of selected key

procedure TPGPDemo.btnFingerprintClick(Sender: TObject);
begin
  reResults.Clear;
  reResults.Refresh;
  if cbxUserIDs.ItemIndex<>-1 then begin
    Application.ProcessMessages;
    with PGPGetKeyProps do begin
      KeyID:=RingPropsList.KeyProps[cbxUserIDs.ItemIndex].kHexID;
      KeyProps:=KeyProps_IDFlags + [KeyProp_Fingerprint];
      DoGetKeyProps;
    end;
  end;
end;

// show selected KeyProps on success

procedure TPGPDemo.PGPGetKeyPropsGetKeyProps(const RingPropsList: TKeyPropsList);
begin
  if RingPropsList.Count<>0 then begin
    with reResults do begin
      Clear;
      Refresh;
      Alignment:=taCenter;
    end;
    with RingPropsList, KeyProps[0] do begin
      if ValidProps=KeyProps_IDFlags + [KeyProp_Fingerprint] then begin
	reResults.Text:=kUserID + ' (' + kHexID + ')' + LFLF + kFingerprint;
      end;
    end;
  end;
end;

// generate DH/DSS key

procedure TPGPDemo.btnKeyGenerateClick(Sender: TObject);
begin
  sDots:=DOT;
  with reResults do begin
    Clear;
    Refresh;
    Alignment:=taLeftJustify;
  end;
  reResults.Text:='Generating key:' + CRLF;
  PGPKeysGenerate.DHDSSKeyGenerate;
  Invalidate;
end;

// show progress of key generation

procedure TPGPDemo.PGPKeysGenerateShowState(State: Char; var Cancel: Longbool);
begin
  with reResults.Lines do begin
    reResults.Lines[1]:=sDots;
  end;
  sDots:=sDots + DOT;
end;

// show results of key generation

procedure TPGPDemo.PGPKeysGenerateKeyGeneration(const NewHexID: string; MasterKeyProps: TKeyPropsRec; Aborted: Longbool);
begin
  if not Aborted then with MasterKeyProps do begin
    case kAlgorithm of
      KeyAlgorithm_RSA: reResults.Text:='New RSA key: ' + kUserID + ' (' + kHexID + ')';
      KeyAlgorithm_DHDSS: reResults.Text:='New DH/DSS key: ' + kUserID + ' (' + kHexID + ')';
    end;
  end
  else reResults.Text:='Key generation aborted';
end;

end.