📄 main.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 + -