unit WebserverUnit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Sockets, ComCtrls;
type
TForm1 =
class(TForm)
TcpServer1: TTcpServer;
Memo1: TMemo;
Start: TButton;
Stop: TButton;
StatusBar1: TStatusBar;
Button1: TButton;
Memo2: TMemo;
IsOnline: TCheckBox;
procedure StartClick(Sender: TObject);
procedure StopClick(Sender: TObject);
procedure TcpServer1Accept(Sender: TObject; ClientSocket: TCustomIpClient);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure TcpServer1Listening(Sender: TObject);
procedure TcpServer1GetThread(Sender: TObject;
var ClientSocketThread: TClientSocketThread);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
mypfad :
String;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
Stop.Click;
form1.TcpServer1.Free;
Application.Terminate;
end;
procedure TForm1.FormCreate(Sender: TObject);
var pfad :
String;
begin
pfad := GetCurrentDir + '
/webDocs';
if not DirectoryExists(Pfad)
then ForceDirectories(Pfad);
pfad := GetCurrentDir + '
/Err';
if not DirectoryExists(Pfad)
then ForceDirectories(Pfad);
end;
procedure TForm1.StartClick(Sender: TObject);
begin
Form1.TcpServer1.Open;
Form1.TcpServer1.Active := true;
memo1.lines.add(Datetimetostr(now) + '
: Server Start ');
isonline.Checked := Form1.TcpServer1.Active;
if isonline.checked = false
then
Showmessage('
Fehler beim Starten');
end;
procedure TForm1.StopClick(Sender: TObject);
begin
Form1.TcpServer1.Close;
Form1.TcpServer1.Active := false;
memo1.lines.add(Datetimetostr(now) + '
: Server Stop ');
isonline.Checked := Form1.TcpServer1.Active;
if isonline.checked = true
then
Showmessage('
Fehler beim Stoppen');
end;
procedure TForm1.TcpServer1Accept(Sender: TObject;
ClientSocket: TCustomIpClient);
var
rawData,Path,Agent,RawAgent:
String;
HttpPos,AgentPos:Integer;
TmpStr,TmpStr1:
String;
RequestFile, RequestHeader:TStringList;
I: Integer;
DataText : TStream;
lParamList: TStringStream;
begin
RawData:='
';
RequestFile := TStringList.Create;
RequestHeader := TStringList.create;
while ClientSocket.Connected
do
begin
RawData := ClientSocket.Receiveln;
memo1.Lines.add('
RawLine:' + rawdata + '
#Endline');
// Logfile
while RawData <> '
'
do
begin
RequestHeader.add(RawData);
RawData := ClientSocket.Receiveln;
memo2.Text := ('
RequestLine:' + RequestHeader.Text );
end;
Sleep(100);
for I := 0
to RequestHeader.Count -1
do
begin
if RequestHeader.Strings[i] = '
'
then
begin
Sleep(100);
Continue;
end;
if Pos('
User-Agent:', RequestHeader.Strings[i]) > 0
then
begin
RawAgent := RequestHeader.Strings[i];
AgentPos := Pos('
User-Agent:',RawAgent);
Agent := Copy(RawAgent,13,Length(RawAgent)-12);
Form1.Memo1.Lines.Add('
User-Agent : ' + Agent);
end;
if Copy(RequestHeader.Strings[i],1,3) = '
GET'
then
begin
Form1.Memo1.lines.add('
GET Request');
HttpPos := Pos('
HTTP',RequestHeader.Strings[i]);
Path := Copy(RequestHeader.Strings[i],5,HttpPos -6);
Form1.Memo1.lines.add('
Request For Page : ' + Path);
end;
if Copy(RequestHeader.Strings[i],1,4) = '
POST'
then
begin
Form1.Memo1.lines.add('
POST Request');
HttpPos := Pos('
HTTP',RequestHeader.Strings[i]);
Path := Copy(RequestHeader.Strings[i],6,HttpPos -6);
Form1.Memo1.lines.add('
Request For Page : ' + Path);
if RequestHeader.Text = '
OPTIONS /Kontakt/index.html HTTP/1.1'
then
Begin // KOntaktdaten kommen
Clientsocket.WaitForData(10);
TmpStr1 := Clientsocket.Receiveln('
#$D#$A');
if length(TmpStr1) > 0
then
Memo1.Lines.add('
Receive: ' + TmpStr1 ) ;
End;
// Accept Post
end;
if Copy(RequestHeader.Strings[i],1,7) = '
OPTIONS'
then
begin
Form1.Memo1.lines.add('
Option Request');
HttpPos := Pos('
HTTP',RequestHeader.Strings[i]);
Path := Copy(RequestHeader.Strings[i],9,HttpPos -6);
Form1.Memo1.lines.add('
Option Page : << ' + Path + '
>>');
if Copy(RequestHeader.Strings[i],1,7) = '
OPTIONS'
then
Begin // KOntaktdaten kommen
// Clientsocket.ReceiveFrom(mybuffer,length(mybuffer),);
Clientsocket.WaitForData(10);
TmpStr1 := Clientsocket.Receiveln('
#$D#$A');
if length(TmpStr1) > 0
then
Memo1.Lines.add('
Receive: ' + TmpStr1 ) ;
End;
end;
end;
// Behandlung der HTTP Anfrage
if FileExists(GetCurrentDir + '
/WebDocs' + Path)
then
begin
RequestFile.LoadFromFile(GetCurrentDir + '
/WebDocs' + Path);
ClientSocket.Sendln('
HTTP/1.0 200 OK');
ClientSocket.Sendln('
');
ClientSocket.Sendln(RequestFile.Text);
ClientSocket.Close;
RequestFile.Clear;
Exit;
end
Else
if Not FileExists(GetCurrentDir + '
/WebDocs' + Path)
then
begin
Form1.memo1.lines.add('
ERROR : 404 Page Not Found : <<'+ Path + '
>>');
RequestFile.LoadFromFile(GetCurrentDir + '
/Err/' + '
404.html');
ClientSocket.Sendln('
HTTP/1.0 404 Not Found');
ClientSocket.Sendln('
');
ClientSocket.Sendln(RequestFile.Text);
ClientSocket.Close;
RequestFile.Clear;
Exit;
end;
end;
RequestFile.Free;
end;
end.