delphihttpserver

原作者: [db:作者] 来自: [db:来源] 收藏邀请

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdContext, IdCustomHTTPServer,
  Vcl.StdCtrls, IdBaseComponent, IdComponent, IdCustomTCPServer, IdHTTPServer;

type
  TForm1 = class(TForm)
    IdHTTPServer1: TIdHTTPServer;
    btnStart: TButton;
    btnStop: TButton;
    edtIp: TEdit;
    edtPort: TEdit;
    edtRootDir: TEdit;
    lbl1: TLabel;
    lbl2: TLabel;
    lbl3: TLabel;
    edtIndex: TEdit;
    mmo1: TMemo;
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure IdHTTPServer1CommandGet(AContext: TIdContext;
      ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//uses IdGlobal;  //IndyTextEncoding_UTF8


var
  RootDir:string;
  URL:string;

procedure TForm1.btnStopClick(Sender:TObject);
begin
  IdHTTPServer1.Active:=false;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  edtip.Text:= '127.0.0.1';
  edtport.Text:= '8008';
  edtIndex.Text:= 'a.txt';

  btnStartClick(btnstart);
end;

procedure TForm1.btnStartClick(Sender:TObject);
begin
  if IdHTTPServer1.Active then exit;

  try
    IdHTTPServer1.Bindings.Clear;
    //要绑定的端口，一定设置此项，这是真正要绑定的端口;
    IdHTTPServer1.DefaultPort:=strtoint(trim(edtport.Text));
    IdHTTPServer1.Bindings.Add.IP:=trim(edtip.Text);
    //启动服务器
    IdHTTPServer1.Active:=True;
  except
    showmessage('启动失败！');
  end;

  //RootDir:=trim(edtrootdir.Text);
  rootdir:= ExtractFilePath(Application.ExeName);
  URL:='http://'+trim(edtip.Text)+trim(edtport.Text)+'/';
  //浏览器请求http://127.0.0.1:8008/index.html?a=1&b=2
end;


procedure TForm1.IdHTTPServer1CommandGet(AContext:TIdContext;
  ARequestInfo:TIdHTTPRequestInfo;AResponseInfo:TIdHTTPResponseInfo);
var
 LFilename:string;
 LPathname:string;
 zhongwen:string;
begin
  //浏览器请求http://127.0.0.1:8008/index.html?a=1&b=2
   //ARequestInfo.Document 返回  /index.html
   //ARequestInfo.QueryParams返回 a=1b=2
   //ARequestInfo.Params.Values['name'] 接收get,post过来的数据

   //1 获取参数
  //  mmo1.Lines.Clear;
  //  mmo1.Lines.Add(ARequestInfo.Document) ;
  //  mmo1.Lines.Add(arequestinfo.Params.Values['a']) ;
  //  mmo1.Lines.Add(arequestinfo.Params.Values['b']);

   //2 webserver发文件
//  LFilename := ARequestInfo.Document;
//  if LFilename = '/' then
//  begin
//    LFilename := '/'+trim(edtIndex.Text);
//  end;
//  LPathname := RootDir + LFilename;
//  if FileExists(LPathname) then
//  begin
//      AResponseInfo.ContentStream := TFileStream.Create(LPathname, fmOpenRead + fmShareDenyWrite);//发文件
//  end
//  else
//  begin
//
//    AResponseInfo.ContentType := 'text/html; charset=GB2312';
//    AResponseInfo.ResponseNo := 404;
//    AResponseInfo.ContentText := '找不到' + ARequestInfo.Document;
//    //找不到，这三个汉字显示为乱码，算个bug
//  end;

  //3 发html文件
//    AResponseInfo.ContentType := 'text/html; charset=GB2312';
//   // AResponseInfo.WriteContent;
//   AResponseInfo.ContentText:='<html><body>dsddddd你好哈哈哈好</body></html>';

  //4发xml文件
     AResponseInfo.ContentType :='text/xml;charset=GB2312';
     AResponseInfo.ContentText:='<?xml version="1.0" encoding="utf-8"?>'
     +'<students>'
     +'<student sex = "male"><name>'+'陈'+'</name><age>14</age></student>'
     +'<student sex = "female"><name>bb</name><age>16</age></student>'
     +'</students>';


//5下载文件时，直接从网页打开而没有弹出保存对话框的问题解决 indy10貌似没有这个问题
{AResponseInfo.CustomHeaders.Values['Content-Disposition'] :='attachment;
filename="'+文件名+'"';
}
   //AResponseInfo.ServeFile(AContext,'a.txt');
   //仅这一句即可下载并弹框


 //6替换 IIS
//  AResponseInfo.Server:='IIS/6.0';
//  AResponseInfo.CacheControl:='no-cache';
//  AResponseInfo.Pragma:='no-cache';
//  AResponseInfo.Date:=Now;

end;

end.