只有三百分了!全给,只为一个问题!!关于Socket在stThreadBlocking方式下的通讯问题!!解决立即建贴结帐!(0分)

  • 主题发起人 主题发起人 TDY
  • 开始时间 开始时间
T

TDY

Unregistered / Unconfirmed
GUEST, unregistred user!
各位大侠,我的问题是这样的:
有N个客户端同时向服务端发送消息!而服务端又要一个不掉地处理这些数据!所以只能用stThreadBlocking这种方式了!我用的是TServerSocket控件!请高手帮忙告诉怎样写收接线程!和结束线程!最好给出代码!实例更好!

本贴现在只发了O分,因为只有三百分了!所以等问题解决了就另建贴结帐!

请大伙帮帮忙! 在线等待~~~~~
E_Mail:newwhua@163.com
Msn:newwhua@Hotmail.com

谢谢谢~~~
 
var
cache:TThreadlist;



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;



procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
cache.Free;
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.
 
呵呵!多谢dcsdcs,
我现在去测试,通过就给分!
 
dcsdcs,还是要出错呀~~~
你写完了这个控件吗??
把编译好的控件传给我吧!谢谢@
 
我不明白,不用阻塞方式也可以处理所有的数据啊
 
同意lich,为什么不用indy?
 
unit ServerThread;
interface
之前是主程序的过程,自己申明一个线程池
之后才是控件,拜托,多仔细看看!
 
问题一样,程序我看了,
SocketThread:=TServerThread.Create(false,ClientSocket);
cache.Add(SocketThread);
不太明白;

请问TServerClientThread是什么为什么
cache.Add(SocketThread);时老出错呢
 
程序发出,请查收!
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
后退
顶部