mainunit.pas

著名的SecureBlackBox控件完整源码

unit MainUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, SBHTTPSClient, SBX509, SBClient, SBSimpleSSL, SBUtils;

type
  TFrmMain = class(TForm)
    Label1: TLabel;
    EdHost: TEdit;
    btnGo: TButton;
    MMLog: TMemo;
    HttpsClient: TElHTTPSClient;
    Label2: TLabel;
    CbProtocol: TComboBox;
    Label3: TLabel;
    EdPort: TEdit;
    Label4: TLabel;
    EdPath: TEdit;
    procedure btnGoClick(Sender: TObject);
    procedure HttpsClientConnect(Sender: TObject);
    procedure HttpsClientDisconnect(Sender: TObject);
    procedure HttpsClientReceive(Sender: TObject; Buffer: Pointer;
      Size: Integer);
    procedure HttpsClientSend(Sender: TObject);
    procedure HttpsClientCertificateValidate(Sender: TObject;
      Certificate: TElX509Certificate; var Validate: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure HttpsClientDocumentStart(Sender: TObject);
    procedure HttpsClientDocumentFinish(Sender: TObject);
    procedure HttpsClientData(Sender: TObject; Buffer: Pointer;
      Size: Integer);
    procedure HttpsClientReceivingHeaders(Sender: TObject;
      Headers: TStringList);
    procedure HttpsClientCloseConnection(Sender: TObject;
      CloseReason: TSBCloseReason);
    procedure HttpsClientRedirection(Sender: TObject; OldURL,
      NewURL: String; var AllowRedirection: Boolean);
    procedure HttpsClientPreparedHeaders(Sender: TObject;
      Headers: TStringList);
  private
    { Private declarations }
  public
    FLogFile: TextFile;
  end;

var
  FrmMain: TFrmMain;

implementation

{$R *.DFM}

procedure TFrmMain.btnGoClick(Sender: TObject);
(*
var Protocol, User, Password, Host, Port, Path, Query: String;
//var Stream : TStream;
begin
  mmLog.Lines.Clear;
  if EdPath.Text = '' then
    EdPath.Text := '/';
  //metacode - update HttpClient
  HttpsClient.SSLEnabled := CbProtocol.ItemIndex > 0;
  HttpsClient.UseHTTPProxy := False;
  //metacode - disable 'Go' button
  btnGo.Enabled := False;
  //metacode - fetch the page
//  Stream := TFileStream.Create('c:\temp\output.html', fmCreate);
  try
  //  HttpsClient.OutputStream := Stream;
    HttpsClient.Get(CbProtocol.Text + '://' + EdHost.Text + ':' + EdPort.Text + EdPath.Text);
  finally
  //  Stream.Free;
    btnGo.Enabled := True;
  end;
end;

procedure TFrmMain.HttpsClientConnect(Sender: TObject);
begin
  MMLog.Lines.Add('--Log-- Connected --Log--');
  Application.ProcessMessages;
  //AssignFile(FLogFile, 'HTTPSClient.log'); Rewrite(FLogFile);
end;

procedure TFrmMain.HttpsClientDisconnect(Sender: TObject);
begin
  MMLog.Lines.Add('--Log-- Disconnected --Log--');
  Application.ProcessMessages;
//  CloseFile(FLogFile);
end;

procedure TFrmMain.HttpsClientReceive(Sender: TObject; Buffer: Pointer;
  Size: Integer);
var TmpS: String;
begin
  SetString(TmpS, PChar(Buffer), Size);
  //write(FLogFile, TmpS);
  MMLog.Text := MMLog.Text + TmpS;
  Application.ProcessMessages;
end;

procedure TFrmMain.HttpsClientSend(Sender: TObject);
begin
  ;
end;

procedure TFrmMain.HttpsClientCertificateValidate(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.FormCreate(Sender: TObject);
begin
  CbProtocol.ItemIndex := 0;
end;

procedure TFrmMain.HttpsClientDocumentStart(Sender: TObject);
begin
  MMLog.Lines.Add('--- Document started ---');
  Application.ProcessMessages;
end;

procedure TFrmMain.HttpsClientDocumentFinish(Sender: TObject);
begin
  MMLog.Lines.Add('--- Document finished ---');
  Application.ProcessMessages;
end;

procedure TFrmMain.HttpsClientData(Sender: TObject; Buffer: Pointer;
  Size: Integer);
var S : string;
begin
  SetLength(S, Size);
  Move(Buffer^, S[1], Size);
  MMLog.Text := MMLog.Text + S;
  Application.ProcessMessages;
end;

procedure TFrmMain.HttpsClientReceivingHeaders(Sender: TObject;
  Headers: TStringList);
begin
  MMLog.Lines.Add('Headers received: ');
  MMLog.Lines.AddStrings(Headers);
  MMLog.Lines.Add('');
  Application.ProcessMessages;
end;

procedure TFrmMain.HttpsClientCloseConnection(Sender: TObject;
  CloseReason: TSBCloseReason);
begin
  MMLog.Lines.Add('Connection closed.');
  Application.ProcessMessages;
end;

procedure TFrmMain.HttpsClientRedirection(Sender: TObject; OldURL,
  NewURL: String; var AllowRedirection: Boolean);
begin
  MMLog.Lines.Add('Request redirected to ' + NewURL);
  AllowRedirection := true;
  Application.ProcessMessages;
end;

procedure TFrmMain.HttpsClientPreparedHeaders(Sender: TObject;
  Headers: TStringList);
begin
  MMLog.Lines.Add('Headers sent: ');
  MMLog.Lines.AddStrings(Headers);
  MMLog.Lines.Add('');
  Application.ProcessMessages;
end;

initialization

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

end.