HTTP Server mit Delphi 2007 und Indy

[asdil12]

Wenn ich das mit Delphi 2007 Compilieren will, mag er das TIdPeerThread nicht.

Gibt es bei der 07er Version ein neues alias dafür oder so?

Delphi-Quellcode:

unit Unit4;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdCustomTCPServer,
  IdCustomHTTPServer, IdHTTPServer;

type
  TForm4 = class(TForm)
    IdHTTPServer1: TIdHTTPServer;
    Button1: TButton;
    Label1: TLabel;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure IdHTTPServer1CommandGet(AThread: TIdPeerThread;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
    procedure IdHTTPServer1AfterBind(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form4: TForm4;

implementation

{$R *.dfm}


procedure TForm4.Button1Click(Sender: TObject);
begin
     IdHTTPServer1.Active := false;
     IdHTTPServer1.DefaultPort   := 8888; // Port 8888 ist Standard
     try
        IdHTTPServer1.Active := true;
     except
        raise;
     end;

     if IdHTTPServer1.Active then
     begin

       label1.Caption := 'Server ist: ONLINE an Port 8888';
     end;
end;

procedure TForm4.Button2Click(Sender: TObject);
begin
     try
        IdHTTPServer1.Active := false;
     except
       raise;
     end;

     if not IdHTTPServer1.Active then
     begin
      Label1.Caption := 'Server ist: OFFLINE';
     end;
end;



procedure TForm4.IdHTTPServer1AfterBind(Sender: TObject);
begin
//
end;

procedure TForm4.IdHTTPServer1CommandGet(AThread: TIdPeerThread;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
Var
  Stream: TFilestream;
  TheString : String;
  begin
if ARequestInfo.Document = '/' then begin
AResponseInfo.ContentType   := 'image/jpeg';
IF  fileexists('test.jpg') = true then ARequestInfo.Document := 'test.jpg';
end;
Stream := TfileStream.Create('test.jpg', fmOpenRead or fmShareDenyWrite );
AResponseInfo.ContentStream := Stream;
setlength(TheString, stream.size);
stream.Read(TheString[1], stream.size);
end;





end.

[mkinzler]

Die Signatur der Eventmethode scheinst sich geändert zu haben:

Delphi-Quellcode:

CommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);

[asdil12]

das scheint er auch nicht zu mögen...

Delphi-Quellcode:

unit Unit4;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdCustomTCPServer,
  IdCustomHTTPServer, IdHTTPServer;

type
  TForm4 = class(TForm)
    IdHTTPServer1: TIdHTTPServer;
    Button1: TButton;
    Label1: TLabel;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure TForm4.IdHTTPServer1CommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
    procedure IdHTTPServer1AfterBind(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form4: TForm4;

implementation

{$R *.dfm}


procedure TForm4.Button1Click(Sender: TObject);
begin
     IdHTTPServer1.Active := false;
     IdHTTPServer1.DefaultPort   := 8888; // Port 8888 ist Standard
     try
        IdHTTPServer1.Active := true;
     except
        raise;
     end;

     if IdHTTPServer1.Active then
     begin

       label1.Caption := 'Server ist: ONLINE an Port 8888';
     end;
end;

procedure TForm4.Button2Click(Sender: TObject);
begin
     try
        IdHTTPServer1.Active := false;
     except
       raise;
     end;

     if not IdHTTPServer1.Active then
     begin
      Label1.Caption := 'Server ist: OFFLINE';
     end;
end;



procedure TForm4.IdHTTPServer1AfterBind(Sender: TObject);
begin
//
end;

procedure TForm4.IdHTTPServer1CommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
Var
  Stream: TFilestream;
  TheString : String;
  begin
if ARequestInfo.Document = '/' then begin
AResponseInfo.ContentType   := 'image/jpeg';
IF  fileexists('test.jpg') = true then ARequestInfo.Document := 'test.jpg';
end;
Stream := TfileStream.Create('test.jpg', fmOpenRead or fmShareDenyWrite );
AResponseInfo.ContentStream := Stream;
setlength(TheString, stream.size);
stream.Read(TheString[1], stream.size);
end;





end.

[mkinzler]

Wie äussert sich das?

[asdil12]

Zitat:

[DCC Fehler] Unit4.pas(18): E2003 Undefinierter Bezeichner: 'TIdContext'

[mkinzler]

uses ..., IdContext, ...;

[SirThornberry]

welche Delphi Version hattest du vorher? Und das wichtigste: welche Indy-Version hattest du vorher und welche Indy-Version hast du jetzt? Mit dem Refactoring kannst du übrigens die benötigten Units suchen lassen.

[asdil12]

davor hatte ich garkeine, jetzt habe ich RAD 2007 und das mitgelieferte indy

der code ist aus dem forum...


und wie geht das genau mit dem Refactoring - ich bin noch einsteiger und das projekt besteht sowieso nur aus einer unit...

[asdil12]

ich weiß nicht wie, aber jetzt läuft er - das heißt, er liefert eine weiße seite aus, wenn ich ihn im browser öffne....


wie kann ich ihn dazu bringen, das aktuelle verzeichnis als root dir zu verwenden und nicht nach einer index file zu suchen (er soll immer dirlist machen)

Delphi-Quellcode:

unit Unit4;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdCustomTCPServer,
  IdCustomHTTPServer, IdHTTPServer, idContext, HTTPApp, HTTPProd;
type
  TForm4 = class(TForm)
    IdHTTPServer1: TIdHTTPServer;
    Button1: TButton;
    Label1: TLabel;
    Button2: TButton;
    PageProducer1: TPageProducer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure IdHTTPServer1CommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
    procedure IdHTTPServer1AfterBind(Sender: TObject);
     procedure pgpEHTMLHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form4: TForm4;

implementation

{$R *.dfm}


procedure TForm4.Button1Click(Sender: TObject);
begin
     IdHTTPServer1.Active := false;
     IdHTTPServer1.DefaultPort   := 8888; // Port 8888 ist Standard
     try
        IdHTTPServer1.Active := true;
     except
        raise;
     end;

     if IdHTTPServer1.Active then
     begin

       label1.Caption := 'Server ist: ONLINE an Port 8888';
     end;
end;

procedure TForm4.Button2Click(Sender: TObject);
begin
     try
        IdHTTPServer1.Active := false;
     except
       raise;
     end;

     if not IdHTTPServer1.Active then
     begin
      Label1.Caption := 'Server ist: OFFLINE';
     end;
end;

 procedure  TForm4.pgpEHTMLHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
var
  LTag: String;
begin
  LTag := LowerCase(TagString);
  if LTag = 'date' then
    ReplaceText := DateToStr(Now)
  else if LTag = 'time' then
    ReplaceText := TimeToStr(Now)
  else if LTag = 'datetime' then
    ReplaceText := DateTimeToStr(Now)
  else if LTag = 'server' then
   // ReplaceText := 'Meinserver'.'Indy';
end;

procedure TForm4.IdHTTPServer1AfterBind(Sender: TObject);
begin
//
end;

procedure TForm4.IdHTTPServer1CommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
Var
  Stream: TFilestream;
  TheString : String;
        I: Integer;


  RequestedDocument, FileName, CheckFileName: String;
  begin
      // requested document
  RequestedDocument := ARequestInfo.Document;

   // convert all '/' to '\'
  FileName := RequestedDocument;
  I := Pos('/', FileName);
  while I > 0 do
  begin
    FileName[I] := '\';
    I := Pos('/', FileName);
  end;
    // locate requested file
 // FileName := '.\' + FileName;

 //MYCODE START

  
  try
    // check whether file or folder was requested
    if AnsiLastChar(FileName)^ = '\' then
      // folder - reroute to default document
      CheckFileName := FileName + 'index.html'
    else
      // file - use it
      CheckFileName := FileName;
    if FileExists(CheckFileName) then
    begin
      // file exists
      if LowerCase(ExtractFileExt(CheckFileName)) = '.ehtm' then
      begin
        // Extended HTML - send through internal tag parser
        PageProducer1 := PageProducer1.Create(Self);
        try
          // set source file name
          PageProducer1.HTMLFile := CheckFileName;
          // set event handler
          PageProducer1.OnHTMLTag := pgpEHTMLHTMLTag;
          // parse !
          AResponseInfo.ContentText := PageProducer1.Content;
        finally
          PageProducer1.Free;
        end;
      end else begin
        // return file as-is
        // log
       // Log('Returning Document: ' + CheckFileName);
        // open file stream
        AResponseInfo.ContentStream :=
          TFileStream.Create(CheckFileName, fmOpenRead or fmShareCompat);
      end;
    end;
  finally
    if Assigned(AResponseInfo.ContentStream) then
    begin
      // response stream does exist
      // set length
      AResponseInfo.ContentLength := AResponseInfo.ContentStream.Size;
      // write header
      AResponseInfo.WriteHeader;
      // return content
      AResponseInfo.WriteContent;
      // free stream
      AResponseInfo.ContentStream.Free;
      AResponseInfo.ContentStream := nil;
    end else if AResponseInfo.ContentText <> '' then begin
      // set length
      AResponseInfo.ContentLength := Length(AResponseInfo.ContentText);
      // write header
      AResponseInfo.WriteHeader;
      // return content
    end else begin
      if not AResponseInfo.HeaderHasBeenWritten then
      begin
        // set error code
        AResponseInfo.ResponseNo := 404;
        AResponseInfo.ResponseText := 'Document not found';
        // write header
        AResponseInfo.WriteHeader;
      end;
      // return content
      AResponseInfo.ContentText := 'The document requested is not availabe.';
      AResponseInfo.WriteContent;
    end;
  end;


 //MYCODE END




if ARequestInfo.Document = '/' then begin
AResponseInfo.ContentType   := 'image/jpeg';
IF  fileexists('test.jpg') = true then ARequestInfo.Document := 'test.jpg';
end;
Stream := TfileStream.Create('test.jpg', fmOpenRead or fmShareDenyWrite );
AResponseInfo.ContentStream := Stream;
setlength(TheString, stream.size);
stream.Read(TheString[1], stream.size);
end;





end.