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

来源：互联网发布：口袋妖怪xy存档数据坏编辑：程序博客网时间：2024/04/29 23:19

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