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.

 

关于法定节假日的问题

1995年5月, 中国开始实行每周5天工作制。 1999年9月18日,中国国务院发布《全国年节及纪念日放假办法》,决定增加公众法定休假日。春节、“五一”和 “十一...

阅读全文

CentOS下shadowsocks-libev一键安装脚本

本脚本适用环境: 系统支持:CentOS 内存要求:≥128M 日期:2018 年 06 月 01 日 关于本脚本: 一键安装 libev 版的 Shadowsocks 最新版本。该版本的特点...

阅读全文

在MAC上安装docker并部署oracle12.2

一。在Mac上安装docker。到docker store下载即可。下载地址是:https://store.docker.com/editions/community/docker-ce-desktop-mac。其实我们还可以看到别...

阅读全文

评论已经关闭。