Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2003.12.30;
Скачать: CL | DM;

Вниз

TCPSERVER - HELP!   Найти похожие ветки 

 
Bart   (2003-11-01 21:51) [0]

Задача передать поток данных от клиента серверу. Как решение был написан следующий класс:

unit class_tcpconnection;

interface

uses Sockets, IdGlobal, Classes;

type
TRing = procedure(MemSt: TMemoryStream) of object;
TLookup = procedure(i: Cardinal) of object;

TTCPConnection = class
private
FTCPServer: TTcpServer;
FRing: TRing;
FLook: TLookup;
procedure RecieveMethod(Sender: TObject; Buf: pchar; var DataLen: integer);
procedure AcceptMethod(Sender: TObject; ClientSocket: TCustomIpClient);
public
Constructor Create(Port: String; Ring: TRing; Look: TLookup; CreateSuspend: boolean = True);
Destructor Free;
end;

implementation

{ TTCPConnection }

procedure TTCPConnection.AcceptMethod(Sender: TObject;
ClientSocket: TCustomIpClient);
var
buff: char;
MemSt: TMemoryStream;
i: integer;
begin
FRing(nil);
ClientSocket.OnReceive := RecieveMethod;
ClientSocket.Open;

try
MemSt := TMemoryStream.Create;
for i := 0 to ClientSocket.BytesSent - 1 do begin
ClientSocket.ReceiveBuf(buff, 1);
MemSt.WriteBuffer(buff, 1);
end;
FRing(MemSt);
finally
MemSt.Free;
end;
end;

constructor TTCPConnection.Create(Port: String; Ring: TRing; Look: TLookup; CreateSuspend: boolean);
begin
FRing := Ring;
FTCPServer := TTcpServer.Create(nil);
FTCPServer.LocalPort := Port;
FTCPServer.OnReceive := RecieveMethod;
FTCPServer.OnAccept := AcceptMethod;
FTCPServer.Active := not CreateSuspend;
end;

destructor TTCPConnection.Free;
begin
if FTCPServer <> nil then begin
FTCPServer.Free;
FTCPServer := nil;
end;
end;

procedure TTCPConnection.RecieveMethod(Sender: TObject; Buf: pchar;
var DataLen: integer);
var
MemSt: TMemoryStream;
begin
FRing(nil);
MemSt := nil;
try
MemSt := TMemoryStream.Create;
MemSt.SetSize(DataLen);
FRing(MemSt);
finally
if MemSt <> nil then begin
MemSt.Clear;
MemSt.Free;
end;
end;
end;

end.

--------------
Метод AcceptMethod успешно отрабатывает, но в нем я не могу получить размер отправляемого потока (BytesRecived = 0)

Метод RecieveMethod - не отрабатывает в принципе :(
Но хелп упорно утверждает, что используя этот метод можно получить и буффер

ХЕЛП!


 
Rouse_ ©   (2003-11-02 17:40) [1]

Ну если Вы уж решили действовать таким методом то дополнительная нагрузка в виде TTcpServer Вам явно ни к чему. Проще реализовать свой класс на основе сокета. Там же и сможете конролировать все что Вам угодно...
Желаю успехов



Страницы: 1 вся ветка

Текущий архив: 2003.12.30;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.029 c
14-99791
belyh
2003-12-05 14:20
2003.12.30
обмен опытом


3-99506
T{}r(l-l
2003-12-05 11:56
2003.12.30
сообщения от


1-99619
Zorlag
2003-12-16 18:32
2003.12.30
Создание приложения, понимающего


9-99427
SkyRanger
2003-06-10 07:08
2003.12.30
Текстурирование


3-99469
konst_bsh
2003-12-05 09:04
2003.12.30
Да, плачевная ситуация с компонентами FIBPlus.