unit1.pas

著名的SecureBlackBox控件完整源码

unit Unit1;

interface

// remember to install one of additional packages,
// located in <SecureBlackbox>\Classes\Indy,
// as described in SecureBlackbox readme file

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  IdIOHandler, IdIOHandlerSocket, IdSSLOpenSSL, SBIndyIOHandler, StdCtrls,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, SBClient,
  SBCustomCertStorage, SBWinCertStorage, SBX509, SBConstants, IdSocks, SBUtils;

type
  TForm1 = class(TForm)
    IdHTTP1: TIdHTTP;
    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;
    SSLHandler: TElIndySSLIOHandlerSocket;
    ElWinCertStorage1: TElWinCertStorage;
    Memo2: TMemo;
    CheckBox4: TCheckBox;
    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 CheckBox4Click(Sender: TObject);
  private
    NoMoreCert : boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Clear;
  Memo1.Repaint;
  Button1.Enabled := False;
  ElWinCertStorage1.SystemStores.Add('ROOT');
  Memo1.Lines.Text := IdHTTP1.Get(ComboBox1.Text);
  IdHTTP1.IOHandler.Close;
  IdHTTP1.RedirectMaximum := 5;
  IdHTTP1.HandleRedirects := true;
  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.CheckBox4Click(Sender: TObject);
begin
  if CheckBox4.Checked
  then
    SSLHandler.Versions := SSLHandler.Versions + [sbTLS11]
  else
    SSLHandler.Versions := SSLHandler.Versions - [sbTLS11];
end;

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

procedure TForm1.SSLHandlerCertificateNeededEx(
  Sender: TObject; var Certificate: TElX509Certificate);
var Stream : TStream;
begin
  if NoMoreCert then
    Certificate := nil
  else
  begin
    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 := true;
    end;
  end;
end;

function FormatName(const Name: TName): string;
begin
  Result := '';
  if Name.Country <> '' then
    Result := Result + 'C=' + Name.Country + '; ';
  if Name.StateOrProvince <> '' then
    Result := Result + 'SP=' + Name.StateOrProvince + '; ';
  if Name.Locality <> '' then
    Result := Result + 'L=' + Name.Locality + '; ';
  if Name.Organization <> '' then
    Result := Result + 'O=' + Name.Organization + '; ';
  if Name.OrganizationUnit <> '' then
    Result := Result + 'OU=' + Name.OrganizationUnit + '; ';
  if Name.CommonName <> '' then
    Result := Result + 'CN=' + Name.CommonName + '; ';
  if Name.EMailAddress <> '' then
    Result := Result + 'E=' + Name.EMailAddress + '; ';
  if Length(Result) > 0 then
    Result := Copy(Result, 1, Length(Result) - 2);
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: ' + FormatName(Certificate.IssuerName) + #13;
  Memo2.Lines.Text := Memo2.Lines.Text + 'Subject: ' + FormatName(Certificate.SubjectName) + #13;
  Memo2.Lines.Text := Memo2.Lines.Text + 'Validity period: ' + DateTimeToStr(Certificate.ValidFrom) + ' - ' + DateTimeToStr(Certificate.ValidTo) + #13;
  Validate := true;
end;

initialization

SetLicenseKey('ADDCD14AD06709806817E0B3D7BFD0A2222D536FE156466C5D5FE65DB5DEAE76' + 
  'FFDEBC07E915A5751C12C01C783958872A38E4A5EDA140E7247E0F2E56442A3C' + 
  'F3E9347AD8FDE52083A0DFC86BC00ECB0FD0CF1B51159A2BCB84F6EA6349EF47' + 
  '5C15A59AFCC55F7C3AAD26C279628B5D91B1DC94BD2385354A70CCA3B76101D9' + 
  'F41C84A639FC3CCE4BA8F0CC4A66DCD150114A3F58C1AD46B7B94643741BC20A' + 
  '8DCA83AB921480951B423CAA19EF1863A47CA2C3422E7E5634BED98939A5AE43' + 
  'DE1E4BAD79E66D8A5C973B3455656C8C9B6FF024FADD6CDA02D0F506D98493C8' + 
  'BD1ED7B237DB75FA31F2C82654490CDDDEE24E19939137B9E1DB05508733B22F');


end.