TCP-Server als Web-Server (Datein senden)

[mb1996]

Hi Leute,
ich habe mir einen TCP-Server (TTcpServer) zum Web-Server programmiert.
Funktioniert alles super.
Hier das Tutorial.
Nun habe ich folgende Fragen:
1. Wie kann ich ein Bild hochladen? Bei mir kam irgendwie kein Bild an :(
2. Wie kann ich Datein hochladen, die gedownloaded werden können? Bei mir kam nur eine kleine Datei zum download, welche irgendwie keine Inhalte hatte :( .
3. Kann man irgendwie die URL ändern (http://localhost:7777/ zu http://Name/ oder sogar http://Name.de).

Falls ihr den Code haben wollt:

Delphi-Quellcode:

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.

Vielen Dank schonmal für's lesen :-D

[rollstuhlfahrer]

Ähm du, wäre es nicht einfacher und gleichzeitig sinnvoller, wenn du statt einem TCPServer auf einen IdHTTPServer wechselst? Der sorgt nämlich nicht nur für die ankommenden Daten, sondern auch für die ausgehenden Daten.

Bernhard

[mb1996]

Kannst du mir ein gutes Tutorial nennnen?
Giebt es auch eine Komponente, die über das Internet geht? Und nicht nur lokal ist?

[Torpedo]

Was genau willst du machen?

[mb1996]

Eine art Homepage.
Das habe ich schon mit dem TCP-Server gemacht, nur ich konnte keine Daten hochladen.
Das brauche ich aber, denn jede gute Seite hat Bilder. Entweder ich nehme Bilder von anderen Seiten, dass darf man aber nicht immer. Oder ich lade meine eigenen hoch (perfekt). Ausserdem wär eine Funktion Download nicht schlecht. Am bessten wär es, wenn der Server übers Internet läuft.

[Torpedo]

Wieso verwendest du nicht einfach einen normalen Webserver (z.B. Apache)?

[mb1996]

Ich will das selber machen.
Ich bin auch zufrieden, wenn der Server lokal ist.
Ich will nur mal ein guten Webserver machen.

[rollstuhlfahrer]

Bei den Indy9-Demos ( http://www.indyproject.org/sockets/demos/index.en.aspx ) ist ein funktionierender Webserver dabei. Diesen kannst du als Lernobjekt inkl. Tutorial ansehen.

Bernhard

PS: Ich habe die Indy10 noch nicht getestet.

[mb1996]

!!!Vielen Dank Rollstuhlfahrer (xD)!!! :thumb:
Ich bin dabei, die Demo zu studieren.
Wenn mir noch fragen bleiben, werde ich sie hier bald reinschreiben.
Nur noch die Frage, ob man die URL ändern kann.
Aber schonmal vielen Dank :thumb:

[himitsu]

Zitat:

Zitat von mb1996

Nur noch die Frage, ob man die URL ändern kann.

Das hat zwar nix mit diesem Thema zu tun (also wenn weitere Fragen, dann einen neuen Thread dazu eröffnen), aber hier kommt es erstmal darauf an, was du willst.

Soll der Server "weltweit" erreichbar sein, dann wirst du z.B. einen Service wie DynIP ( www.dynip.com ) nutzen müssen, um deine IP mit einer Domain/URL zu verknüpfen
oder soll das nur lokal auf deinem PC so sein?

[mb1996]

Ne, ich meine, dass was ich auch oben gesagt habe.
http://Name/ oder http://Name.de.
Es muss nicht weltweit sein, aber wenn das geht, würde ich gern wissen, wie man das macht.

[rollstuhlfahrer]

wie schon beschrieben: mit dem Dienst von DynDNS kannst du dir einen festen Subdomainnamen sichern. Ansonsten benötigst du diese Domain, die du haben willst und einen Provider, der dir diese Domain verwaltet. Alles andere geht nur per IP und dein Server muss min. eine Portweiterleitung auf Port 80 haben.

Bernhard

[mb1996]

Gibt es dazu nicht noch ein Tutorial?

[rollstuhlfahrer]

nein, gibt es nicht. Genauso wenig, wie es dafür eine Komplettlösung oder einen Allheilsweg gibt. Das ist Sache des Einzelnen und jeder kann einen anderen Weg nehmen. Das macht es auch so wunderbar einfach/kompliziert (je nachdem wie rum man sich die Sache betrachtet).

http://www.dyndns.com/ hilft dir aber sicher weiter.


Bernhard

[mb1996]

Danke. Aber, ich denke so wichtig ist die URL für ein lokalen Web-Server auch nicht.
Nur noch eine Frage.
Mit [img]Bild.jpg[/img] sendet man ja ein Bild hoch.
Wie bietet man denn eine Datei zum Download an?

[rollstuhlfahrer]

Zitat:

Zitat von mb1996

Mit [img]Bild.jpg[/img] sendet man ja ein Bild hoch.

Einspruch. Damit fordert man den Webbrowser auf, ein Bild nachzuladen. Mehr nicht.

Wie bietet man ein Bild zum Download an?

Delphi-Quellcode:

AResponseInfo.ContentType := 'image/jpeg';
FileStream := TFileStream.Create(FILENAME, mfOpenRead);
AResponseInfo.ContentLength := FileStream.Size;
AResponseInfo.ContentStream := FileStream;

Bernhard

[ele]

Du solltest dich einwenig mit den HTTP Grundlagen beschäftigen...

Zitat:

Mit [img]Bild.jpg[/img] sendet man ja ein Bild hoch.

Stimmt z.B. überhaut nicht. Damit referenzierst du ein Bild in deiner HTML-Datei, da wird nichts hochgesendet oder runtergeladen.

Das liefern von Dateien über einen TidHTTPServer ist eigentlich ganz einfach:

Die Komponente TIdHTTPServer besitzt im wesentlichen eine wichtiges Ereignis: OnCommandGet

1) In diesem Ereignis wertest du die Adresse in ARequestInfo.Document aus und lieferst je nachdem andere Daten.

2) Du setzt AResponseInfo.ContentType auf einen Sinvollen Wert. Für jpg-Dateien wäre das z.B. 'image/jpeg'.

3) Du setzt den Inhalt der HTTP-Response entweder in AResponseInfo.ContentText (String) oder gleich AResponseInfo.ContentStream mit einem FileStream auf deine Datei:

Delphi-Quellcode:

procedure TMyMainForm.OnCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
  if SameText(ARequestInfo.Document, '/bild.jpg') then
  begin
    AResponseInfo.ContentType := 'image/jpeg';
    AResponseInfo.ContentStream := TFileStream.Create('bild.jpg', fmCreate);
  end;
end;

Der Rest is Fleissarbeit und Internet-Recherche. Es empfiehlt sich schwer zu verstehen was bei HTTP überhaupt abgeht. Wikipedia und Google sind deine Freunde.

[mb1996]

Also bei mein Http-Server kommt jetzt immer ein Fehler: Zugriffsverletzung bei Adresse 00408D6E in Modul 'Server.exe'. Lesen von Adresse 00007FFC
Was soll ich tuhen? Es liegt am Quellencode.
Kann mir jemand helfen?

[rollstuhlfahrer]

HI,

Zitat:

Zitat von mb1996 (Beitrag 1027432)

Zugriffsverletzung bei Adresse 00408D6E in Modul 'Server.exe'. Lesen von Adresse 00007FFC

Leider kann dir mit dieser Laufzeitfehlermeldung kann dir leider keiner helfen. Die ist nämlich bei jedem mal kompilieren ANDERS.

Zitat:

Zitat von mb1996 (Beitrag 1027432)

Was soll ich tuhen? Es liegt am Quellencode. Kann mir jemand helfen?

Schön. Und wie sieht der Quellcode aus?

Bernhard

[mb1996]

Ich habe es nach der Indy-Demo gemacht (ein bisschen verändert):

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ActnList, StdCtrls, IdComponent, IdTCPServer, IdHTTPServer, Buttons,
  ComCtrls, IdGlobal, IdBaseComponent, IdThreadMgr, IdThreadMgrDefault, syncobjs,
  IdThreadMgrPool, ExtCtrls, IdIntercept, IdIOHandlerSocket,
  IdCustomHTTPServer, idSocketHandle, XPMan, FileCtrl, IdStack;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    XPManifest1: TXPManifest;
    Label1: TLabel;
    edPort: TEdit;
    cbManageSessions: TCheckBox;
    cbEnableLog: TCheckBox;
    GroupBox2: TGroupBox;
    Label2: TLabel;
    Label3: TLabel;
    name: TEdit;
    passwort: TEdit;
    GroupBox3: TGroupBox;
    cbAuthentication: TCheckBox;
    GroupBox4: TGroupBox;
    lbSessionList: TListBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    HTTPServer: TIdHTTPServer;
    alGeneral: TActionList;
    idLog: TListBox;
    Label4: TLabel;
    edroot: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure ManageUserSession(AThread: TIdPeerThread;
      RequestInfo: TIdHTTPRequestInfo; ResponseInfo: TIdHTTPResponseInfo);
    procedure ServeVirtualFolder(AThread: TIdPeerThread;
      RequestInfo: TIdHTTPRequestInfo; ResponseInfo: TIdHTTPResponseInfo);
    procedure HTTPServerCommandGet(AThread: TIdPeerThread;
      ARequestInfo: TIdHTTPRequestInfo;
      AResponseInfo: TIdHTTPResponseInfo);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure HTTPServerSessionEnd(Sender: TIdHTTPSession);
    procedure HTTPServerSessionStart(Sender: TIdHTTPSession);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure lbSessionListDblClick(Sender: TObject);
    procedure HTTPServerConnect(AThread: TIdPeerThread);
    procedure HTTPServerExecute(AThread: TIdPeerThread);
    procedure HTTPServerCommandOther(Thread: TIdPeerThread;
      const asCommand, asData, asVersion: String);
    procedure HTTPServerStatus(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: String);

  private
    function GetMIMEType(sFile: TFileName): String;
  public
  EnableLog: boolean;
    MIMEMap: TIdMIMETable;
    procedure MyInfoCallback(Msg: String);
    procedure GetKeyPassword(var Password: String);
  end;

var
  Form1: TForm1;
  Enablelog:Boolean;
  MIMEMap: TIdMIMETable;
  UILock: TCriticalSection;
  an:boolean;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  Binding : TIdSocketHandle;
begin
If not httpserver.Active then
 begin
 Httpserver.Bindings.Clear;
 Binding:=HTTPServer.Bindings.Add;
 Binding.Port:=StrToIntDef(edPort.Text,80);
 Binding.IP:='127.0.0.1';
 end;

if not DirectoryExists(edRoot.text) then
  begin
    idlog.Items.Add (Format('Ordner (%s) nicht gefunden.',[edRoot.text]));
    httpserver.Active:=false;
  end
  else
  begin

try
EnableLog:=cbEnableLog.Checked;
HTTPServer.SessionState:=cbManageSessions.Checked;
HTTPServer.Active:=True;
idlog.Items.Add(format('Hört auf HTTP-Clients auf %s:%d.',[HTTPServer.Bindings[0].IP, HTTPServer.Bindings[0].Port]));

except
 on e:exception do
 begin
 HTTPServer.Active:=False;
 idlog.Items.Add(format('Fehler: %s in der Aktivität. Fehler ist:"%s".', [e.ClassName, e.Message]));
 end;
end;
end;
An:=HTTPServer.Active;
edPort.Enabled:=not An;
cbAuthentication.Enabled := not An;
cbEnableLog.Enabled := not an;
cbManageSessions.Enabled := not an;
name.Enabled:=not an;
passwort.Enabled:=not an;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
HTTPServer.Active:=False;

An:=HTTPServer.Active;
edPort.Enabled:=not An;
cbAuthentication.Enabled := not An;
cbEnableLog.Enabled := not an;
cbManageSessions.Enabled := not an;
name.Enabled:=not an;
passwort.Enabled:=not an;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
Button2.Click;
Application.Terminate;
end;

procedure TForm1.ManageUserSession(AThread: TIdPeerThread;
  RequestInfo: TIdHTTPRequestInfo; ResponseInfo: TIdHTTPResponseInfo);
var
  NumberOfView: Integer;
begin
  // Manage session informations
  if assigned(RequestInfo.Session) or (HTTPServer.CreateSession(AThread, ResponseInfo, RequestInfo) <> nil) then
  begin
    RequestInfo.Session.Lock;
    try
      NumberOfView := StrToIntDef(RequestInfo.Session.Content.Values['NumViews'], 0);
      inc(NumberOfView);
      RequestInfo.Session.Content.Values['NumViews'] := IntToStr(NumberOfView);
      RequestInfo.Session.Content.Values['UserName'] := RequestInfo.AuthUsername;
      RequestInfo.Session.Content.Values['Password'] := RequestInfo.AuthPassword;
    finally
      RequestInfo.Session.Unlock;
    end;
  end;
end;

procedure TForm1.ServeVirtualFolder(AThread: TIdPeerThread;
  RequestInfo: TIdHTTPRequestInfo; ResponseInfo: TIdHTTPResponseInfo);
begin
  ResponseInfo.ContentType := 'text/HTML';
  ResponseInfo.ContentText := '<html><head><title>Mappe</title></head><body>';

  if AnsiSameText(RequestInfo.Params.Values['action'], 'close') then
  begin
    // Closing user session
    RequestInfo.Session.Free;
    ResponseInfo.ContentText :=  ResponseInfo.ContentText + '<h1>Session cleared</h1><p><a href="/sessions">Back</a></p>';
  end
  else
  begin
    if assigned(RequestInfo.Session) then
    begin
      if Length(RequestInfo.Params.Values['ParamName'])>0 then
      begin
        // Add a new parameter to the session
        ResponseInfo.Session.Content.Values[RequestInfo.Params.Values['ParamName']] := RequestInfo.Params.Values['Param'];
      end;
      ResponseInfo.ContentText := ResponseInfo.ContentText + '<h1>Informationen</h1>';
      RequestInfo.Session.Lock;
      try
        ResponseInfo.ContentText := ResponseInfo.ContentText + '<table border=1>';
        ResponseInfo.ContentText := ResponseInfo.ContentText + '<tr><td>SessionID</td><td>' + RequestInfo.Session.SessionID + '</td></tr>';
        ResponseInfo.ContentText := ResponseInfo.ContentText + '<tr><td>Number of page requested during this session</td><td>'+RequestInfo.Session.Content.Values['NumViews']+'</td></tr>';
        ResponseInfo.ContentText := ResponseInfo.ContentText + '<tr><td>Session data (raw)</td><td><pre>' + RequestInfo.Session.Content.Text + '</pre></td></tr>';
        ResponseInfo.ContentText := ResponseInfo.ContentText + '</table>';
        ResponseInfo.ContentText := ResponseInfo.ContentText + '<h1>Tools:</h1>';
        ResponseInfo.ContentText := ResponseInfo.ContentText + '<h2>Add new parameter</h2>';
        ResponseInfo.ContentText := ResponseInfo.ContentText + '<form method="POST">';
        ResponseInfo.ContentText := ResponseInfo.ContentText + '<p>Name: <input type="text" Name="ParamName"></p>';
        ResponseInfo.ContentText := ResponseInfo.ContentText + '<p>value: <input type="text" Name="Param"></p>';
        ResponseInfo.ContentText := ResponseInfo.ContentText + '<p><input type="Submit"><input type="reset"></p>';
        ResponseInfo.ContentText := ResponseInfo.ContentText + '</form>';
        ResponseInfo.ContentText := ResponseInfo.ContentText + '<h2>Other:</h2>';
        ResponseInfo.ContentText := ResponseInfo.ContentText + '<p><a href="' + RequestInfo.Document + '?action=close">Close current session</a></p>';
      finally
        RequestInfo.Session.Unlock;
      end;
    end
    else
    begin
      ResponseInfo.ContentText := ResponseInfo.ContentText + '<p color=#FF000>No session</p>';
    end;
  end;
  ResponseInfo.ContentText := ResponseInfo.ContentText + '</body></html>';
end;

procedure TForm1.HTTPServerCommandGet(AThread: TIdPeerThread;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);

  procedure AuthFailed;
  var 
      ResponseInfo: TIdHTTPResponseInfo;
  begin
    ResponseInfo.ContentText := '<html><head><title>Fehler</title></head><body><h1>Fehler</h1>Sie haben keine Befugnis dieses Dokument zu sehen-</body></html>';
    ResponseInfo.ResponseNo := 403;
  end;


procedure AccessDenied;
  var RequestInfo: TIdHTTPRequestInfo;
      ResponseInfo: TIdHTTPResponseInfo;
  begin
    ResponseInfo.ContentText := '<html><head><title>Error</title></head><body><h1>Access denied</h1>'#13 +
      'Sie sind nicht befugt, die Seite zu öffnen.</body></html>';
    ResponseInfo.ResponseNo := 403;
  end;


var
 LocalDoc: string;
  ByteSent: Cardinal;
  ResultFile: TFileStream;
  RequestInfo: TIdHTTPRequestInfo;
  ResponseInfo: TIdHTTPResponseInfo;
begin
idlog.Items.Add(Format( 'Befehl %s %s empfangen von %s:%d',
                         [RequestInfo.Command, RequestInfo.Document,
                         TIdIOHandlerSocket(AThread.Connection.IOHandler).Binding.PeerIP,
                         TIdIOHandlerSocket(AThread.Connection.IOHandler).Binding.PeerPort]));

if cbAuthentication.Checked and ((RequestInfo.AuthUsername <> Name.text) or (RequestInfo.AuthPassword <> Passwort.text)) then
 begin
 Authfailed;
 exit;
 end;

 if cbManageSessions.checked then
    ManageUserSession(AThread, RequestInfo, ResponseInfo);
  if (Pos('/session', LowerCase(RequestInfo.Document)) = 1) then
  begin
    ServeVirtualFolder(AThread, RequestInfo, ResponseInfo);
  end
  else
  begin
  LocalDoc := ExpandFilename(edRoot.text + RequestInfo.Document);
  LocalDoc := ExpandFilename(edRoot.text + RequestInfo.Document);

    if not FileExists(LocalDoc) and DirectoryExists(LocalDoc) and FileExists(ExpandFileName(LocalDoc + '/index.html')) then
    begin
      LocalDoc := ExpandFileName(LocalDoc + '/index.txt');
    if FileExists(LocalDoc) then
    begin
      if AnsiSameText(Copy(LocalDoc, 1, Length(edRoot.text)), edRoot.Text) then // File down in dir structure
      begin
        if AnsiSameText(RequestInfo.Command, 'HEAD') then
        begin

          ResultFile := TFileStream.create(LocalDoc, fmOpenRead   or fmShareDenyWrite);
          try
            ResponseInfo.ResponseNo := 200;
            ResponseInfo.ContentType := GetMIMEType(LocalDoc);
            ResponseInfo.ContentLength := ResultFile.Size;
          finally
            ResultFile.Free;
          end;
          end
          else
           begin
           ByteSent := HTTPServer.ServeFile(AThread, ResponseInfo, LocalDoc);
          Idlog.Items.Add(Format('Speicher Datei %s (%d bytes / %d bytes sent) in %s:%d',
                                [LocalDoc, ByteSent, FileSizeByName(LocalDoc),
                                 TIdIOHandlerSocket(AThread.Connection.IOHandler).Binding.PeerIP,
                                 TIdIOHandlerSocket(AThread.Connection.IOHandler).Binding.PeerPort]));
        end;
      end
      else
        AccessDenied;
        end
        else
        begin
      ResponseInfo.ResponseNo := 404; // Not found
      ResponseInfo.ContentText := '<html><head><title>Fehler</title></head><body><h1>' + ResponseInfo.ResponseText + '</h1></body></html>';
    end;

    end;

  end;

end;



procedure TForm1.FormCreate(Sender: TObject);
begin
UILock := TCriticalSection.Create;
  MIMEMap := TIdMIMETable.Create(true);
  edRoot.text := ExtractFilePath(Application.exename) + 'Web';
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 MIMEMap.Free;
  UILock.Free;
end;

function Tform1.GetMIMEType(sFile: TFileName): String;
begin
  result := MIMEMap.GetFileMIMEType(sFile);
end;

procedure TForm1.HTTPServerSessionEnd(Sender: TIdHTTPSession);
var
  dt: TDateTime;
  i: Integer;
  hour, min, s, ms: word;
begin
  idlog.Items.Add('Beendent Sitzung %s bei %s');
  dt := (StrToDateTime(sender.Content.Values['StartTime'])-now);
  DecodeTime(dt, hour, min, s, ms);
  i := ((Trunc(dt)*24 + hour)*60 + min)*60 + s;
  idlog.items.add(Format('Die Sitzung dauerte: %d Sekunden', [i]));


end;

procedure TForm1.HTTPServerSessionStart(Sender: TIdHTTPSession);
begin
 sender.Content.Values['StartTime'] := DateTimeToStr(Now);
  idlog.Items.Add(Format('Startet eine SItzung %s bei %s',[Sender.SessionID, FormatDateTime(LongTimeFormat, now)]));
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
HTTPServer.Active:=False;
end;

procedure TForm1.lbSessionListDblClick(Sender: TObject);
begin
if lbSessionList.ItemIndex > -1 then
  begin
    HTTPServer.EndSession(lbSessionList.Items[lbSessionList.ItemIndex]);
  end;
end;

procedure TFOrm1.MyInfoCallback(Msg:STring);
begin
idLog.Items.Add(msg);
end;

procedure TForm1.GetKeyPassword(var Password:STring);
begin
 Password := 'aaaa'; 
end;

procedure TForm1.HTTPServerConnect(AThread: TIdPeerThread);
begin
idlog.Items.Add('Benutzer loggte ein');
end;

procedure TForm1.HTTPServerExecute(AThread: TIdPeerThread);
begin
idlog.Items.Add('Gestartet');
end;

procedure TForm1.HTTPServerCommandOther(Thread: TIdPeerThread;
  const asCommand, asData, asVersion: String);
begin
idlog.Items.Add('Gebietet: ' + asCommand);
end;

procedure TForm1.HTTPServerStatus(ASender: TObject;
  const AStatus: TIdStatus; const AStatusText: String);
begin
idlog.Items.Add('Status: ' + astatustext);
end;

end.

Fehler bei Delphi:
[Warnung] Unit1.pas(10): Unit 'FileCtrl' ist plattformspezifisch
[Warnung] Unit1.pas(220): Variable 'ResponseInfo' ist möglicherweise nicht initialisiert worden
[Warnung] Unit1.pas(229): Variable 'ResponseInfo' ist möglicherweise nicht initialisiert worden
[Hinweis] Unit1.pas(226): Variable 'RequestInfo' wurde deklariert, aber in 'AccessDenied' nicht verwendet
[Warnung] Unit1.pas(245): Variable 'RequestInfo' ist möglicherweise nicht initialisiert worden
[Warnung] Unit1.pas(254): Variable 'ResponseInfo' ist möglicherweise nicht initialisiert worden

[SirThornberry]

Das ist jetzt aber nicht dein ernst oder? Warum postest du den gesamten Quelltext anstelle nur den Teil bei dem der Fehler auftritt?

[mb1996]

^^
Hier der Fehler:

Delphi-Quellcode:

idlog.Items.Add(Format( 'Befehl %s %s empfangen von %s:%d',
                         [RequestInfo.Command, RequestInfo.Document,
                         TIdIOHandlerSocket(AThread.Connection.IOHandler).Binding.PeerIP,
                         TIdIOHandlerSocket(AThread.Connection.IOHandler).Binding.PeerPort]));

[mb1996]

:glaskugel:

[DataCool]

Hi,

interessant wäre auch in welchem Event Du diese Zeilen benutzt,
dann kann man die :glaskugel: auch wieder in den Schrank packen ;-)

Ich vermute jetzt mal das bei Deinem :

Delphi-Quellcode:

idlog.Items.Add(Format( 'Befehl %s %s empfangen von %s:%d',
    [RequestInfo.Command, RequestInfo.Document,      // RequestInfo = Nil ?
    TIdIOHandlerSocket(AThread.Connection.IOHandler).Binding.PeerIP, // Binding = Nil ?
    TIdIOHandlerSocket(AThread.Connection.IOHandler).Binding.PeerPort])); // Binding = Nil ?

Ein Breakpoint und debuggen sollten den Fehler recht schnell ausfindig machen,
der genaue Wortlaut der Fehlermeldung könnte übrings den ein oder anderen dazu veranlassen
Dir die Ursache+Lösung zu verraten ;-)

Greetz Data

[DataCool]

Hi,

hatte jetzt gerade nochmal Deinen "gesamten" Source überflogen und geschaut,
wo genau den die besagte Zeile im Code steht.

Und siehe da, ich lag mit meiner Vermutung "gold richtig!,
RequestInfo zeigt ins Nirvana !!!

Warum ?!

Delphi-Quellcode:

procedure TForm1.HTTPServerCommandGet(AThread: TIdPeerThread;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);

  procedure AuthFailed;
  var
      ResponseInfo: TIdHTTPResponseInfo;
  begin
    ResponseInfo.ContentText := '<html><head><title>Fehler</title></head><body><h1>Fehler</h1>Sie haben keine Befugnis dieses Dokument zu sehen-</body></html>';
    ResponseInfo.ResponseNo := 403;
  end;


procedure AccessDenied;
  var RequestInfo: TIdHTTPRequestInfo;
      ResponseInfo: TIdHTTPResponseInfo;
  begin
    ResponseInfo.ContentText := '<html><head><title>Error</title></head><body><h1>Access denied</h1>'#13 +
      'Sie sind nicht befugt, die Seite zu öffnen.</body></html>';
    ResponseInfo.ResponseNo := 403;
  end;


var
 LocalDoc: string;
  ByteSent: Cardinal;
  ResultFile: TFileStream;
  RequestInfo: TIdHTTPRequestInfo;
  ResponseInfo: TIdHTTPResponseInfo;
begin
// hier fehlt eine Zuweisung der Parameter an Deine Lokalen Variablen
  RequestInfo := ARequestInfo;
  ResponseInfo := AResponseInfo;
// ---- jetzt sollte die folgende Zeile gehen
idlog.Items.Add(Format( 'Befehl %s %s empfangen von %s:%d',
                         [RequestInfo.Command, RequestInfo.Document,
                         TIdIOHandlerSocket(AThread.Connection.IOHandler).Binding.PeerIP,
                         TIdIOHandlerSocket(AThread.Connection.IOHandler).Binding.PeerPort]));
  // .... Rest ist nicht mehr relevant

^^ Damit sollte Dein Problem gelöst sein ^^

Allerdings hätte Dich schon die Compiler-Meldung:
[Warnung] Unit1.pas(220): Variable 'ResponseInfo' ist möglicherweise nicht initialisiert worden
[Warnung] Unit1.pas(229): Variable 'ResponseInfo' ist möglicherweise nicht initialisiert worden
[Warnung] Unit1.pas(245): Variable 'RequestInfo' ist möglicherweise nicht initialisiert worden
[Warnung] Unit1.pas(254): Variable 'ResponseInfo' ist möglicherweise nicht initialisiert worden

darauf aufmerksam gemacht haben müssen.

Was mich aber noch viel mehr beschäftigt ist die Frage warum Du überhaupt extra Variablen für "ResponseInfo" und "RequestInfo"
verwendet hast, diese bekommst Du doch wunderbar als Funktions-/Procedure Parameter mitgeliefert.

Delphi-Quellcode:

procedure TForm1.HTTPServerCommandGet(AThread: TIdPeerThread;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);

Du hast jetzt in einer Procedure an 3 Stellen RequestInfo und ResponseInfo deklariert ....
Das geht gar nicht :wink:
Einfach komplett mit "ARequestInfo" und "AResponseInfo" arbeiten und die ganzen lokalen Varianten rausschmeissen.

Greetz Data

[mb1996]

Danke, ,,früher" hatte ich das noch nicht so gewusst... ^^
Habe hier nicht mehr reingeschaut. Das hatte ich dann auch gemerkt. Trotzdem Danke