用Delphi打造自己的WEB服务器

使用indy的IdHTTPServer控件：（限于篇幅，部分内容省略）

unit Unit1;



interface

uses

...... ActiveX,IdBaseComponent, IdComponent, IdCustomTCPServer, IdCustomHTTPServer,IdHTTPServer,IdTCPServer,IdContext;

type

......

procedure Server1CommandGet(AContext: TIdContext;ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);

procedure WebBrowser1NavigateComplete2(ASender: TObject;

const pDisp: IDispatch; var URL: OleVariant);

private

{ Private declarations }

protected

FHTMLDir: string;

FURL:string;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

server1.Active:=false;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

FHTMLDir:= ExtractFilePath(Application.ExeName) + 'WEBROOT';

FURL:='http://127.0.0.1:'+inttostr(server1.DefaultPort)+'/';

end;

procedure TForm1.Server1CommandGet(AContext: TIdContext;

ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);

var

LFilename: string;

LPathname: string;

begin

LFilename := ARequestInfo.Document;

if LFilename = '/' then begin

LFilename := '/index.html';

end;

LPathname := FHTMLDir + LFilename;

if FileExists(LPathname) then begin

AResponseInfo.ContentStream := TFileStream.Create(LPathname, fmOpenRead + fmShareDenyWrite);

end else begin

AResponseInfo.ResponseNo := 404;

AResponseInfo.ContentText := 'The requested URL ' + ARequestInfo.Document+ ' was not found on this server.';

end;

end;

initialization

OleInitialize(nil);

finalization

try

OleUninitialize;

except

end;

end.