unit main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, IdBaseComponent,IdContext ,IdComponent, IdCustomTCPServer, IdCustomHTTPServer, IdHTTPServer, StdCtrls; type TForm_main = class(TForm) IdHTTPServer1: TIdHTTPServer; Button_StartServer: TButton; Edit_Port: TEdit; Label1: TLabel; Label2: TLabel; Edit_Ip: TEdit; Button_stop: TButton; Label3: TLabel; Edit_RootDir: TEdit; Edit_index: TEdit; Label4: TLabel; procedure Button_StartServerClick(Sender: TObject); procedure Button_stopClick(Sender: TObject); procedure IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); private { Private declarations } public { Public declarations } end; var Form_main: TForm_main; implementation var RootDir:string; URL:string; {$R *.dfm} procedure TForm_main.Button_StartServerClick(Sender: TObject); begin try IdHTTPServer1.Bindings.Clear; //要绑定的端口,一定设置此项,这是真正要绑定的端口; IdHTTPServer1.DefaultPort:=strtoint(trim(edit_port.Text)); IdHTTPServer1.Bindings.Add.IP := trim(edit_Ip.Text); //启动服务器 IdHTTPServer1.Active := True; except showmessage('启动失败!'); end; RootDir:=trim(edit_rootDir.Text); URL:='http://'+trim(edit_Ip.Text)+trim(edit_port.Text)+'/'; end; procedure TForm_main.Button_stopClick(Sender: TObject); begin IdHTTPServer1.Active := false; end; procedure TForm_main.IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); var LFilename: string; LPathname: string; zhongwen:string; begin ////webserver发文件 {LFilename := ARequestInfo.Document; if LFilename = '/' then begin LFilename := '/'+trim(edit_index.Text); end; LPathname := RootDir + LFilename; if FileExists(LPathname) then begin AResponseInfo.ContentStream := TFileStream.Create(LPathname, fmOpenRead + fmShareDenyWrite);//发文件 end else begin AResponseInfo.ResponseNo := 404; AResponseInfo.ContentText := '找不到' + ARequestInfo.Document; end; } //发html文件 {AResponseInfo.ContentEncoding:='utf-8'; AResponseInfo.ContentType :='text/html'; AResponseInfo.ContentText:='<html><body>好</body></html>'; } //发xml文件 {AResponseInfo.ContentType :='text/xml'; AResponseInfo.ContentText:='<?xml version="1.0" encoding="utf-8"?>' +'<students>' +'<student sex = "male"><name>'+AnsiToUtf8('陈')+'</name><age>14</age></student>' +'<student sex = "female"><name>bb</name><age>16</age></student>' +'</students>';} //下载文件时,直接从网页打开而没有弹出保存对话框的问题解决 //AResponseInfo.CustomHeaders.Values['Content-Disposition'] :='attachment; filename="'+文件名+'"'; //替换 IIS {AResponseInfo.Server:='IIS/6.0'; AResponseInfo.CacheControl:='no-cache'; AResponseInfo.Pragma:='no-cache'; AResponseInfo.Date:=Now;} end; end. |
|