Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Netzwerke (https://www.delphipraxis.net/14-netzwerke/)
-   -   Delphi HTTP Server mit Delphi 2007 und Indy (https://www.delphipraxis.net/109454-http-server-mit-delphi-2007-und-indy.html)

asdil12 1. Mär 2008 19:42


HTTP Server mit Delphi 2007 und Indy
 
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 1. Mär 2008 19:51

Re: HTTP Server mit Delphi 2007 und Indy
 
Die Signatur der Eventmethode scheinst sich geändert zu haben:
Delphi-Quellcode:
CommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);

asdil12 1. Mär 2008 20:16

Re: HTTP Server mit Delphi 2007 und Indy
 
das scheint er auch nicht zu mögen... :o

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 1. Mär 2008 20:18

Re: HTTP Server mit Delphi 2007 und Indy
 
Wie äussert sich das?

asdil12 1. Mär 2008 20:20

Re: HTTP Server mit Delphi 2007 und Indy
 
Zitat:

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

mkinzler 1. Mär 2008 20:25

Re: HTTP Server mit Delphi 2007 und Indy
 
Delphi-Quellcode:
uses ..., IdContext, ...;

SirThornberry 1. Mär 2008 20:25

Re: HTTP Server mit Delphi 2007 und Indy
 
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 1. Mär 2008 20:28

Re: HTTP Server mit Delphi 2007 und Indy
 
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 1. Mär 2008 22:48

Re: HTTP Server mit Delphi 2007 und Indy
 
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.


Alle Zeitangaben in WEZ +1. Es ist jetzt 17:14 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz