TCP-Server als Web-Server (Datein senden)

[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