张无忌大侠一定要进(50分)

  • 主题发起人 主题发起人 supercop
  • 开始时间 开始时间
S

supercop

Unregistered / Unconfirmed
GUEST, unregistred user!
早就听说你的大名,请你一定要帮忙解决这个问题。谢谢了。

我现在要做一个服务端程序,接收access数据库文件,客户端同时上传最多可能有30个,请问这个服务端采用什么方式好,TserveSocket应该采用线程阻塞还是非阻塞的。
如果是线程阻塞的,应该如何编程,我是一头雾水,不知道该如何下手。你能否发给我一个关于TserverSocket多线程处理TclientSocket发来请求的例子。
 
我的email:super_cop@sina.com
 
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
------------------

var
Form1: TForm1;
cache:TThreadlist;
implementation
procedure TForm1.FormCreate(Sender: TObject);
begin
cache:=TThreadlist.Create;
end;
procedure TForm1.ServerSocket1GetThread(Sender: TObject;
ClientSocket: TServerClientWinSocket;
var SocketThread: TServerClientThread);
begin
SocketThread:=TServerThread.Create(false,ClientSocket);
cache.Add(SocketThread);
end;

procedure TForm1.ServerSocket1ThreadEnd(Sender: TObject;
Thread: TServerClientThread);
var
i:integer;
begin
with cache.LockList do
begin
for i:=0 to count-1 do
begin
if Thread=Items then
begin
Delete(i);
exit;
end;
end;
end;
cache.UnlockList;
end;
-------------------------------------
unit ServerThread;
interface

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

type accepttypekind = (requestget,requestpost,requesthead);

type
TServerThread = class(TServerClientThread)
private
fSocketStream : TWinSocketStream;
requestfilename:string; //请求的文件名
fconnectionlength:integer;
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;
const maxipdata:integer=1024;
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);
Stream.WriteBuffer(Pchar(head)^,length(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,rechead,rec:string;
tttype:accepttypekind;
maxreccount,reccount,pos_cl,xh_max,xh_count:integer;
begin
head:=format('%s',['HTTP/1.0 200 OK'])+#13+#10;
head:=head+'Server:dcs-file-manager-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);
try
FillChar(Buffer1, maxipdata, 0);
if Stream.WaitForData(20000) then
begin
if Stream.Read(Buffer1, maxipdata) = 0 then
ClientSocket.Close
else
begin
//
rechead:=Buffer1;
//create object
pos_cl:=pos('Content-length:',rechead);
rec:=copy(rechead,pos_cl+15,length(rechead)-pos_cl-14);
pos_cl:=pos(#13+#10,rec);
rec:=copy(rec,1,pos_cl);
//rec表示返回的字节数
if rec<>'' then
begin
maxreccount:=strtoint(trim(rec));
rec:='';
xh_max:=(maxreccount+maxipdata-1) div maxipdata;
xh_count:=1;
while ((not Terminated) and (xh_count<xh_max) and (ClientSocket.Connected)) do
begin
FillChar(Buffer1,sizeof(Buffer1), 0);
if Stream.WaitForData(20000) then
begin
if Stream.Read(Buffer1,maxipdata)<>0 then
begin
form1.Memo1.lines.add(format('xh_count:%d,xh_max:%d.maxrecount:%d',[xh_count,xh_max,maxreccount]));
if xh_count=xh_max-1 then
begin
for i:=0 to (maxreccount-(xh_count-1)*maxipdata) do
rec:=rec+buffer1;
end
else
begin
rec:=rec+buffer1;
end;
end;
end;
inc(xh_count);
end;
reccount:=0;
end;
//end object
form1.Memo1.Lines.Add(rec);
tttype:=accepttype(rechead,requestfilename);
case tttype of
requesthead:
begin
ClientSocket.SendText(head+#13+#10);
ClientSocket.Close;
end;
else
sendfile(stream);
end;{end case}
ClientSocket.Close;
end;
end
else
ClientSocket.Close;
finally
Stream.Free;
end;
end;
except
//HandleException;
end;
end;
procedure Register;
begin
//RegisterComponents('Samples', [TServerThread]);
end;

end.
实际程序,来mail
 
to:dcsdcs
谢谢,非常感谢,你能把你的程序法给我一份吗?请问你的mail是????
我将和你联系。我的mail:super_cop@sina.com。
我的客户端可能是猫。
 
接受答案了.
 
后退
顶部