Thema: WebServer

Einzelnen Beitrag anzeigen

lucy

Registriert seit: 25. Okt 2017
63 Beiträge
 
Delphi XE7 Starter
 
#1

WebServer

  Alt 26. Okt 2022, 14:27
Delphi Version XE 7 Starter

Hallo haben einen kleinen Webserver, der soweit ganz gut läuft (HTML).

Jetzt würde ich gerne auch (PHP Scripte einbinden).

Wer kann mir helfen?

Was für ein "ContentType:='text/html'" brauche ich für PHP ?

Hier ein Stück Quelltext:

Code:
procedure TForm1.ServerCommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var Stream: TFileStream;
    Groesse: String;
begin
 if (CheckBox1.Checked=True) and ((ARequestinfo.AuthUsername<>Edit2.Text) or (ARequestinfo.AuthPassword<>Edit3.Text)) then
  begin
    AResponseinfo.ContentText:='Benutzername und Passwort...';
    AResponseinfo.AuthRealm:='TEST-Interface';
  end else
   begin
     if ARequestinfo.Document='/' then
      begin
        AResponseinfo.ContentType:='text/html';
        Stream:=TFileStream.Create('htdocs/index.html', fmOpenRead or fmShareDenyWrite);
        AResponseinfo.ContentStream:=Stream;
        setlength(Groesse, Stream.Size);
        Stream.Read(Groesse[1], Stream.Size);
        Memo1.Lines.Add(datetostr(date) + ' | ' + timetostr(time) + ': Client ' + ARequestinfo.RemoteIP + ' hat die Datei index.html (' + inttostr(round(Stream.Size /1024)) + 'kb) angefordert.');
      end;
   end;
end;
Quelltext komplett
Code:
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.XPMan,
  IdBaseComponent, IdComponent, IdCustomTCPServer, IdCustomHTTPServer,
  IdHTTPServer, IdContext;

type
  TForm1 = class(TForm)
    TrayIcon1: TTrayIcon;
    Label1: TLabel;
    Edit1: TEdit;
    GroupBox1: TGroupBox;
    Memo1: TMemo;
    CheckBox1: TCheckBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit2: TEdit;
    Edit3: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Server: TIdHTTPServer;
    Button4: TButton;
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ServerConnect(AContext: TIdContext);
    procedure ServerDisconnect(AContext: TIdContext);
    procedure ServerCommandGet(AContext: TIdContext;
      ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
    procedure TrayIcon1DblClick(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  user: Integer;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
 Server.DefaultPort:=Strtoint(Edit1.Text);
 Server.Active:=True;

 Memo1.Lines.Add('Status: ' + datetostr(date) + ' | ' + timetostr(time) + ': Server gestartet');
 Button1.Enabled:=False;
 Button2.Enabled:=True;
 Label1.Enabled:=False;
 Edit1.Enabled:=False;
end;

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

 Memo1.Lines.Add('Status: ' + datetostr(date) + ' | ' + timetostr(time) + ': Server gestoppt');
 Button1.Enabled:=True;
 Button2.Enabled:=False;
 Label1.Enabled:=True;
 Edit1.Enabled:=True;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 Memo1.Lines.Clear;
 Memo1.Lines.Add('Server 1.0');
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  Hide();
  WindowState := wsMinimized;
  TrayIcon1.Visible := True;
  TrayIcon1.Animate := True;
  TrayIcon1.ShowBalloonHint;
end;

procedure TForm1.ServerCommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var Stream: TFileStream;
    Groesse: String;
begin
 if (CheckBox1.Checked=True) and ((ARequestinfo.AuthUsername<>Edit2.Text) or (ARequestinfo.AuthPassword<>Edit3.Text)) then
  begin
    AResponseinfo.ContentText:='Benutzername und Passwort...';
    AResponseinfo.AuthRealm:='TEST-Interface';
  end else
   begin
     if ARequestinfo.Document='/' then
      begin
        AResponseinfo.ContentType:='text/html';
        Stream:=TFileStream.Create('htdocs/index.html', fmOpenRead or fmShareDenyWrite);
        AResponseinfo.ContentStream:=Stream;
        setlength(Groesse, Stream.Size);
        Stream.Read(Groesse[1], Stream.Size);
        Memo1.Lines.Add(datetostr(date) + ' | ' + timetostr(time) + ': Client ' + ARequestinfo.RemoteIP + ' hat die Datei index.html (' + inttostr(round(Stream.Size /1024)) + 'kb) angefordert.');
      end;
   end;
end;

procedure TForm1.ServerConnect(AContext: TIdContext);
begin
 User:=User +1;
 GroupBox1.Caption:='Log (User: ' + inttostr (user) + '):';
end;

procedure TForm1.ServerDisconnect(AContext: TIdContext);
begin
 User:=User -1;
 GroupBox1.Caption:='Log (User: ' + inttostr (user) + '):';
end;

procedure TForm1.TrayIcon1DblClick(Sender: TObject);
begin
  TrayIcon1.Visible := False;
  Show();
  WindowState := wsNormal;
  Application.BringToFront();
end;

end.
  Mit Zitat antworten Zitat