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.