mainform.pas

著名的SecureBlackBox控件完整源码

unit MainForm;

interface

uses
  Windows, Messages, Graphics, Controls, Forms, Dialogs, ToolWin, ComCtrls,
  Menus, Buttons, Spin, SysUtils, Classes, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, ExtCtrls, StdCtrls,
  IdIOHandler, IdIOHandlerSocket, 
  SBUtils, SBX509, SBIndyIOHandler10, IdIOHandlerStack, IdSSL;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    edUserName: TEdit;
    Label2: TLabel;
    edServer: TEdit;
    Label3: TLabel;
    lbClients: TListBox;
    Label4: TLabel;
    memLines: TMemo;
    Label5: TLabel;
    edMessage: TEdit;
    SpeedButton1: TSpeedButton;
    Timer1: TTimer;
    Label6: TLabel;
    sePort: TSpinEdit;
    Button1: TButton;
    Label7: TLabel;
    edtCert: TEdit;
    btnCert: TButton;
    dlgCert: TOpenDialog;
    Label8: TLabel;
    edtCertPwd: TEdit;
    Handler: TElClientIndySSLIOHandlerSocket;
    IdTCPClient1: TIdTCPClient;
    procedure FormShow(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure IdTCPClient1Connected(Sender: TObject);
    procedure edMessageKeyPress(Sender: TObject; var Key: Char);
    procedure Button1Click(Sender: TObject);
    procedure ElIndySSLIOHandlerSocket1CertificateValidate(Sender: TObject;
      Certificate: TElX509Certificate; var Validate: Boolean);
    procedure btnCertClick(Sender: TObject);
    procedure HandlerCertificateNeededEx(Sender: TObject;
      var Certificate: TElX509Certificate);
  private
    { Private declarations }
  public
    ClientCert : TElX509Certificate;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormShow(Sender: TObject);
begin
  width := width + 1;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Com,
  Msg : String;
begin
  if not IdTcpClient1.Connected then
    exit;

  IdTCPClient1.ReadTimeout := 10;
  Msg := IdTCPClient1.Socket.ReadLn('', 5);

  if Msg <> '' then
    if Msg[1] <> '@' then
      begin
      { Not a system command }
        memLines.Lines.Add(Msg);
      end
    else
      begin
      { System command }
        Com := UpperCase(Trim(Copy(Msg, 2, Pos(':', Msg) -2)));
        Msg := UpperCase(Trim(Copy(Msg, Pos(':', Msg) +1, Length(Msg))));
        if Com = 'CLIENTS' then
          lbClients.Items.CommaText := Msg;
      end;

end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  if (edUserName.Text <> '') and
     (edServer.Text <> '')   and
     SpeedButton1.Down then
    begin
      IdTCPClient1.Host := edServer.Text;
      IdTCPClient1.Port := sePort.Value;
      if SpeedButton1.Down then
        IdTCPClient1.Connect;
    end
  else
    begin
      if (edUserName.Text = '') or
         (edServer.Text = '')   then
        ShowMessage('You must put in a User Name and server name to connect.');
      SpeedButton1.Down := false;
    end;
end;

procedure TForm1.IdTCPClient1Connected(Sender: TObject);
begin
  IdTCPClient1.Socket.WriteLn(edUserName.Text);
end;

procedure TForm1.edMessageKeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then
    begin
      IdTCPClient1.Socket.WriteLn(edMessage.Text);
      edMessage.Text := '';
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  IdTCPClient1.Socket.WriteLn('@' + 'CLIENTS:REQUEST');
end;

procedure TForm1.ElIndySSLIOHandlerSocket1CertificateValidate(
  Sender: TObject; Certificate: TElX509Certificate; var Validate: Boolean);
begin
  Validate := true;
  // NEVER do this in real life since this makes security void. 
  // Instead validate the certificate as described on http://www.eldos.com/sbb/articles/1966.php

  MemLines.Lines.Add('Server certificate received:');
  MemLines.Lines.Add('  Issuer: ' + Certificate.IssuerName.Country + ', ' +
    Certificate.IssuerName.StateOrProvince + ', ' +
    Certificate.IssuerName.Organization + ', ' +
    Certificate.IssuerName.CommonName);
  MemLines.Lines.Add('  Subject: ' + Certificate.SubjectName.Country + ', ' +
    Certificate.SubjectName.StateOrProvince + ', ' +
    Certificate.SubjectName.Organization + ', ' +
    Certificate.SubjectName.CommonName);
  MemLines.Lines.Add('  Validity Period: ' + DateTimeToStr(Certificate.ValidFrom) + ' - ' +
    DateTimeToStr(Certificate.ValidTo));
end;

procedure TForm1.btnCertClick(Sender: TObject);
begin
  dlgCert.fileName := edtCert.Text;
  if dlgCert.Execute then
    edtCert.Text := dlgCert.fileName;
end;

procedure TForm1.HandlerCertificateNeededEx(Sender: TObject;
  var Certificate: TElX509Certificate);
var F : TFileStream;
begin
  if ClientCert <> nil then
  begin
    Certificate := nil;
    FreeAndNil(ClientCert);
  end
  else
  begin
    ClientCert := TElX509Certificate.Create(nil);
    try
      F := TFileStream.Create(edtCert.Text, fmOpenRead or fmShareDenyWrite);
      try
        ClientCert.LoadFromStreamPFX(F, edtCertPwd.Text);
        Certificate := ClientCert;
      finally
        F.Free;
      end;
    except
      FreeAndNil(ClientCert);
      ClientCert := nil;
    end;
  end;
end;

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

end.