unit Push_main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPServer, IdCustomHTTPServer,
IdHTTPServer, StdCtrls, ToolBox;
type
TForm1 =
class(TForm)
Server: TIdHTTPServer;
Active: TCheckBox;
Port: TEdit;
procedure ServerCommandGet(AThread: TIdPeerThread;
ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
procedure ServerCreatePostStream(ASender: TIdPeerThread;
var VPostStream: TStream);
procedure FormCreate(Sender: TObject);
procedure ActiveClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses IdHTTPHeaderInfo;
{$R *.dfm}
//function fib(n:Integer):Integer; begin if (n <= 2) then result:=1 else result:=fib(n-1) + fib(n-2); end;
function HtmlForm:
string;
begin
Result:=
'
<html><head><title>Upload</title></head><body>'+
'
<center><h1>File Upload</h1><hr>'+
'
<form action="/upload/" method=post enctype="multipart/form-data">'+
'
<input type=file name=file><input type=submit value=Upload></form>'+
'
</center></body></html>';
end;
function HTMLMessage(msg:
String):
string;
begin
Result:=
'
<html><head><title>Upload</title></head><body>'+
'
<center><h1>File Upload</h1><hr>'+msg+'
<hr>'+
'
<a href=/>Click here to continue</a></center></body></html>';
end;
procedure TForm1.ServerCommandGet(AThread: TIdPeerThread;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
Var TheFile:TMemoryStream;
FN:
String;
begin
If ARequestInfo.Document='
/'
Then begin
With AResponseInfo
do begin
ContentText:=HtmlForm;
WriteContent;
end;
end else if ARequestInfo.Document='
/upload/'
then begin
TheFile:=TMemoryStream.Create;
try
try
TheFile.LoadFromStream(ARequestInfo.PostStream);
TheFile.SaveToFile('
.\'+DateToStr(now)+'
'+TimeToStr(now)+'
'+ARequestInfo.RemoteIP+'
'+FN);
With AResponseInfo
do begin
ContentText:=HtmlMessage('
Upload Successful!');
WriteContent;
end;
except
With AResponseInfo
do begin
ContentText:=HTMLMessage('
Upload Error!');
WriteContent;
end;
end;
finally
TheFile.Free;
end;
end;
end;
procedure TForm1.ServerCreatePostStream(ASender: TIdPeerThread;
var VPostStream: TStream);
begin
VPostStream:=TMemoryStream.Create;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
LongTimeFormat:='
hhmmss';
ShortDateFormat:='
yyMMdd';
end;
procedure TForm1.ActiveClick(Sender: TObject);
begin
Try
If Active.Checked
then begin
Server.DefaultPort:=StrTointDef(Port.Text,80);
end;
Server.Active:=Active.Checked;
Finally
Active.Checked:=Server.Active;
end;
end;
end.