unit1.pas

Delphi快速开发Web Server

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, rtcDataSrv, rtcConn, rtcHttpSrv, rtcInfo;

type
  TForm1 = class(TForm)
    RtcDualDataServerLinkB: TRtcDualDataServerLink;
    RtcDualDataServerLink: TRtcDualDataServerLink;
    RtcDualDataServerLinkA: TRtcDualDataServerLink;
    HttpServer8080: TRtcHttpServer;
    HttpServer1975: TRtcHttpServer;
    HttpServer443: TRtcHttpServer;
    HttpServer80: TRtcHttpServer;
    RtcDataProvider1: TRtcDataProvider;
    RtcDataProvider2: TRtcDataProvider;
    RtcDataProvider3: TRtcDataProvider;
    RtcDataProvider4: TRtcDataProvider;
    procedure RtcDataProvider1CheckRequest(Sender: TRtcConnection);
    procedure FormCreate(Sender: TObject);
    procedure RtcDataProvider2CheckRequest(Sender: TRtcConnection);
    procedure RtcDataProvider3CheckRequest(Sender: TRtcConnection);
    procedure RtcDataProvider4CheckRequest(Sender: TRtcConnection);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
  begin
  HttpServer80.Listen;
  HttpServer443.Listen;
  HttpServer8080.Listen;
  HttpServer1975.Listen;
  end;

procedure TForm1.FormDestroy(Sender: TObject);
  var
    w:longword;
  begin
  HttpServer80.StopListen;
  HttpServer443.StopListen;
  HttpServer8080.StopListen;
  HttpServer1975.StopListen;

  w:=GetTickCount;
  while (HttpServer80.TotalConnectionCount>0) and (GetTickCount-w<10000) do
    begin
    Application.ProcessMessages;
    Sleep(10);
    end;
  end;

procedure TForm1.RtcDataProvider1CheckRequest(Sender: TRtcConnection);
  begin
  with TRtcDataServer(Sender) do
    if Request.FileName='/' then
      begin
      Accept;
      Write('ALL Servers, you are on Server '+ServerPort);
      end;
  end;

procedure TForm1.RtcDataProvider2CheckRequest(Sender: TRtcConnection);
  begin
  with TRtcDataServer(Sender) do
    if Request.FileName='/a' then
      begin
      Accept;
      Write('80 and 443 Servers, you are on Server '+ServerPort);
      end;
  end;

procedure TForm1.RtcDataProvider3CheckRequest(Sender: TRtcConnection);
  begin
  with TRtcDataServer(Sender) do
    if Request.FileName='/b' then
      begin
      Accept;
      Write('8080 and 1975 Servers, you are on Server '+ServerPort);
      end;
  end;

procedure TForm1.RtcDataProvider4CheckRequest(Sender: TRtcConnection);
  begin
  with TRtcDataServer(Sender) do
    if Request.FileName='/c' then
      begin
      Accept;
      Write('80 Server, you are on Server '+ServerPort);
      end;
  end;

end.