Приём текста, передаваемого с помощью метода 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