mainform.pas

著名的SecureBlackBox控件完整源码

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ActnList, ComCtrls, ToolWin, Menus, SBPGPKeys, SBPGPUtils,
  SBUtils, SBPGPConstants, ImgList, ExtCtrls, StdCtrls,
  PassphraseRequestForm, AboutForm, ImportKeyForm;

type
  TfrmKeys = class(TForm)
    mnuMain: TMainMenu;
    mniFile: TMenuItem;
    tbrMain: TToolBar;
    sbrMain: TStatusBar;
    tvKeyring: TTreeView;
    aclMain: TActionList;
    actOpenKeyring: TAction;
    pgpKeyring: TElPGPKeyring;
    mniOpenKeyring: TMenuItem;
    actSaveKeyring: TAction;
    actNewKeyring: TAction;
    mniNewKeyring: TMenuItem;
    mniSaveKeyring: TMenuItem;
    N1: TMenuItem;
    mniExit: TMenuItem;
    actExit: TAction;
    actRemoveKey: TAction;
    actSign: TAction;
    mnuKeys: TPopupMenu;
    NewKey2: TMenuItem;
    N3: TMenuItem;
    Sign2: TMenuItem;
    DeleteKey2: TMenuItem;
    imgToolbar: TImageList;
    ToolBar1: TToolBar;
    tbNewKeyring: TToolButton;
    tbLoadKeyring: TToolButton;
    tbSaveKeyring: TToolButton;
    tbGenerate: TToolButton;
    tbAddKey: TToolButton;
    tbRemoveKey: TToolButton;
    tbExportKey: TToolButton;
    tbSign: TToolButton;
    tbRevoke: TToolButton;
    tbDelim1: TToolButton;
    tbDelim2: TToolButton;
    tbDelim3: TToolButton;
    tbDelim4: TToolButton;
    mniHelp: TMenuItem;
    mniAbout: TMenuItem;
    pInfo: TPanel;
    imgTreeView: TImageList;
    pKeyInfo: TPanel;
    lbKeyAlgorithm: TLabel;
    lbKeyID: TLabel;
    lbKeyFP: TLabel;
    lbTimeStamp: TLabel;
    lbExpires: TLabel;
    lbTrust: TLabel;
    pSigInfo: TPanel;
    lbSigType: TLabel;
    lbSigner: TLabel;
    lbSigCreated: TLabel;
    lbValidity: TLabel;
    pUserInfo: TPanel;
    lbUserName: TLabel;
    picUser: TImage;
    actGenerateKey: TAction;
    actAddKey: TAction;
    OpenDlg: TOpenDialog;
    actExportKey: TAction;
    SaveDlg: TSaveDialog;
    actRevoke: TAction;
    actAbout: TAction;
    Revoke1: TMenuItem;
    procedure actOpenKeyringExecute(Sender: TObject);
    procedure actSaveKeyringExecute(Sender: TObject);
    procedure actNewKeyringExecute(Sender: TObject);
    procedure actExitExecute(Sender: TObject);
    procedure actRemoveKeyExecute(Sender: TObject);
    procedure actRemoveKeyUpdate(Sender: TObject);
    procedure actSignUpdate(Sender: TObject);
    procedure actSignExecute(Sender: TObject);
    procedure tvKeyringChange(Sender: TObject; Node: TTreeNode);
    procedure actGenerateKeyExecute(Sender: TObject);
    procedure actAddKeyExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure actExportKeyExecute(Sender: TObject);
    procedure actRevokeExecute(Sender: TObject);
    procedure actAboutExecute(Sender: TObject);
  private
    FPubKeyringFileName: string;
    FSecKeyringFileName: string;

    function SignUser(user: TElPGPCustomUser; userKey: TElPGPCustomPublicKey; signingKey: TElPGPSecretKey): TElPGPSignature;
    function RevokeUser(user: TElPGPCustomUser; userKey: TElPGPCustomPublicKey; signingKey: TElPGPSecretKey): TElPGPSignature;

    function RequestPassphrase(Key: TElPGPPublicKey): string;

    procedure SetStatus(s: string);

    procedure DrawPublicKeyProps(key: TElPGPCustomPublicKey);
    procedure DrawUserIDProps(user: TElPGPUserID);
    procedure DrawUserAttrProps(user: TElPGPUserAttr);
    procedure DrawSignatureProps(sig: TElPGPSignature; user: TElPGPCustomUser; userKey: TElPGPCustomPublicKey); overload;
    procedure DrawSignatureProps(sig: TElPGPSignature; subkey: TElPGPPublicSubkey; userKey: TElPGPCustomPublicKey); overload;

    procedure HideAllInfoPanels();
    procedure EnableView(p: TPanel);
  public
    property PubKeyringFileName: string read FPubKeyringFileName write FPubKeyringFileName;
    property SecKeyringFileName: string read FSecKeyringFileName write FSecKeyringFileName;
  end;

var
  frmKeys: TfrmKeys;

implementation

uses
  Keyring, Wizard, Keys;

{$R *.dfm}

function KeyIDToString(const KeyID: TSBKeyID): String;
begin
  Result := Format('0x%.2X%.2X%.2X%.2X', [KeyID[4], KeyID[5],
    KeyID[6], KeyID[7]]);
end;

function PubKeyAlgToString(Alg: Integer): String;
begin
  case Alg of
    SB_PGP_ALGORITHM_PK_RSA: Result := 'RSA';
    SB_PGP_ALGORITHM_PK_RSA_ENCRYPT: Result := 'RSA';
    SB_PGP_ALGORITHM_PK_RSA_SIGN: Result := 'RSA';
    SB_PGP_ALGORITHM_PK_ELGAMAL_ENCRYPT: Result := 'ElGamal';
    SB_PGP_ALGORITHM_PK_DSA: Result := 'DSS';
    SB_PGP_ALGORITHM_PK_ELGAMAL: Result := 'ElGamal';
  else
    Result := 'Unknown';
  end;
end;

function GetDefaultUserID(Key: TElPGPPublicKey): string;
begin
  if (Key.UserIDCount > 0) then
    Result := Key.UserIDs[0].Name
  else
    Result := 'No name';
end;

procedure RedrawKeyring(tv: TTreeView; Keyring: TElPGPKeyring);
var
  i, j, k: Integer;
  KeyNode, UserNode, SubKeyNode, SigNode: TTreeNode;
begin
  tv.Items.BeginUpdate();

  try
  tv.Items.Clear();
  for i := 0 to Keyring.PublicCount - 1 do
  begin
    // Creating key node
    KeyNode := tv.Items.Add(nil, GetDefaultUserID(keyring.PublicKeys[i]));
    KeyNode.Data := Keyring.PublicKeys[i];
    if ((Keyring.PublicKeys[i].PublicKeyAlgorithm = SB_PGP_ALGORITHM_PK_RSA) or
        (Keyring.PublicKeys[i].PublicKeyAlgorithm = SB_PGP_ALGORITHM_PK_RSA_ENCRYPT) or
        (Keyring.PublicKeys[i].PublicKeyAlgorithm = SB_PGP_ALGORITHM_PK_RSA_SIGN)) then
      KeyNode.ImageIndex := 1
    else
      KeyNode.ImageIndex := 0;

    KeyNode.SelectedIndex := KeyNode.ImageIndex;
    if (Keyring.PublicKeys[i].SecretKey <> nil) then
    begin
      // KeyNode.NodeFont = new Font(this.Font, FontStyle.Bold);
    end;

    if (Keyring.PublicKeys[i].Revoked) then
    begin
      // KeyNode.NodeFont = new Font(tv.Font, FontStyle.Italic);
    end;

    // Creating user nodes
    for j := 0 to Keyring.PublicKeys[i].UserIDCount - 1 do
    begin
      UserNode := tv.Items.AddChild(KeyNode, Keyring.PublicKeys[i].UserIDs[j].Name);
      UserNode.Data := Keyring.PublicKeys[i].UserIDs[j];
      UserNode.ImageIndex := 2;
      UserNode.SelectedIndex := 2;

      // Creating signature nodes
      for k := 0 to Keyring.PublicKeys[i].UserIDs[j].SignatureCount - 1 do
      begin
        if (Keyring.PublicKeys[i].UserIDs[j].Signatures[k].IsUserRevocation()) then
        begin
          SigNode := tv.Items.AddChild(UserNode, 'Revocation');
//          UserNode.NodeFont = new Font(tv.Font, FontStyle.Italic);
        end
        else
        begin
          SigNode := tv.Items.AddChild(UserNode, 'Signature');
          SigNode.ImageIndex := 3;
          SigNode.SelectedIndex := 3;
	end;

        SigNode.Data := Keyring.PublicKeys[i].UserIDs[j].Signatures[k];
      end;
    end;

    for j := 0 to Keyring.PublicKeys[i].UserAttrCount - 1 do
    begin
      UserNode := tv.Items.AddChild(KeyNode, 'Photo');
      UserNode.Data := Keyring.PublicKeys[i].UserAttrs[j];

      // Creating signature nodes
      for k := 0 to Keyring.PublicKeys[i].UserAttrs[j].SignatureCount - 1 do
      begin
        if (Keyring.PublicKeys[i].UserAttrs[j].Signatures[k].IsUserRevocation()) then
	begin
          SigNode := tv.Items.AddChild(UserNode, 'Revocation');
//          UserNode.NodeFont = new Font(tv.Font, FontStyle.Italic);
        end
        else
        begin
          SigNode := tv.Items.AddChild(UserNode, 'Signature');
          SigNode.ImageIndex := 3;
          SigNode.SelectedIndex := 3;
        end;

        SigNode.Data := Keyring.PublicKeys[i].UserAttrs[j].Signatures[k];
      end;
    end;

    // Subkeys
    for j := 0 to Keyring.PublicKeys[i].SubkeyCount - 1 do
    begin
      SubKeyNode := tv.Items.AddChild(KeyNode, PKAlg2Str(Keyring.PublicKeys[i].Subkeys[j].PublicKeyAlgorithm) + ' subkey');
      SubKeyNode.Data := Keyring.PublicKeys[i].Subkeys[j];

      // Creating signature nodes
      for k := 0 to Keyring.PublicKeys[i].Subkeys[j].SignatureCount - 1 do
      begin
        if (keyring.PublicKeys[i].Subkeys[j].Signatures[k].IsSubkeyRevocation()) then
        begin
          SigNode := tv.Items.AddChild(SubKeyNode, 'Revocation');
//          SubKeyNode.NodeFont = new Font(tv.Font, FontStyle.Italic);
        end
        else
        begin
          SigNode := tv.Items.AddChild(SubKeyNode, 'Signature');
          SigNode.ImageIndex := 3;
          SigNode.SelectedIndex := 3;
        end;

        SigNode.Data := Keyring.PublicKeys[i].Subkeys[j].Signatures[k];
      end;
    end;
  end

  finally
    tv.Items.EndUpdate();
  end;
end;

procedure TfrmKeys.actNewKeyringExecute(Sender: TObject);
begin
  if MessageDlg('Are you sure you want to create a new keyring?'#13#10'All unsaved information will be LOST!',
        mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  begin
    PubKeyringFileName := '';
    SecKeyringFileName := '';
    tvKeyring.Items.Clear();
    pgpKeyring.Clear();
    HideAllInfoPanels();
    RedrawKeyring(tvKeyring, pgpKeyring);
    SetStatus('New keyring created');
  end;
end;

procedure TfrmKeys.actOpenKeyringExecute(Sender: TObject);
var
  tempKeyring: TElPGPKeyring;
begin
  tempKeyring := TElPGPKeyring.Create(nil);

  with TfrmSelectKeyring.Create(Self) do
    try
      OpenKeyring := True;
      Caption := 'Load keyring';
      if ShowModal = mrOK then
      begin
        try
          tempKeyring.Load(edtPub.Text, edtSec.Text, True);
        except
          on E: Exception do
          begin
            MessageDlg(E.Message, mtError, [mbOK], 0);
            SetStatus('Failed to load keyring');
            Exit;
          end;
        end;

	HideAllInfoPanels();
        FPubKeyringFileName := edtPub.Text;
        FSecKeyringFileName := edtSec.Text;
        pgpKeyring.Clear();
        tempKeyring.ExportTo(pgpKeyring);
        RedrawKeyring(tvKeyring, pgpKeyring);
        SetStatus('Keyring loaded');
      end;

    finally
      tempKeyring.Free;
      Free;
    end;
end;

procedure TfrmKeys.actSaveKeyringExecute(Sender: TObject);
begin
  with TfrmSelectKeyring.Create(Self) do
    try
      OpenKeyring := False;
      Caption := 'Save keyring';
      edtPub.Text := PubKeyringFileName;
      edtSec.Text := SecKeyringFileName;
      if (ShowModal = mrOK) then
        try
          pgpKeyring.Save(edtPub.Text, edtSec.Text, false);
          SetStatus('Keyring saved');
        except
          on E: Exception do
     	  begin
            MessageDlg(E.Message, mtError, [mbOK], 0);
            SetStatus('Failed to save keyring');
	  end;
        end;
    finally
      Free;
    end;
end;

procedure TfrmKeys.actExitExecute(Sender: TObject);
begin
  Close;
end;

procedure TfrmKeys.actGenerateKeyExecute(Sender: TObject);
begin
  with TfrmWizard.Create(Self) do
    try
      if ShowModal = mrOK then
      begin
        pgpKeyring.AddSecretKey(FSecKey);
//        pgpKeyring.AddPublicKey(FSecKey.PublicKey);
        RedrawKeyring(tvKeyring, pgpKeyring);
        SetStatus('New key was added to keyring');
      end;
    finally
      Free;
    end;
end;

procedure TfrmKeys.actAddKeyExecute(Sender: TObject);
var
  tempKeyring: TElPGPKeyring;
begin
  tempKeyring := TElPGPKeyring.Create(nil);
  if OpenDlg.Execute then
  begin
    try
      tempKeyring.Load(OpenDlg.Filename, '', True);
    except
      on E: Exception do
      begin
        MessageDlg(E.Message, mtError, [mbOK], 0);
        SetStatus('Failed to import key');
        FreeAndNil(tempKeyring);
      end;
    end;

    with TfrmImportKey.Create(Self) do
      try
        tvKeys.Images := imgTreeView;
        RedrawKeyring(tvKeys, tempKeyring);
        if (ShowModal = mrOK) then
        begin
          tempKeyring.ExportTo(pgpKeyring);
          RedrawKeyring(tvKeyring, pgpKeyring);
        end;
      finally
        Free;
      end;
  end;

  SetStatus(IntToStr(tempKeyring.PublicCount) + ' key(s) successfully imported');
  tempKeyring.Free;
end;

procedure TfrmKeys.actRemoveKeyUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := (tvKeyring.Selected <> nil) and
    (tvKeyring.Selected.Level = 0);
end;

procedure TfrmKeys.actRemoveKeyExecute(Sender: TObject);
var
  Key: TElPGPPublicKey;
begin
  if ((tvKeyring.Selected <> nil) and (TObject(tvKeyring.Selected.Data) is TElPGPPublicKey)) then
  begin
    Key := TElPGPPublicKey(tvKeyring.Selected.Data);