Приём текста, передаваемого с помощью метода SendText
Материал из DRKB
{ **** UBPFD *********** by kladovka.net.ru ****
>> Приём и обработка пакетов переданных методом SendText() - с учётом "склеенных" и полученных неполностью пакетов.
Юнит RecvPckt предназначен для приёма текста, передаваемого с помощью метода SendText
объекта Socket:TCustomWinSocket. Данный юнит может использоваться как клиентом так
и сервером для обработки принятого пакета.
Функции юнита предусматривают возможность получения "склеенных" пакетов,
или пакетов, пришедших не полностью.
Тип TBuffer;
FBuffer - хранит в себе принимаемый пакет
FCurrentPacketSize = хранит сведения о полной длине принимаемого пакета.
Описание функций и процедур, необходимых для использования в других юнитах
procedure ClearBuffer(var ABuffer: TBuffer);
Очищает буффер FBuffer и обнуляет значение FCurrentPacketSize;
function ProcessReceivedPacket(var ABuffer: TBuffer; var APacket: string): Boolean;
В данную функцию передаётся полученный от клиента/сервера пакет, через аргумент APacket
Принцип работы этой функции заключается в накоплении получаемого текста в поле
FBuffer объекта ABuffer. В случае когда FBuffer будет содержать полностью весь пакет,
функция возвратит True, иначе возвращает False
Функция ОТПРАВКИ текста:
function SendTextToSocket(Socket: TCustomWinSocket; const Text: string): Integer;
begin
Result := -1;
if Text = '' then exit;
if Socket.Connected then
Result := Socket.SendText(IntToStr(Length(Text)) + '#' + Text);
end;
Зависимости: sysutils
Автор: VID, snap@iwt.ru, ICQ:132234868, Махачкала
Copyright: VID
Дата: 30 сентября 2002 г.
********************************************** }
unit RecvPckt;
interface
uses
SysUtils;
Type
TReadHeaderResult = record
FPacketSize: Integer;
FPacketSizeStr: string;
FTextStartsAt: Integer;
end;
TBuffer = record
FBuffer: string;
FHeaderBuffer: string;
FCurrentPacketSize: Integer;
end;
procedure ClearBuffer(var ABuffer: TBuffer);
function ReadHeader(var ABuffer: TBuffer; var APacket: string): TReadHeaderResult;
function ProcessReceivedPacket(var ABuffer: TBuffer; var APacket: string): Boolean;
implementation
procedure ClearBuffer(var ABuffer: TBuffer);
begin
with ABuffer do
begin
FBuffer := '';
FHeaderBuffer := '';
FCurrentPacketSize := 0;
end;
end;
function ReadHeader(var ABuffer: TBuffer; var APacket: string): TReadHeaderResult;
var
X: Integer;
procedure ClearHeader;
begin
ABuffer.FHeaderBuffer := '';
end;
function CorrectPacket: Boolean;
var
I, L: Integer;
begin
X := 0;
L := Length(APacket);
for I := 1 to L do
begin
if (APacket[I] in ['0'..'9']) then
Break
else if (APacket[I] = '#') and (ABuffer.FHeaderBuffer <> '') then
Break
else
X := I;
end;
if X > 0 then
Delete(APacket, 1, X);
Result := (APacket <> '');
end;
procedure GetHeader;
var
I, L: Integer;
begin
L := Length(APacket);
X := 0;
for I := 1 to L do
begin
X := I;
if (APacket[I] in ['0'..'9']) then
begin
Insert(APacket[I], ABuffer.FHeaderBuffer, Length(ABuffer.FHeaderBuffer)+1);
end
else
Break;
end;
end;
procedure SetResultToNone;
begin
with Result do
begin
FPacketSize := 0;
FTextStartsAt := 0;
FPacketSizeStr := '';
end;
end;
begin
SetResultToNone;
if APacket = '' then Exit;
if ABuffer.FCurrentPacketSize > 0 then
begin
with Result do
begin
FPacketSize := ABuffer.FCurrentPacketSize;
FPacketSizeStr := IntToStr(ABuffer.FCurrentPacketSize);
FTextStartsAt := 1;
end;
Exit;
end;
if not CorrectPacket then Exit;
GetHeader();
if APacket[X] = '#' then
begin
Inc(X);
try
Result.FPacketSize := StrToInt(ABuffer.FHeaderBuffer);
except
end;
Result.FPacketSizeStr := ABuffer.FHeaderBuffer;
ClearHeader;
end
else if not (APacket[X] in ['0'..'9']) then
ClearHeader;
Result.FTextStartsAt := X;
end;
function ProcessReceivedPacket(var ABuffer: TBuffer; var APacket: string): Boolean;
var
ReadHeaderResult: TReadHeaderResult;
NeedToCopy, DelSize: Integer;
S: string;
function FullPacket: Boolean;
begin
with ABuffer do
Result := (Length(FBuffer) = FCurrentPacketSize);
end;
begin
Result := True;
if APacket = '' then Exit;
if ABuffer.FBuffer = '' then
begin
ReadHeaderResult := ReadHeader(ABuffer, APacket);
ABuffer.FCurrentPacketSize := ReadHeaderResult.FPacketSize;
S := Copy(APacket, ReadHeaderResult.FTextStartsAt, ReadHeaderResult.FPacketSize);
DelSize := Length(ReadHeaderResult.FPacketSizeStr) + ReadHeaderResult.FPacketSize + 1;
end
else
begin
with ABuffer do NeedToCopy := FCurrentPacketSize - Length(FBuffer);
S := Copy(APacket, 1, NeedToCopy);
DelSize := NeedToCopy;
end;
with ABuffer do
if FCurrentPacketSize > 0 then
Insert(S, FBuffer, Length(FBuffer)+1);
if not FullPacket then Result := False;
if ABuffer.FHeaderBuffer = '' then
Delete(APacket, 1, DelSize)
else
begin
APacket := '';
Result := False;
end;
end;
end.
Пример использования:
var
GBuffer: TBuffer; // Объявляем переменную типа TBuffer. Для каждого клиента на сервере должна быть объявлена отдельная переменная этого типа
procedure TForm1.ServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
S: string;
begin
S := Socket.ReceiveText;
repeat
if ProcessReceivedPacket(GBuffer, S) then
begin
if GBuffer.FBuffer <> '' then
try
Recv.Lines.Add(GBuffer.FBuffer);
// Или же передать GBuffer.FBuffer на исполнение.
finally
ClearBuffer(GBuffer);
end;
end;
until S = '';
end
Author: VID
ID: 03566