Тип AniString

← →
DVM © (2011-05-15 23:14) [40]

> Германн © (13.05.11 16:46) [14]
>
> > Для какой такой особой цели
>
> Приемный накопительный буфер.

бери мой, может подойдет
unit uBuffer; interface const MinAllocation = 1024; type TBuffer = class(TObject) private FStorage: PAnsiChar; FAllocation: integer; FHead: PAnsiChar; FTail: PAnsiChar; FSize: integer; function GetBytes(Index: Integer): PAnsiChar; procedure SetSize(ASize: integer); public constructor Create; overload; constructor Create(ASize: integer); overload; constructor Create(AStorage: PAnsiChar; ASize: integer); overload; constructor Create(ABuffer: TBuffer); overload; destructor Destroy; override; function Append(ABuffer: TBuffer): integer; overload; function Append(AStorage: PAnsiChar; ASize: integer): integer; overload; function Assign(AStorage: PAnsiChar; ASize: integer): integer; overload; function Assign(ABuffer: TBuffer): integer; overload; function Consume(ACount: integer): integer; procedure Empty; procedure Compact; function IsEmpty: boolean; function Expand(ACount: integer): integer; function Extract(ACount: integer): PAnsiChar; function Shrink(ACount: integer): integer; procedure Tidy; property Head: PAnsiChar read FHead; property Size: integer read FSize write SetSize; property Storage: PAnsiChar read FStorage; property Tail: PAnsiChar read FTail; property Allocation: integer read FAllocation; property Bytes[Index: Integer]: PAnsiChar read GetBytes; end;

← →
DVM © (2011-05-15 23:15) [41]

implementation //------------------------------------------------------------------------------ constructor TBuffer.Create; begin Create(0); end; //------------------------------------------------------------------------------ constructor TBuffer.Create(ASize: integer); begin if ASize > 0 then FAllocation := ASize else FAllocation := MinAllocation; FSize := 0; GetMem(FStorage, FAllocation); FHead := FStorage; FTail := FHead; end; //------------------------------------------------------------------------------ constructor TBuffer.Create(AStorage: PAnsiChar; ASize: integer); begin if (ASize > 0) and Assigned(AStorage) then begin FAllocation := ASize; FSize := ASize; GetMem(FStorage, FAllocation); FHead := FStorage; Move(AStorage^, FStorage^, ASize); FTail := FHead + FSize; end else Create; end; //------------------------------------------------------------------------------ constructor TBuffer.Create(ABuffer: TBuffer); begin if (Assigned(ABuffer)) and (ABuffer.Size > 0) then begin FAllocation := ABuffer.Size; FSize := ABuffer.Size; GetMem(FStorage, FAllocation); FHead := FStorage; Move(ABuffer.Storage^, FStorage^, ABuffer.Size); FTail := FHead + FSize; end else Create; end; //------------------------------------------------------------------------------ procedure TBuffer.SetSize(ASize: integer); begin if FSize <> ASize then begin if FSize < ASize then Expand(ASize) else begin FSize := ASize; FTail := FHead + FSize; end; end; end; // Отсекает первые ACount символов ---------------------------------------------- function TBuffer.Consume(ACount: integer): integer; begin if ACount > FSize then ACount := FSize; if ACount < 0 then ACount := 0; FHead := FHead + ACount; FSize := FSize - ACount; Result := ACount; end; // Отсекает последние ACount символов ------------------------------------------- function TBuffer.Shrink(ACount: integer): integer; begin if ACount > FSize then ACount := FSize; if ACount < 0 then ACount := 0; FSize := FSize - ACount; if FTail > FHead + FSize then FTail := FHead + FSize; Result := ACount; end; // Расширение буфера ----------------------------------------------------------- function TBuffer.Expand(ACount: integer): integer; var Spare, HeadSpace, TailSpace, Width, OldAllocation: integer; NewStorage: PAnsiChar; begin result := FSize; if ACount <= 0 then exit; // Свободный (незанятый) объем буфера Spare := FAllocation - FSize; // Свободное место в начале буфера HeadSpace := FHead - FStorage; // Свободное место в конце буфера TailSpace := Spare - HeadSpace; // Размер (ширина) занятой части буфера Width := Tail - Head; // Если в буфере есть достаточно свободного места для добавления ACount байт if Spare >= ACount then begin // Если хвост меньше чем надо добавить if TailSpace < ACount then begin // Двигаем полезные данные в начало буфера Move(FHead^, FStorage^, FSize); // Начало данных совпадает с началом буфера FHead := FStorage; // Хвост данных на расстоянии width от головы FTail := FHead + Width; end; end else // Если в буфере недостаточно места для добавления count символов begin OldAllocation := FAllocation; // Общий объем буфера увеличиваем на count FAllocation := FAllocation + ACount; // Создаем временный буфер нужного размера GetMem(NewStorage, FAllocation); FillChar(NewStorage^, FAllocation, 0); if FStorage <> nil then begin // Копируем в него данные из старого буфера Move(FHead^, NewStorage^, FSize); // Старый буфер удаляем FreeMem(FStorage, OldAllocation); end; // Новый буфер заменяет старый FStorage := NewStorage; // Данные в начале буфера FHead := FStorage; // Хвоcт на расстоянии width от головы буфера FTail := FHead + Width; end; // Устанавливаем новый размер буфера FSize := FSize + ACount; // Возвращаем новый размер result := FSize; end; // Добавление данных в конец буфера -------------------------------------------- function TBuffer.Append(AStorage: PAnsiChar; ASize: integer): integer; begin if Assigned(AStorage) and (ASize > 0) then begin Expand(ASize); Move(AStorage^, FTail^, ASize); FTail := FTail + ASize; end; result := FSize; end; // Добавление данных в конец буфера -------------------------------------------- function TBuffer.Append(ABuffer: TBuffer): integer; begin result := Append(ABuffer.Storage, ABuffer.Size); end;

← →
DVM © (2011-05-15 23:15) [42]

// Извлечение первых ACount символов с их удалением из буфера ------------------ function TBuffer.Extract(ACount: integer): PAnsiChar; var OldHead: PAnsiChar; begin if ACount > FSize then ACount := FSize; if ACount < 0 then ACount := 0; OldHead := FHead; Inc(FHead, ACount); Dec(FSize, ACount); result := OldHead; end; //------------------------------------------------------------------------------ procedure TBuffer.Empty; begin FSize := 0; FHead := FStorage; FTail := FHead; end; //------------------------------------------------------------------------------ function TBuffer.Assign(AStorage: PAnsiChar; ASize: integer): integer; begin if Assigned(AStorage) and (ASize > 0) then begin FreeMem(FStorage, FAllocation); FSize := ASize; FAllocation := FSize; GetMem(FStorage, FAllocation); FHead := FStorage; Move(AStorage^, FStorage^, FSize); FTail := FHead + FSize; end; result := FSize; end; //------------------------------------------------------------------------------ function TBuffer.Assign(ABuffer: TBuffer): integer; begin result := Assign(ABuffer.Storage, ABuffer.Size); end; //------------------------------------------------------------------------------ destructor TBuffer.Destroy; begin FreeMem(FStorage, FAllocation); inherited Destroy; end; //------------------------------------------------------------------------------ function TBuffer.GetBytes(Index: Integer): PAnsiChar; begin result := Head + Index; end; //------------------------------------------------------------------------------ procedure TBuffer.Tidy; begin if FHead <> FStorage then begin if FSize = 0 then begin FHead := FStorage; FTail := FHead; end else begin Move(FHead^, FStorage, FSize); FHead := FStorage; FTail := FHead + FSize; end; end; end; //------------------------------------------------------------------------------ function TBuffer.IsEmpty: boolean; begin result := FSize = 0; end; //------------------------------------------------------------------------------ procedure TBuffer.Compact; var Temp: PAnsiChar; begin if FSize > 0 then begin GetMem(Temp, FSize); Move(FHead^, Temp^, FSize); FreeMem(FStorage, FAllocation); FStorage := Temp; FAllocation := FSize; end else begin FreeMem(FStorage, FAllocation); FSize := 0; FAllocation := MinAllocation; GetMem(FStorage, FAllocation); end; FHead := FStorage; FTail := FHead + FSize; FAllocation := FSize; end; //------------------------------------------------------------------------------ end.

← →
Германн © (2011-05-16 00:37) [43]

> DVM © (15.05.11 23:14) [40]
>
>
> > Германн © (13.05.11 16:46) [14]
> >
> > > Для какой такой особой цели
> >
> > Приемный накопительный буфер.
>
> бери мой, может подойдет
>

Спасибо, хорошая штука. Но в моем случае это из пушки по воробьям.

← →
Германн © (2011-05-16 01:04) [44]

> Германн © (16.05.11 00:37) [43]
>
>
> > DVM © (15.05.11 23:14) [40]

Хотя. На всякий случай код сохранил. Если задача усложнится, то он может пригодиться.

> бери мой, может подойдет

Странно, что ты в данном модуле не добавил свой привычный блок комментария об авторе кода. Я уже добавил в сей юнит комментарий, что сей юнит создан тобой. Но естественно я не помню, как ты оформляешь сей комментарий.

> Anatoly Podgoretsky © (15.05.11 07:32) [39]
>
> > Германн (15.05.2011 06:13:38) [38]
>
> Почему не убью, особенно для TCP/IP
>

Потому что лень будет разбираться с кодом. :)
Ведь вывод в визуальный контрол у меня не планируется даже. :)

Тип AniString Найти похожие ветки