Модуль для принятия и отправления длинных блоков данных

{ **** UBPFD *********** by kladovka.net.ru ****
>> Процедуры передачи и приема длинных блоков данных, с учетом фрагментации и возможной слепки пакетов. На компоненты TServerSocket,TClientSocket ..SendText
Данный модуль содержит функции, которые позволяет принимать и отправлять длинные блоки данных.
В код встрена автоматическая обработка фрагментации и слепки пакетов.
Данные процелуры предназначены для передачи текстовых строк, и используют методы SendText, ReciveText TCustomSocket и предназначены для использования с компонентами TClientSocket, TServerSocket и других производных от TCustomSocket.
Данные решение отличается простотой использования, скоростью обработки и надежностью:
тестировалось посылкой блоков данных размером 1-16000, было обработано 15100 блоков данных. Последующее сравнение отправленнх и полученных данных показало отсутвие каких либо ошибок при передачи, сборки и фрагментации данных.
Перед использованием нужно приготовить пользовательскую процедуру, которая будет вызываться каждый раз, когда получен очередной БЛОК данных. Данная процедура должна иметь ОДИН входной параметр типа STRING:
procedure SomeUserProc(S: string);
begin
....
end;
Модуль содержит 3 функции, из которых пользователю нужны только 2
function SendLongText(Socket: TCustomWinSocket; S: string): Boolean;
function ReceiveLongText(Socket: TCustomWinSocket; MySProc: TMySProc; SafeCalledStr: string = ): Boolean;
Функция SendText служит для отправки пакетов. В качестве параметров ей передается объект TCustomWinSocket (например это ClientSocket.Socket) и собственно отправляемая строка S (ShortString, AnsiString, WideString).
В случае успешной отправки функция возвращает true, иначе false. Для обработки используйте GetLastError().
function ReceiveLongText(Socket:TCustomWinSocket;MySProc:TMySProc;SafeCalledStr :string = ):boolean;
Используется для получения. Данная функция должна быть вызвана в событии On*Read компонента. В качестве параметров необходимо передать TCustomWinSocket (например ServerSocket.Socket) и имя процедуры, назначенной для обработки данных (например, ранее приготовленная SomeUserProc). Третий параметр ЗАПОЛНЯТЬ НЕ СЛЕДУЕТ!!!
Процедура FlushBuffers является внутренней и очищает буфер приема, и напрямую пользователем вызываться не должна.
Зависимости: ScktComp;
Автор: Subfire, subfire@mail.ru, ICQ:55161852, Санкт-Петербург
Copyright: Егоров Виктор aka Subfire
Дата: 2 октября 2002 г.
********************************************** }
unit LongDataTransfer;
interface
uses ScktComp;
type TMySProc = procedure(const S: AnsiString);
function SendLongText(Socket: TCustomWinSocket; S: string): Boolean;
function ReceiveLongText(Socket: TCustomWinSocket; MySProc: TMySProc; SafeCalledStr: string = ): Boolean;
var
 InputBuf: string;
 InputDataSize: LongWord;
 InputReceivedSize: LongWord;
implementation
function SendLongText(Socket: TCustomWinSocket; S: string): Boolean;
var
 TextSize: Integer;
 TSSig: string[4];
begin
 Result := True;
 try
 if not Socket.Connected then Exit;
 TextSize := Length(S);
 asm
 mov EAX,TextSize;
 mov dword ptr TSSig[1],EAX;
 mov byte ptr TSSig[0],4;
 end;
 S := String(TSSig+S);
 Socket.SendBuf(Pointer(S)^, Length(S));
 except
 Result := False;
 end;
end;
procedure FlushBuffers;
begin
 InputBuf := ;
 InputDataSize := 0;
 InputReceivedSize := 0;
end;
function ReceiveLongText(Socket: TCustomWinSocket; MySProc: TMySProc; SafeCalledStr: string = ): Boolean;
var
 S: string;
 RDSize: LongWord;
 F: string[4];
begin
 Result := True;
 try
 if SafeCalledStr = then
 begin
 RDSize := Socket.ReceiveLength;
 S := Socket.ReceiveText;
 end
 else
 begin
 S := SafeCalledStr;
 RDSize := Length(S);
 end;
 if (Length(InputBuf) < 4) and (Length(InputBuf) > 0) then
 begin
 // Корректировка, в том случае если фрагментирован сам заголовок блока данных
 S := InputBuf + S;
 FlushBuffers;
 end;
 if InputBuf = then
 begin
 // Самый первый пакет;
 F := Copy(S, 0, 4);
 asm
 mov EAX,dword ptr F[1];
 mov InputDataSize,EAX;
 end;
 if InputDataSize = RDSize-4 then
 begin
 // Один блок в пакете, ни слепки, ни фрагментации нет.
 InputBuf := Copy(S, 5, RDSize-4);
 MySProc(InputBuf);
 FlushBuffers;
 Exit;
 end;
 if InputDataSize < RDSize-4 then
 begin
 // Пакет слеплен.
 InputBuf := Copy(S, 5, InputDataSize);
 MySProc(InputBuf);
 Delete(S, 1, InputDataSize+4);
 FlushBuffers;
 ReceiveLongText(Socket, MySProc, S);
 Exit;
 end;
 if InputDataSize > RDSize-4 then
 begin
 // это ПЕРВЫЙ фрагмент большого пакета
 InputBuf := Copy(S, 5, RDSize-4);
 InputReceivedSize := RDSize-4;
 end;
 end
 else
 begin
 // Буфер приема не пуст
 //InputBuf:=
 if RDSize + InputReceivedSize = InputDataSize then
 begin
 // Получили последний фрагмент целиком в пакете, данных в пакете больше нет
 InputBuf := InputBuf + Copy(S, 0, RDSize);
 MySProc(InputBuf);
 FlushBuffers;
 Exit;
 end;
 if RDSize + InputReceivedSize < InputDataSize then
 begin
 // Получили очередной фрагмент
 InputBuf := InputBuf + Copy(S, 0, RDSize);
 InputReceivedSize := InputReceivedSize + RDSize;
 Exit;
 end;
 if RDSize + InputReceivedSize > InputDataSize then
 begin
 // Последний фрагмент
 // но в пакете есть еще данные - слеплен.
 InputBuf := InputBuf + Copy(S, 0, InputDataSize - InputReceivedSize);
 MySProc(InputBuf);
 Delete(S, 1, InputDataSize - InputReceivedSize);
 FlushBuffers;
 ReceiveLongText(Socket, MySProc, S);
 end;
 end;
 except
 Result := False;
 end;
end;
end.
Пример использования:
// Эта процедура будет обрабатывать полученные данные, и
// автоматически вызывается каждый при получении нового блока данных.
procedure DataProcessing(S: string);
begin
 ShowMessage(S);
end;
// Процедура отправки - по нажатию кнопки отправляем через компонент
// ClientSocket три строки.
procedure TForm1.Button1Click(Sender: TObject);
begin
 SendLongText(ClientSocket.Socket, 'Первая строчка!');
 SendLongText(ClientSocket.Socket, 'Вторая строчка!');
 SendLongText(ClientSocket.Socket, 'Третья строчка! Все три показаны по отдельности!!!');
end;
// Процедура ServerSocket OnClientRead содержит одну строчку
// вызова ReceiveLongText, передавая ей в качестве параметра
// имя вашей процедуры обработки.
procedure TForm1.ServerSocketClientRead(Sender: TObject; Socket: TCustomWinSocket);
begin
 ReceiveLongText(Socket, DataProcessing);
end;
// И все!!! Не правда ли просто? :) Если у вас есть какие-либо вопросы,
// комментарии, замечания, bug reports - пишите на subfire@mail.ri
Author: Subfire
ID: 03567
Category:Связь
Category:Сокеты