fmain.pas

来自「著名的SecureBlackBox控件完整源码」· PAS 代码 · 共 586 行 · 第 1/2 页

unit fMain;

interface

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

type
  TfrmMain = class(TForm)
    lblStep1: TLabel;
    btnLoadMessage: TButton;
    lblMessageHeader: TLabel;
    memMessageHeader: TMemo;
    btnProcessHeader: TButton;
    lblStep3: TLabel;
    btnProcessBody: TButton;
    lblMessageBody: TLabel;
    memMessageBody: TMemo;
    lblStep2: TLabel;
    grpSenderSignature: TGroupBox;
    lblSenderSignatureAlgorithm: TLabel;
    lblSenderDigestAlgorithm: TLabel;
    lblSenderQueryType: TLabel;
    lblSenderSelector: TLabel;
    lblSenderDomain: TLabel;
    lblSenderAvailable: TLabel;
    grpAuthorSignature: TGroupBox;
    lblAuthorSignatureAlgorithm: TLabel;
    lblAuthorDigestAlgorithm: TLabel;
    lblAuthorQueryType: TLabel;
    lblAuthorSelector: TLabel;
    lblAuthorDomain: TLabel;
    lblAuthorAvailable: TLabel;
    lblStep4: TLabel;
    btnQueryDNS: TButton;
    lblStep5: TLabel;
    lblStep6: TLabel;
    lblStep2Result: TLabel;
    lblStep3Result: TLabel;
    dlgOpenMessage: TOpenDialog;
    grpAuthorDNS: TGroupBox;
    edtAuthorDomain: TEdit;
    lblAuthorGranularity: TLabel;
    lblAuthorTestMode: TLabel;
    edtAuthorNotes: TEdit;
    lblAuthorPublicKey: TLabel;
    lblAuthorRevoked: TLabel;
    grpSenderDNS: TGroupBox;
    lblSenderGranularity: TLabel;
    lblSenderTestMode: TLabel;
    lblSenderPublicKey: TLabel;
    lblSenderRevoked: TLabel;
    edtSenderDomain: TEdit;
    edtSenderNotes: TEdit;
    btnVerify: TButton;
    pnlBottom: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    btnReset: TButton;
    lblSenderSignature: TLabel;
    lblAuthorSignature: TLabel;
    pnlTop: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnLoadMessageClick(Sender: TObject);
    procedure btnProcessHeaderClick(Sender: TObject);
    procedure btnProcessBodyClick(Sender: TObject);
    procedure btnQueryDNSClick(Sender: TObject);
    procedure btnVerifyClick(Sender: TObject);
    procedure btnResetClick(Sender: TObject);
  private
    // Verifier
    FVerifier: TElDomainKeysVerifier;
    // DNS Records
    FAuthorRecord: TElDKDNSRecord;
    FSenderRecord: TElDKDNSRecord;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

uses
  fDNS;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  // create an instance of verifier
  FVerifier := TElDomainKeysVerifier.Create(nil);
  // create instances of DNS records
  FSenderRecord := TElDKDNSRecord.Create;
  FAuthorRecord := TElDKDNSRecord.Create;
  // disable all steps except the first one
  btnProcessHeader.Enabled := False;      // step 2
  btnProcessBody.Enabled := False;        // step 3
  btnQueryDNS.Enabled := False;           // step 4
  btnVerify.Enabled := False;             // step 5
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  // destroy the instainces of DNS records
  FreeAndNil(FAuthorRecord);
  FreeAndNil(FSenderRecord);
  // destroy the instance of verifier
  FreeAndNil(FVerifier);
end;

procedure TfrmMain.btnLoadMessageClick(Sender: TObject);
var
  Text: TStringList;
  I: Integer;
  HeaderDone: Boolean;
  S: string;
begin
  // call Open File Dialog
  if dlgOpenMessage.Execute then
  begin
    // create a temporary string list
    Text := TStringList.Create;
    try
      // load content of the file to the temporary string list
      Text.LoadFromFile(dlgOpenMessage.FileName);
      // iterate the content line by line to separate header and body
      HeaderDone := False;
      for I := 0 to Text.Count - 1 do
      begin
        S := Text[I];
        if not HeaderDone then
        begin
          // header is not loaded yet
          memMessageHeader.Lines.Add(S);
          if S = '' then    // first empty line separates header and body
            HeaderDone := True;
        end
        else
        begin
          // header is loaded already
          memMessageBody.Lines.Add(S);
        end;
      end;
    finally
      Text.Free;
    end;
    // if the message was loaded successfully, enable the next step
    btnProcessHeader.Enabled := True;
    // and disable the current step
    btnLoadMessage.Enabled := False;
  end;
end;

procedure TfrmMain.btnProcessHeaderClick(Sender: TObject);
var
  Result: Integer;
begin
  // call ProcessHeader method of verifier
  Result := FVerifier.ProcessHeader(memMessageHeader.Lines);
  // analyze the returned value
  if Result = SB_DK_VERIFIER_ERROR_SUCCESS then
  begin
    // ProcessHeader method returned no error
    lblStep2Result.Caption := 'Succeeded';
    // check if sender signature is available 
    if FVerifier.SenderSignature.Available then
    begin
      lblSenderAvailable.Caption := 'YES';
      // get the parameters of sender signature
      lblSenderDomain.Caption := FVerifier.SenderSignature.Domain;
      lblSenderSelector.Caption := FVerifier.SenderSignature.Selector;
      if FVerifier.SenderSignature.QueryType = dkDNS then
        lblSenderQueryType.Caption := 'DNS'
      else
        lblSenderQueryType.Caption := 'Unknown';
      if FVerifier.SenderSignature.SignatureAlgorithm = dkRSA then
        lblSenderSignatureAlgorithm.Caption := 'RSA'
      else
        lblSenderSignatureAlgorithm.Caption := 'Unknown';
      if FVerifier.SenderSignature.DigestAlgorithm = dkSHA1 then
        lblSenderDigestAlgorithm.Caption := 'SHA-1'
      else
        lblSenderDigestAlgorithm.Caption := 'Unknown';
      // get domain for DNS query
      edtSenderDomain.Text := FVerifier.SenderSignature.Selector +
        '._domainkey.' + FVerifier.SenderSignature.Domain;
    end
    else
      lblSenderAvailable.Caption := 'NO';
    // check if author signature is available 
    if FVerifier.AuthorSignature.Available then
    begin
      lblAuthorAvailable.Caption := 'YES';
      // get the parameters of author signature
      lblAuthorDomain.Caption := FVerifier.AuthorSignature.Domain;
      lblAuthorSelector.Caption := FVerifier.AuthorSignature.Selector;
      if FVerifier.AuthorSignature.QueryType = dkDNS then
        lblAuthorQueryType.Caption := 'DNS'
      else
        lblAuthorQueryType.Caption := 'Unknown';
      if FVerifier.AuthorSignature.SignatureAlgorithm = dkRSA then
        lblAuthorSignatureAlgorithm.Caption := 'RSA'
      else
        lblAuthorSignatureAlgorithm.Caption := 'Unknown';
      if FVerifier.AuthorSignature.DigestAlgorithm = dkSHA1 then
        lblAuthorDigestAlgorithm.Caption := 'SHA-1'
      else
        lblAuthorDigestAlgorithm.Caption := 'Unknown';
      // get domain for DNS query
      edtAuthorDomain.Text := FVerifier.AuthorSignature.Selector +
        '._domainkey.' + FVerifier.AuthorSignature.Domain;
    end
    else
      lblAuthorAvailable.Caption := 'NO';
    // enable the next step
    btnProcessBody.Enabled := True;
    // and disable the current step
    btnProcessHeader.Enabled := False;
    // scroll the form to make Step 3 controls visible
    ScrollInView(btnQueryDNS);
  end
  else
  begin
    // ProcessHeader method returned an error
    case Result of
      SB_DK_VERIFIER_ERROR_INVALID_STATE:
        begin
          // returned if the ProcessHeader and ProcessBodyLine
          // methods are called in wrang order; so this error will
          // not be returned in this demo app
          lblStep2Result.Caption := 'Internal error';
        end;
      SB_DK_VERIFIER_ERROR_INVALID_HEADER:
        begin
          // returned if verifier has failed to parse message header
          lblStep2Result.Caption := 'Invalid header format';
        end;
      SB_DK_VERIFIER_ERROR_INVALID_SENDER:
        begin
          // returned if verifier has field to extract sender's domain name
          // from the Sender header field
          lblStep2Result.Caption := 'Invalid message sender';
        end;
      SB_DK_VERIFIER_ERROR_INVALID_AUTHOR:
        begin
          // returned if verifier has field to extract author's domain name
          // from the From header field
          lblStep2Result.Caption := 'Invalid message author'; 
        end;
      SB_DK_VERIFIER_ERROR_NO_ADDRESS:
        begin
          // returned if the message doesn't contain Sender nor From fields
          lblStep2Result.Caption := 'No Sender nor Author specified';
        end;
      SB_DK_VERIFIER_ERROR_NO_SIGNATURE:
        begin
          // returned if the message is not signed
          lblStep2Result.Caption := 'The message is not singed. Nothing to verify';
        end;
      SB_DK_VERIFIER_ERROR_INVALID_FORMAT:
        begin
          // returned if verifier has failed to parse a signature
          lblStep2Result.Caption := 'Invalid signature format';
        end;
      SB_DK_VERIFIER_ERROR_UNKNOWN_ALGORITHM:
        begin
          // returned if verifier has found an unknown algorithm
          // specified in the message
          lblStep2Result.Caption := 'Invalid algorithm';
        end;
      SB_DK_VERIFIER_ERROR_FAILURE:
        begin
          // this code is returned only from ProcessMessage method
          // when it fails to read from stream
          lblStep2Result.Caption := 'Internal Error';
        end;
    else
      // unknown error code
      lblStep2Result.Caption := 'Unknown Internal Error';
    end;
    // disable the current step; Reset method of verifier must be called
    // to process next message
    btnProcessHeader.Enabled := False;
  end;
end;

procedure TfrmMain.btnProcessBodyClick(Sender: TObject);
var
  I, Result: Integer;