unit1.pas

著名的SecureBlackBox控件完整源码

unit Unit1;

interface

uses
  SysUtils, Classes, QGraphics, QControls, QForms, QDialogs,
  IdIOHandler, IdIOHandlerSocket, SBIndyIOHandler10, QStdCtrls,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, SBClient,
  SBCustomCertStorage, SBX509, SBConstants, IdSocks,
  IdIOHandlerStack, IdSSL;

type
  TForm1 = class(TForm)
    ComboBox1: TComboBox;
    Button1: TButton;
    Memo1: TMemo;
    GroupBox1: TGroupBox;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    GroupBox2: TGroupBox;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Button4: TButton;
    OpenDialog1: TOpenDialog;
    Label1: TLabel;
    Memo2: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure CheckBox3Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure SSLHandlerCertificateValidate(Sender: TObject;
      Certificate: TElX509Certificate; var Validate: Boolean);
    procedure SSLHandlerCertificateNeededEx(
      Sender: TObject; var Certificate: TElX509Certificate);
    procedure FormCreate(Sender: TObject);
  private
    NoMoreCert : boolean;
    IdHTTP1: TIdHTTP;
    SSLHandler: TElClientIndySSLIOHandlerSocket;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Clear;
  Memo1.Repaint;
  Button1.Enabled := False;
  Memo1.Lines.Text := IdHTTP1.Get(ComboBox1.Text);
  IdHTTP1.IOHandler.Close;
  Button1.Enabled := True;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    Edit1.Text := OpenDialog1.FileName;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    Edit2.Text := OpenDialog1.FileName;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked
  then
    SSLHandler.Versions := SSLHandler.Versions + [sbSSL2]
  else
    SSLHandler.Versions := SSLHandler.Versions - [sbSSL2];
end;

procedure TForm1.CheckBox2Click(Sender: TObject);
begin
  if CheckBox2.Checked
  then
    SSLHandler.Versions := SSLHandler.Versions + [sbSSL3]
  else
    SSLHandler.Versions := SSLHandler.Versions - [sbSSL3];
end;

procedure TForm1.CheckBox3Click(Sender: TObject);
begin
  if CheckBox3.Checked
  then
    SSLHandler.Versions := SSLHandler.Versions + [sbTLS1]
  else
    SSLHandler.Versions := SSLHandler.Versions - [sbTLS1];
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  ComboBox1.ItemIndex := 0;
end;

procedure TForm1.SSLHandlerCertificateValidate(
  Sender: TObject; Certificate: TElX509Certificate; var Validate: Boolean);
var
  Validity : TSBCertificateValidity;
  Reason : TSBCertificateValidityReason;
begin
  SSLHandler.InternalValidate(Validity, Reason);
  Memo2.Lines.Text := '';
  if Validity = cvOk then
    Memo2.Lines.Text := 'Certificate is correct. '
  else if Validity = cvSelfSigned then
    Memo2.Lines.Text := 'Certificate is self-signed. '
  else
    Memo2.Lines.Text := 'Certificate is invalid. ';
  if vrBadData in Reason then
    Memo2.Lines.Text := Memo2.Lines.Text + 'Certificate is not a valid X509 certificate. ';
  if vrRevoked in Reason then
    Memo2.Lines.Text := Memo2.Lines.Text + 'Certificate is revoked. ';
  if vrNotYetValid in Reason then
    Memo2.Lines.Text := Memo2.Lines.Text + 'Certificate is not yet valid. ';
  if vrExpired in Reason then
    Memo2.Lines.Text := Memo2.Lines.Text + 'Certificate is expired. ';
  if vrInvalidSignature in Reason then
    Memo2.Lines.Text := Memo2.Lines.Text + 'Digital signature is invalid (maybe, certificate is corrupted). ';
  if vrUnknownCA in Reason then
    Memo2.Lines.Text := Memo2.Lines.Text + 'Certificate is signed by unknown Certificate Authority. ';
  Memo2.Lines.Text := Memo2.Lines.Text + #13 + 'Certificate parameters:' + #13;
  Memo2.Lines.Text := Memo2.Lines.Text + 'Version: ' + InttoStr(Certificate.Version) + #13;
  Memo2.Lines.Text := Memo2.Lines.Text + 'Issuer: ' + Certificate.Issuer.Text + #13;
  Memo2.Lines.Text := Memo2.Lines.Text + 'Subject: ' + Certificate.Subject.Text + #13;
  Memo2.Lines.Text := Memo2.Lines.Text + 'Validity period: ' + DateTimeToStr(Certificate.ValidFrom) + ' - ' + DateTimeToStr(Certificate.ValidTo) + #13;
  Validate := true;
end;

procedure TForm1.SSLHandlerCertificateNeededEx(
  Sender: TObject; var Certificate: TElX509Certificate);
var Stream : TStream;
begin
  if NoMoreCert then
    Certificate := nil
  else
  begin
    ShowMessage('Certificate Needed');
    if (Edit1.Text <> '') and (Edit2.Text <> '') then
    begin
      Certificate := TElX509Certificate.Create(nil);
      if Edit1.Text <> '' then
      begin
        Stream := TFileStream.Create(Edit1.Text, fmOpenRead or fmShareDenyWrite);
        try
          Certificate.LoadFromStream(Stream);
        finally
          Stream.Free;
        end;
      end;
      if Edit2.Text <> '' then
      begin
        Stream := TFileStream.Create(Edit2.Text, fmOpenRead or fmShareDenyWrite);
        try
          Certificate.LoadKeyFromStream(Stream);
        finally
          Stream.Free;
        end;
      end;
      NoMoreCert := false;
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  IdHTTP1:= TIdHTTP.Create(nil);
  SSLHandler:= TElClientIndySSLIOHandlerSocket.Create(nil);
  IdHTTP1.IOHandler := SSLHandler;
end;

end.