mainform.pas

著名的SecureBlackBox控件完整源码

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, SBClient, ScktComp, SBX509, SBConstants, WinSock,
  SBUtils, SBCustomCertStorage, SelectCertForm, ExtCtrls;

type
  TfrmMain = class(TForm)
    GroupBox1: TGroupBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    btnConnect: TButton;
    StatusBar1: TStatusBar;
    Memo1: TMemo;
    Edit3: TEdit;
    btnSend: TButton;
    ElSecureClient: TElSecureClient;
    ClientSocket: TClientSocket;
    btnDisconnect: TButton;
    Timer1: TTimer;
    procedure btnConnectClick(Sender: TObject);
    procedure ElSecureClientReceive(Sender: TObject; Buffer: Pointer;
      MaxSize: Integer; out Written: Integer);
    procedure ElSecureClientSend(Sender: TObject; Buffer: Pointer;
      Size: Integer);
    procedure ElSecureClientData(Sender: TObject; Buffer: Pointer;
      Size: Integer);
    procedure ElSecureClientOpenConnection(Sender: TObject);
    procedure ElSecureClientCloseConnection(Sender: TObject;
      CloseReason: TSBCloseReason);
    procedure ElSecureClientCertificateValidate(Sender: TObject;
      Certificate: TElX509Certificate; var Validate: Boolean);
    procedure ClientSocketConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientSocketDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure btnSendClick(Sender: TObject);
    procedure btnDisconnectClick(Sender: TObject);
    procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ClientSocketWrite(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ElSecureClientCertificateNeededEx(Sender: TObject;
      var Certificate: TElX509Certificate);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    DataBuffer : array of byte;
  protected
    FCertStorage: TElMemoryCertStorage;
    FLastCert: Integer;

    procedure AttemptSocketWrite;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.DFM}

procedure TfrmMain.btnConnectClick(Sender: TObject);
begin
  FreeAndNil(FCertStorage);

  ClientSocket.Host := Edit1.Text;
  ClientSocket.Port := StrToInt(Edit2.Text);
  ClientSocket.Open;
end;

// this event handler is called by ElSecureClient when it needs some data
// to be read from socket
// Written parameter should be set according to number of bytes really read
procedure TfrmMain.ElSecureClientReceive(Sender: TObject; Buffer: Pointer;
  MaxSize: Integer; out Written: Integer);
begin
  Written := ClientSocket.Socket.ReceiveBuf(Buffer^, MaxSize);
  // on error ReceiveBuf returns negative value (-1), so explicitly setting
  // Written parameter to 0.
  if Written < 0 then
    Written := 0;
end;

// this event handler is called by ElSecureClient when it needs some data
// to be written to socket
procedure TfrmMain.ElSecureClientSend(Sender: TObject; Buffer: Pointer;
  Size: Integer);
var Pos : integer;
begin
  // caching output data in the internal buffer
  Pos := Length(DataBuffer);
  SetLength(DataBuffer, Pos + Size);
  Move(PChar(Buffer)^, DataBuffer[Pos], Size);
  // trying to send it to peer
  AttemptSocketWrite;
end;

// this event handler is called by ElSecureClient when some amount of data is
// received from peer. Buffer parameter specifies the array of decrypted data.
procedure TfrmMain.ElSecureClientData(Sender: TObject; Buffer: Pointer;
  Size: Integer);
var
  S : string;
begin
  SetLength(S, Size);
  Move(Buffer^, S[1], Size);
  Memo1.Lines.Text := Memo1.Lines.Text + '[SERVER] ' + S + #13#10;
end;

// this event handler is called by ElSecureClient when SSL connection is opened.
// After this step, the data may be sent to peer using SendData/SendText methods.
procedure TfrmMain.ElSecureClientOpenConnection(Sender: TObject);
begin
  StatusBar1.Panels[0].Text := 'Secure Connection Established';
  Memo1.Lines.Text := Memo1.Lines.Text + 'Connection to Server established. SSL version is';
  if ElSecureClient.CurrentVersion = sbSSL2 then
    Memo1.Lines.Text := Memo1.Lines.Text + ' SSL2'
  else if ElSecureClient.CurrentVersion = sbSSL3 then
    Memo1.Lines.Text := Memo1.Lines.Text + ' SSL3'
  else if ElSecureClient.CurrentVersion = sbTLS1 then
    Memo1.Lines.Text := Memo1.Lines.Text + ' TLS1'
  else if ElSecureClient.CurrentVersion = sbTLS11 then
    Memo1.Lines.Text := Memo1.Lines.Text + ' TLS1.1';
  Memo1.Lines.Text := Memo1.Lines.Text + #13#10;
end;

// this event handler is called by ElSecureClient when SSL connection is gracefully
// closed. No data should be sent using SendData/SendText methods after
// this event is fired.
procedure TfrmMain.ElSecureClientCloseConnection(Sender: TObject;
  CloseReason: TSBCloseReason);
begin
  StatusBar1.Panels[0].Text := 'Secure Connection Closed';
end;

// this event handler is called by ElSecureClient when it receives a certificate
// from server. Depending on your tasks, you may use different approaches to
// validate this certificate. Here the certificate validation is skipped.
procedure TfrmMain.ElSecureClientCertificateValidate(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
end;

procedure TfrmMain.ClientSocketConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  ElSecureClient.Open;
end;

// this event handler is called by ClientSocket to notify that some
// data has arrived to Socket.
procedure TfrmMain.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  // Pushing ElSecureClient to read data from socket using OnReceive event.
  ElSecureClient.DataAvailable;
end;

procedure TfrmMain.ClientSocketDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  ElSecureClient.Close;
  StatusBar1.Panels[0].Text := 'Secure Connection Closed';
end;

procedure TfrmMain.btnSendClick(Sender: TObject);
begin
  ElSecureClient.SendText(Edit3.Text);
  Memo1.Lines.Text := Memo1.Lines.Text + '[CLIENT] ' + Edit3.Text + #13#10;
end;

procedure TfrmMain.btnDisconnectClick(Sender: TObject);
begin
  if ElSecureClient.Active then
    ElSecureClient.Close(true);
  ClientSocket.Active := false;
  StatusBar1.Panels[0].Text := 'Secure Connection Closed';
end;

procedure TfrmMain.ClientSocketError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  if ElSecureClient.Active then
    ElSecureClient.Close;
  StatusBar1.Panels[0].Text := 'Secure Connection Closed';
end;

procedure TfrmMain.ClientSocketWrite(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  AttemptSocketWrite;
end;

// This routine tries to send as much buffered data as possible to the socket
procedure TfrmMain.AttemptSocketWrite;
  var Sent : integer;
    err  : integer;
begin
  if Length(DataBuffer) > 0 then
  begin
    Sent := ClientSocket.Socket.SendBuf(DataBuffer[0], Length(DataBuffer));
    if Sent = -1 then
    begin
      err := WSAGetLastError;
      if err <> WSAEWOULDBLOCK then
      begin
        SetLength(DataBuffer, 0);
        ShowMessage(Format('Error %d while trying to send the data', [err]));
        exit;
      end;
    end;
    if Sent > 0 then
    begin
      if (Sent < Length(DataBuffer)) then
      begin
        Move(DataBuffer[Sent], DataBuffer[0], Length(DataBuffer) - Sent);
        SetLength(DataBuffer, Length(DataBuffer) - Sent);
      end
      else
        SetLength(DataBuffer, 0);
    end;
  end;
end;

// this event handler is called by ElSecureClient when server request the
// client's certificate.
procedure TfrmMain.ElSecureClientCertificateNeededEx(Sender: TObject;
  var Certificate: TElX509Certificate);
var
  ReadEvent: TSocketNotifyEvent;
begin
  if not Assigned(FCertStorage) then
  begin
    FCertStorage := TElMemoryCertStorage.Create(nil);
    with TfrmSelectCert.Create(Self) do
      try
        // block reading in ShowModal mode
        ReadEvent := ClientSocket.OnRead;
        ClientSocket.OnRead := nil;

        Mode := smClientCert;
        LoadStorage('CertStorageDef.ucs', FCertStorage);
        SetStorage(FCertStorage);
        if ShowModal() = mrOK then
        begin
          GetStorage(FCertStorage);
        end
        else
          FCertStorage.Clear;

        ClientSocket.OnRead := ReadEvent;

      finally
        Free;
      end;

    FLastCert := -1;
  end;

  Inc(FLastCert);
  if FLastCert >= FCertStorage.Count then
  begin
    Certificate := nil;
    // force client to continue read data after sending all data
    Timer1.Enabled := True;
  end
  else
    Certificate := FCertStorage.Certificates[FLastCert];
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FCertStorage);
end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := False;
  // Pushing ElSecureClient to read data from socket using OnReceive event.
  ElSecureClient.DataAvailable;
end;

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

end.