unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, XPMan, Sockets;
type
TForm1 =
class(TForm)
GroupBox1: TGroupBox;
Memo1: TMemo;
XPManifest1: TXPManifest;
Button1: TButton;
Button2: TButton;
Button3: TButton;
TcpServer1: TTcpServer;
Button7: TButton;
procedure Button3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure TcpServer1Accept(Sender: TObject;
ClientSocket: TCustomIpClient);
procedure Button7Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button3Click(Sender: TObject);
begin
Button2.Click;
application.Terminate;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TCPServer1.Open;
Memo1.Lines.Add('
Server gestartet');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
TCPServer1.Close;
Memo1.Lines.Add('
Server gestoppt');
end;
procedure TForm1.TcpServer1Accept(Sender: TObject;
ClientSocket: TCustomIpClient);
var Line:
String;
i:Integer;
path:
String;
Httppos:Integer;
begin
Line:='
';
while ClientSocket.Connected
and (Line<>'
')
do
begin
Line:=ClientSocket.Receiveln();
Memo1.Lines.Add(Line);
if copy(Line,1,3)= '
GET'
then
begin
Httppos:= Pos('
HTTP',Line);
Path:=Copy(Line,5,HTTPPos-6);
Memo1.Lines.Add('
Path: ' + Path);
end;
end;
If Path='
/'
then
Path:='
Seiten/index.html';
If Fileexists('
htdocs/' + Path)
then
with TStringList.Create
do
begin
Loadfromfile('
htdocs/' + path);
ClientSocket.Sendln('
HTTP:/1.0 200 OK');
ClientSocket.Sendln('
');
ClientSOcket.Sendln(Text);
ClientSOcket.Close;
Free;
exit;
end;
ClientSocket.Sendln('
HTTP:/1.0 404 Not Found');
ClientSocket.Sendln('
');
ClientSOcket.Sendln('
<h1>Nicht gefunden</h1>
Path: ' + Path);
ClientSocket.Close;
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
Memo1.Clear;
Memo1.Lines.Add('
---LOG---');
end;
end.