serverthread.pas

计算机网络与通信的知识

unit ServerThread;
interface

uses
  Windows, Messages,SysUtils,FileCtrl,
   Classes, Graphics, Controls,ScktComp,registry;

type accepttypekind = (requestget,requestpost,requesthead);

type
  TServerThread = class(TServerClientThread)
  private
    fSocketStream : TWinSocketStream;
    requestfilename:string; //请求的文件名
    function accepttype(input:string;var str:string):accepttypekind;//返回请求类型
  protected
    procedure sendfile(var stream:TWinSocketStream);//发送文件
  public
    //constructor Create(bool:boolean;socket:TServerClientWinSocket); override;
    procedure ClientExecute; override;
  published
    { Published declarations }
  end;

procedure Register;

implementation
uses unit1;
function TServerThread.accepttype(input:string;var str:string):accepttypekind;
var
wz:integer;
resultstr,tmp,cutespc:string;
tbool:boolean;
begin
tmp:=trimleft(input);
wz:=pos(#13,tmp);
tmp:=copy(tmp,1,wz-1);
//传递路径
//返回类型
wz:=pos(' ',tmp);
if wz>0 then
    begin
    resultstr:=AnsiLowerCase(copy(tmp,1,wz-1));
    tmp:=copy(tmp,wz+1,length(tmp)-wz);
    end;
tbool:=false;
if pos(' ',tmp)>0 then
    tbool:=true;
wz:=length(tmp);
while tbool do
    begin
    cutespc:=copy(tmp,wz,1);
    if cutespc=' ' then
        tbool:=false;
    wz:=wz-1;
    tmp:=copy(tmp,1,wz);
    end;
str:=tmp;
if ((resultstr='GET') or (resultstr='get'))  then
    begin
    result:=requestget;
    exit;
    end;
if ((resultstr='HEAD') or (resultstr='head')) then
    begin
    result:=requesthead;
    exit;
    end;
end;
procedure TServerThread.sendfile(var stream:TWinSocketStream);
var
  size,i,alllen: integer;
  MyFStream:Tfilestream;
  head,sendfiletype,sendfilename:string;
  Buffer :PChar;
  RegF:TRegistry;
  hist:string;
begin
sendfilename:=rootdir+Format('%s',[requestfilename]);
hist:=ClientSocket.LocalAddress+'   '+datetimetostr(now)+'    '+requestfilename;
form1.historylistbox.Items.Append(hist);
try
if DirectoryExists(sendfilename) then
    begin
    alllen:=length(sendfilename);
    if ((copy(sendfilename,alllen,1)='/') or (copy(sendfilename,alllen,1)='\')) then
        sendfilename:=sendfilename+defaultpage
    else
        sendfilename:=sendfilename+'\'+defaultpage;
    end;
if not(FileExists(sendfilename)) then
    begin
    //文件或者目录不存在
    //这里需要处理，比如isapi带参数
    ClientSocket.SendText('HTTP/1.0 404 Not Found'+#13+#10+#13+#10);
    exit;
    end;
//获取文件类型
RegF:=TRegistry.Create;
RegF.RootKey:=HKEY_CLASSES_ROOT;
try
    sendfiletype:=ExtractFileExt(sendfilename);
    RegF.OpenKey(sendfiletype,False);
    sendfiletype:=RegF.ReadString('Content Type');
except
End;
RegF.CloseKey;
RegF.Free;

head:=format('%s',['HTTP/1.0 200 OK'])+#13+#10;
head:=head+'Server: dcs-http-server/1.0'+#13+#10;
head:=head+'Date: Thu, 06 Dec 2001 15:08:55 GMT'+#13+#10;

MyFStream := TFileStream.Create(sendfilename,fmShareDenyNone);
size:=MyFstream.Size;
Buffer := PChar(AllocMem(Size + 1));
MyFStream.Seek(0,0);
MyFStream.Read(buffer^,Size+1);
MYFStream.Free;
if sendfiletype<>'' then       //加上文件属性
    head:=head+'Content-type: '+sendfiletype+#13+#10;
head:=head+'Content-length: '+inttostr(size)+#13+#10;
head:=head+#13+#10;
ClientSocket.SendText(head);
alllen:=size div 8192;
i:=0;
while ((not Terminated) and (ClientSocket.Connected) and (i<alllen+1)) do
    begin
    if i=alllen then
        Stream.WriteBuffer((buffer+i*8192)^,size-i*8192)
    else
        Stream.WriteBuffer((buffer+i*8192)^,8192);
    i:=i+1;
    end;
FreeMem(Buffer);
except
end;
end;
procedure TServerThread.ClientExecute;
var
  Stream : TWinSocketStream;
  Buffer :PChar;
  buffer1: array[0 .. 1023] of Char;
  size,i,alllen: integer;
  MyFStream:Tfilestream;
  head:string;
  tttype:accepttypekind;
begin

head:=format('%s',['HTTP/1.0 200 OK'])+#13+#10;
head:=head+'Server: dcs-http-server/1.0'+#13+#10;
head:=head+'Date: Thu, 06 Dec 2001 15:08:55 GMT'+#13+#10;
try
  while (not Terminated) and ClientSocket.Connected do
  begin

      Stream := TWinSocketStream.Create(ClientSocket, 30000);
        FillChar(Buffer1, 1024, 0);
        if Stream.WaitForData(20000) then
        begin
          if Stream.Read(Buffer1, 1024) = 0 then
            ClientSocket.Close
          else
            begin
            //form1.memo1.lines.Append(buffer1);
            tttype:=accepttype(buffer1,requestfilename);
            case tttype of
                requesthead:
                    begin
                    ClientSocket.SendText(head+#13+#10);
                    ClientSocket.Close;
                    end;
                else
                    sendfile(stream);
            end;{end case}
            Stream.Free;
            ClientSocket.Close;
            end;
        end
        else
          ClientSocket.Close;
    end;
except
      //HandleException;
end;
end;
procedure Register;
begin
  //RegisterComponents('Samples', [TServerThread]);
end;

end.