mainunit.pas

著名的SecureBlackBox控件完整源码

unit MainUnit;

interface

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

type
  TFrmFileUpload = class(TForm)
    Label1: TLabel;
    EdURL: TEdit;
    Label2: TLabel;
    EdFileName: TEdit;
    dlgOpen: TOpenDialog;
    BtSel: TButton;
    BtStart: TButton;
    PBUploading: TProgressBar;
    HttpClient: TElHTTPSClient;
    procedure BtStartClick(Sender: TObject);
    procedure BtSelClick(Sender: TObject);
    procedure HttpClientData(Sender: TObject; Buffer: Pointer;
      Size: Integer);
    procedure HttpClientProgress(Sender: TObject; Total, Current: Int64;
      var Cancel: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmFileUpload: TFrmFileUpload;

implementation

{$R *.DFM}

procedure TFrmFileUpload.BtStartClick(Sender: TObject);
var FS: TFileStream;
    SL: TStringList;
begin
  if not HttpClient.Active then
  begin
    if FileExists(EdFileName.Text) then
    begin
      FS := TFileStream.Create(EdFileName.Text, fmOpenRead + fmShareDenyWrite);
      SL := TStringList.Create; SL.Add('upload=Upload');
      PBUploading.Min := 0;
      PBUploading.Max := FS.Size;
      PBUploading.Position := 0;
      BtStart.Caption := 'Stop';
      HttpClient.Post(EdURL.Text, SL, 'userfile', EdFileName.Text, FS, '', True);
      BtStart.Caption := 'Start';
    end
    else
      Application.MessageBox('Cant open the specified file.', 'Error', MB_OK);
  end
  else
  begin
    HttpClient.Close(true);
    pbUploading.Position := 0; 
    BtStart.Caption := 'Start';
  end;
end;

procedure TFrmFileUpload.BtSelClick(Sender: TObject);
begin
  if dlgOpen.Execute then
    EdFileName.Text := dlgOpen.FileName;
end;

procedure TFrmFileUpload.HttpClientData(Sender: TObject; Buffer: Pointer;
  Size: Integer);
var S : string;
begin
  SetLength(S, Size);
  Move(Buffer^, S[1], Size);
  ShowMessage(S);
end;

procedure TFrmFileUpload.HttpClientProgress(Sender: TObject; Total,
  Current: Int64; var Cancel: Boolean);
begin
  if Total <> -1 then
  begin
    PBUploading.Max := Total;
    PBUploading.Position := Current;
  end;
  Cancel := false;
end;

initialization

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

end.