Clever-Internet-Suite-Examples/Delphi/SubmitFile/Main.pas at master · CleverComponents/Clever-Internet-Suite-Examples · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
unit Main;

interface

uses
  Windows, SysUtils, Classes, Forms, Dialogs, StdCtrls, clDC, clUploader, clDCUtils,
  clMultiDC, clSingleDC, clProgressBar, clProgressBarDC, Controls, ShellAPI, clHttpRequest,
  clResourceState, DemoBaseFormUnit, Graphics, ExtCtrls;

type
  TMainForm = class(TclDemoBaseForm)
    Label4: TLabel;
    Label5: TLabel;
    edtFile: TEdit;
    btnBrowse: TButton;
    btnStart: TButton;
    edtHost: TEdit;
    OpenDialog1: TOpenDialog;
    clUploader: TclUploader;
    clProgressBar1: TclProgressBarDC;
    Memo1: TMemo;
    Label1: TLabel;
    btnStop: TButton;
    Label2: TLabel;
    edtViewPage: TEdit;
    btnView: TButton;
    clHttpRequest: TclHttpRequest;
    procedure btnBrowseClick(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure clUploaderStatusChanged(Sender: TObject;
      Status: TclProcessStatus);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure btnStopClick(Sender: TObject);
    procedure btnViewClick(Sender: TObject);
    procedure clUploaderProcessCompleted(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.Items[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, PChar(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.btnStopClick(Sender: TObject);
begin
  clUploader.Stop();
end;

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

procedure TMainForm.clUploaderProcessCompleted(Sender: TObject);
begin
  Memo1.Lines.Assign(clUploader.HttpResponse);
end;

end.