demo1_u1.pas

< Delphi网络通信协议分析与应用实现>>一书的源代码。

unit Demo1_u1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, MysockHttp,
  MySock, StdCtrls, ExtCtrls, Buttons;

type
  TWebForm = class(TForm)
    Server1: THttpServerSock;
    GroupBox1: TGroupBox;
    Panel1: TPanel;
    BtnStart: TBitBtn;
    BtnStop: TBitBtn;
    Edit2: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Edit3: TEdit;
    Memo1: TMemo;
    Label4: TLabel;
    Shape1: TShape;
    CkBNeedAuth: TCheckBox;
    Edit4: TEdit;
    Label5: TLabel;
    Label6: TLabel;
    Edit5: TEdit;
    Label1: TLabel;
    procedure Server1Client(Server: THttpServerSock;
      Client: TClientSockServ; Head: THttpHead);
    procedure BtnStartClick(Sender: TObject);
    procedure BtnStopClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  WebForm: TWebForm;

implementation

{$R *.DFM}

procedure TWebForm.Server1Client(Server: THttpServerSock;
  Client: TClientSockServ; Head: THttpHead);
var
  i : Integer;
  deffile:string;
  ftype:string;
begin
    memo1.Lines.Add('************************');
    memo1.lines.Add(timetostr(now)+': ---【'+
    head.Host+'】 请求文件---'+head.Url);
    //需要认证
    for i:=0 to head.otherfields.Count-1 do
    begin
        memo1.Lines.add(head.otherfields.Strings[i]);
    end;
    if ckbNeedAuth.Checked then
    begin
        memo1.Lines.Add(head.Authorization+'*****'+head.Auth_Username);
        if not((head.Auth_Username=edit4.Text) and
            (head.Auth_Password=edit5.text)) then
        begin
            SendPasswordNeeded(client,'--wwwroot--');
            exit;
        end

    end;
    
    //发送根目录缺省网页
    if head.Url='/' then
    begin
        if fileexists('wwwroot\index.html') then
        begin
            deffile:='wwwroot\index.html';
        end
        else if fileexists('wwwroot\index.htm') then
        begin
            deffile:='wwwroot\index.htm';
        end
        else if  fileexists('wwwroot\default.html') then
        begin
            deffile:='wwwroot\default.html';
        end
        else if  fileexists('wwwroot\default.htm') then
        begin
            deffile:='wwwroot\default.htm';
        end;
        if deffile<>'' then
        begin
            sendfile(deffile,client,Head,'text/html');
        end
        else
        begin
            SendNotFoundError(client);
        end;;
        exit;
    end;
    //发送指定文件
    if fileexists('wwwroot\'+head.Url) then
    begin
        if (length(head.Url))>4 then
        begin
            ftype:=copy(head.Url,length(head.Url)-4,4);
        end;
        if (AnsiUpperCase(ftype)='.TXT') or (AnsiUpperCase(ftype)='HTML')
            or (AnsiUpperCase(ftype)='.HTM')  then
        begin
            ftype:='text/html';
        end
        else
        begin
            ftype:='image/image';
        end;
        sendfile('wwwroot\'+head.url,client,head,ftype);
        exit;
    end
    else
    begin
        SendNotFoundError(client);
    end;



    //sendseqfile('index.html',client,Head,'text/html','hehe');
    //sendseqfile('index.html',client,Head,'text/html','hehe');
 { sendStdHeader(client);
  client.send('<H1>TEST SERVER</H1>Fields send:<BR>');
  for i:=0 to head.otherfields.count-1 do begin
    client.send(head.otherfields[i]+'<BR>');
  end;
  client.send('HTTP version='+head.HttpVer+'<BR>Method='+head.Method+'<BR>Path='+head.url);
  }
end;

procedure TWebForm.BtnStartClick(Sender: TObject);
begin
    server1.PortName:=edit2.text;
    try
        server1.MaxClient:=strtoint(edit3.Text);
    except
        server1.MaxClient:=20;
    end;
    Server1.Active:=true;
    btnstop.Enabled:=true;
    btnstart.enabled:=false;
end;

procedure TWebForm.BtnStopClick(Sender: TObject);
begin
    server1.Active:=false;
    btnstop.Enabled:=false;
    btnstart.enabled:=true;
end;

end.