打造自己的Web（HTTP）服务器

使用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.