delphi idhttpsever

http://blog.csdn.net/chelen_jak/article/details/50203809

delphi idhttpsever

2015-12-07 11:36 216人阅读 评论(0) 收藏 举报
 分类：
 
 
转自：http://3699119.blog.163.com/blog/static/167075351201373024054586/
[delphi] view plain copy
 
  1. unit main;  
  2.   
  3. interface  
  4.   
  5. uses  
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
  7.   Dialogs, IdBaseComponent,IdContext ,IdComponent, IdCustomTCPServer, IdCustomHTTPServer,  
  8.   IdHTTPServer, StdCtrls;  
  9.   
  10. type  
  11.   TForm_main = class(TForm)  
  12.     IdHTTPServer1: TIdHTTPServer;  
  13.     Button_StartServer: TButton;  
  14.     Edit_Port: TEdit;  
  15.     Label1: TLabel;  
  16.     Label2: TLabel;  
  17.     Edit_Ip: TEdit;  
  18.     Button_stop: TButton;  
  19.     Label3: TLabel;  
  20.     Edit_RootDir: TEdit;  
  21.     Edit_index: TEdit;  
  22.     Label4: TLabel;  
  23.     procedure Button_StartServerClick(Sender: TObject);  
  24.     procedure Button_stopClick(Sender: TObject);  
  25.     procedure IdHTTPServer1CommandGet(AContext: TIdContext;  
  26.       ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);  
  27.   private  
  28.     { Private declarations }  
  29.   public  
  30.     { Public declarations }  
  31.   end;  
  32.   
  33. var  
  34.   Form_main: TForm_main;  
  35.   
  36. implementation  
  37. var  
  38.   RootDir:string;  
  39.   URL:string;  
  40. {$R *.dfm}  
  41.   
  42. procedure TForm_main.Button_StartServerClick(Sender: TObject);  
  43. begin  
  44.   try  
  45.     IdHTTPServer1.Bindings.Clear;  
  46.     //要绑定的端口，一定设置此项，这是真正要绑定的端口;  
  47.     IdHTTPServer1.DefaultPort:=strtoint(trim(edit_port.Text));  
  48.     IdHTTPServer1.Bindings.Add.IP := trim(edit_Ip.Text);  
  49.     //启动服务器  
  50.     IdHTTPServer1.Active := True;  
  51.   except  
  52.      showmessage('启动失败！');  
  53.   end;  
  54.   RootDir:=trim(edit_rootDir.Text);  
  55.   URL:='http://'+trim(edit_Ip.Text)+trim(edit_port.Text)+'/';  
  56. end;  
  57.   
  58. procedure TForm_main.Button_stopClick(Sender: TObject);  
  59. begin  
  60.   IdHTTPServer1.Active := false;  
  61. end;  
  62.   
  63. procedure TForm_main.IdHTTPServer1CommandGet(AContext: TIdContext;  
  64.   ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);  
  65. var  
  66.   LFilename: string;  
  67.   LPathname: string;  
  68.   zhongwen:string;  
  69. begin  
  70.   //浏览器请求http://127.0.0.1:8008/index.html?a=1&b=2  
  71.   //ARequestInfo.Document  返回    /index.html  
  72.   //ARequestInfo.QueryParams 返回  a=1b=2  
  73.   //ARequestInfo.Params.Values['name']   接收get,post过来的数据  
  74.   ////webserver发文件    
  75.   {LFilename := ARequestInfo.Document; 
  76.   if LFilename = '/' then 
  77.   begin 
  78.     LFilename := '/'+trim(edit_index.Text); 
  79.   end; 
  80.   LPathname := RootDir + LFilename; 
  81.   if FileExists(LPathname) then  
  82.   begin 
  83.     AResponseInfo.ContentStream := TFileStream.Create(LPathname, fmOpenRead + fmShareDenyWrite);//发文件 
  84.   end 
  85.   else begin 
  86.       AResponseInfo.ResponseNo := 404; 
  87.       AResponseInfo.ContentText := '找不到' + ARequestInfo.Document; 
  88.   end;}  
  89.   
  90.   //发html文件  
  91.   {AResponseInfo.ContentEncoding:='utf-8'; 
  92.   AResponseInfo.ContentType :='text/html'; 
  93.   AResponseInfo.ContentText:='<html><body>好</body></html>'; }  
  94.   
  95.   //发xml文件  
  96.   {AResponseInfo.ContentType :='text/xml'; 
  97.   AResponseInfo.ContentText:='<?xml version="1.0" encoding="utf-8"?>' 
  98.   +'<students>' 
  99.   +'<student sex = "male"><name>'+AnsiToUtf8('陈')+'</name><age>14</age></student>' 
  100.   +'<student sex = "female"><name>bb</name><age>16</age></student>' 
  101.   +'</students>';}  
  102.   
  103.   //下载文件时，直接从网页打开而没有弹出保存对话框的问题解决  
  104.   //AResponseInfo.CustomHeaders.Values['Content-Disposition'] :='attachment; filename="'+文件名+'"';  
  105.   //替换 IIS  
  106.   {AResponseInfo.Server:='IIS/6.0'; 
  107.   AResponseInfo.CacheControl:='no-cache'; 
  108.   AResponseInfo.Pragma:='no-cache'; 
  109.   AResponseInfo.Date:=Now;}  
  110. end;  
  111.   
  112. end.  
delphi lazarus opengl 网页操作自动化， 图像分析破解，游戏开发
【推广】 免费学中医，健康全家人
原文地址：https://www.cnblogs.com/delphi-xe5/p/5459682.html