⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 Clever Internet Suite 4.0 source
💻 PAS
字号:
unit Main;

interface

uses
  Windows, SysUtils, Classes, Forms, Dialogs, StdCtrls, clDC, clUploader, clDCUtils,
  clMultiDC, clSingleDC, clProgressBar, Controls, ShellAPI, clHttpRequest;

type
  TMainForm = class(TForm)
    Label4: TLabel;
    Label5: TLabel;
    edtFile: TEdit;
    btnBrowse: TButton;
    btnStart: TButton;
    edtHost: TEdit;
    OpenDialog1: TOpenDialog;
    clUploader: TclUploader;
    clProgressBar1: TclProgressBar;
    Memo1: TMemo;
    Label1: TLabel;
    btnStop: TButton;
    Label2: TLabel;
    edtViewPage: TEdit;
    btnView: TButton;
    clHttpRequestBuilder: TclHttpRequestBuilder;
    procedure btnBrowseClick(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure clUploaderStatusChanged(Sender: TObject;
      Status: TclProcessStatus);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure clUploaderGetServerResponse(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure btnViewClick(Sender: TObject);
  end;
 
var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.btnBrowseClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    edtFile.Text := OpenDialog1.FileName;
  end;
end;

procedure TMainForm.btnStartClick(Sender: TObject);
begin
  if clUploader.IsBusy then Exit;
  clUploader.URL := edtHost.Text;
  (clUploader.HTTPRequest[0] as TclSubmitFileRequestItem).FileName := edtFile.Text;
  clUploader.Start();
end;

procedure TMainForm.clUploaderStatusChanged(Sender: TObject;
  Status: TclProcessStatus);
var
  s: String;
begin
  case Status of
    psSuccess:
    begin
      ShowMessage('Process completed successfully.');
    end;
    psErrors, psFailed:
      begin
        s := (Sender as TclUploader).Errors.Text;
        MessageBox(0, PAnsiChar(s), 'Error', 0);
      end;
    psTerminated: MessageBox(0, 'Process stopped', 'Message', 0);
  end;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := not clUploader.IsBusy;
  if not CanClose then
  begin
    ShowMessage('Uploading is in progress');
  end;
end;

procedure TMainForm.clUploaderGetServerResponse(Sender: TObject);
begin
  Memo1.Lines.Assign(clUploader.ServerResponse);
end;

procedure TMainForm.btnStopClick(Sender: TObject);
begin
  clUploader.Stop();
end;

procedure TMainForm.btnViewClick(Sender: TObject);
begin
  ShellExecute(0, 'open', PAnsiChar(edtViewPage.Text), nil, nil, SW_RESTORE);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -