使用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 (Sender: TObject; var Action: TCloseAction);
begin
:=false;
end;

procedure (Sender: TObject);
begin
FHTMLDir:= ExtractFilePath() + 'WEBROOT';
FURL:='http://127.0.0.1:'+inttostr()+'/';
end;

procedure TForm1.Server1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
LFilename: string;
LPathname: string;
begin
LFilename := ;
if LFilename = '/' then begin
LFilename := '/';
end;
LPathname := FHTMLDir + LFilename;
if FileExists(LPathname) then begin
:= (LPathname, fmOpenRead + fmShareDenyWrite);
end else begin
:= 404;
:= 'The requested URL ' + + ' was not found on this server.';
end;
end;

initialization
OleInitialize(nil);
finalization
try
OleUninitialize;
except
end;

end.