Как сделать калькулятор в Delphi?

Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.

Как Delphi реализует многоплатформенную разработку?

Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...

Приём и обработка пакетов переданных методом SendText - с учётом склеенных и полученных неполностью пакетов

Советы » Сокеты » Приём и обработка пакетов переданных методом SendText - с учётом склеенных и полученных неполностью пакетов

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Приём и обработка пакетов переданных методом 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; Text:String):Integer;
Var S:String;
begin
Result := -1;
IF Text = '' then exit;
IF Socket.Connected then
begin
S:=IntToStr(Length(Text));
Result := Socket.SendText(S+'#'+Text);
end;
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

; type

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

ABuffer.FBuffer := ''; ABuffer.FHeaderBuffer := ''; ABuffer.FCurrentPacketSize := 0; end

; function

ReadHeader(var

ABuffer: TBuffer; var

APacket: string

): TReadHeaderResult; var

X, HBuffLen: 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

if

(APacket[I] in

['0'..'9']) then

BREAK else

if

(APacket[I] = '#') and

(ABuffer.FHeaderBuffer <> '') then

BREAK else

X := I; 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

HBuffLen := Length(ABuffer.FHeaderBuffer); if

HBuffLen > 0 then

Inc(HBuffLen); Insert(APacket[I], ABuffer.FHeaderBuffer, HBuffLen); end

else

Break; end

; end

; procedure

SetResultToNone; begin

Result.FPacketSize := 0; Result.FTextStartsAt := 0; Result.FPacketSizeStr := ''; end

; begin

SetResultToNone; if

APacket = '' then

Exit; if

ABuffer.FCurrentPacketSize > 0 then

begin

Result.FPacketSize := ABuffer.FCurrentPacketSize; Result.FPacketSizeStr := IntToStr(ABuffer.FCurrentPacketSize); Result.FTextStartsAt := 1; 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

; BuffLen: Integer; function

FullPacket: Boolean; begin

Result := Length(ABuffer.FBuffer) = ABuffer.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

NeedToCopy := ABuffer.FCurrentPacketSize - Length(ABuffer.FBuffer); S := Copy(APacket, 1, NeedToCopy); DelSize := NeedToCopy; end

; if

ABuffer.FCurrentPacketSize > 0 then

begin

BuffLen := Length(ABuffer.FBuffer); if

BuffLen > 0 then

Inc(BuffLen); Insert(S, ABuffer.FBuffer, BuffLen); end

; if

not

FullPacket then

Result := False; if

ABuffer.FHeaderBuffer = '' then

DELETE(APacket, 1, DelSize) else

begin

APacket := ''; Result := False; end

; end

; end

.

Пример использования:

// Объявляем переменную типа TBuffer. Для каждого клиента на
// сервере должна быть объявлена отдельная переменная этого типа
var

GBuffer: 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

Recv.Lines.Add(GBuffer.FBuffer); //или же передать GBuffer.FBuffer на исполнение. ClearBuffer(GBuffer); end

; until

S = ''; end

;

Другое по теме:

Категории

Статьи

Советы

Copyright © 2024 - All Rights Reserved - www.delphirus.com