Функции для динамических Ansi-строк

type
  PStrRec = ^TStrRec;
  TStrRec = packed record
  {$IFDEF UnicodeCompiler}
    CodePage: Word;    // code page of string
    CharSize: Word;    // number of bytes per character of string
  {$ENDIF}
    RefCount: LongInt; // number of references to string
    Length: LongInt;   // number of characters of string
  end;

function InterlockedDecrement(var Value: LongInt): LongInt;
asm
  MOV  EDX, Value      // Передаем адрес переменной Value в edx
  MOV  EAX, -1         // Устанавливаем значение, на которое нужно увеличить счетчик (-1)
  LOCK XADD [EDX], EAX // Инкрементируем значение по адресу edx и сохраняем результат в eax
  DEC  EAX             // Уменьшаем eax на 1, так как InterlockedDecrement должен вернуть новое значение
end;

function InterlockedIncrement(var Value: LongInt): LongInt;
asm
  MOV  EDX, Value      // Передаем адрес переменной Value в edx
  MOV  EAX, 1          // Устанавливаем значение, на которое нужно увеличить счетчик (1)
  LOCK XADD [EDX], EAX // Инкрементируем значение по адресу edx и сохраняем результат в eax
  INC  EAX             // Увеличиваем eax на 1, так как InterlockedIncrement должен вернуть новое значение
end;

function _NewAnsiString(Length: LongInt): Pointer;
var
  P: PStrRec;
begin
  if Length > 0 then
  begin
    GetMem(P, Length + SizeOf(TStrRec) + 1 + ((Length + 1) and 1));
    Result := Pointer(PAnsiChar(P)[SizeOf(TStrRec)]);
    PWideChar(Result)[Length div 2] := #0;
    P.RefCount := 1;
    P.Length := Length;
  end
  else
    Result := nil;
end;

procedure _LStrClr(var S);
var
  P: PStrRec;
begin
  if Pointer(S) = nil then Exit;
  P := PStrRec(PAnsiChar(S)[-SizeOf(TStrRec)]);
  Pointer(S) := nil;
  if P.RefCount <= 0 then Exit;
  if InterlockedDecrement(P.RefCount) <> 0 then Exit;
  FreeMem(P);
end;

procedure _LStrFromPCharLen(var Dst: AnsiString; Src: PAnsiChar; Length: Integer);
var
  P: Pointer;
begin
  P := _NewAnsiString(Length);
  if Src <> nil then
    Move(Src^, P^, Length);
  _LStrClr(Pointer(Dst));
  Pointer(Dst) := P;
end;

procedure _LStrFromString(var Dst: AnsiString; const Src: ShortString);
begin
  _LStrFromPCharLen(Dst, PAnsiChar(@Src[1]), Length(Src));
end;

procedure _LStrFromChar(var Dst: AnsiString; Src: AnsiChar);
begin
  _LStrFromPCharLen(Dst, @Src, 1);
end;

procedure _LStrToString(var Dst: ShortString; const Src: AnsiString; MaxLen: Integer);
var
  Len: LongInt;
begin
  if Pointer(Src) <> nil then
  begin
    Len := PStrRec(@(PAnsiChar(Src)[-SizeOf(TStrRec)])).Length;
    if Len <> 0 then
    begin
      if Len > MaxLen then
         Len := MaxLen;
      Dst[0] := AnsiChar(Len);
      Move(Pointer(Src)^, Dst[1], Len);
      Exit;
    end;
  end;
  Dst[0] := #0;
end;

procedure _PStrCpy(var Dst, Src: ShortString);
begin
  Move(Src, Dst, Byte(Src[0]) + 1);
end;

procedure __CLenToPasStr(Dst: PShortString; const Src: PAnsiChar; MaxLen: Integer);
var
  i: LongInt;
begin
  if MaxLen > High(ShortString) then
    MaxLen := High(ShortString);
  i := 0;
  while (i <= MaxLen) and (Src[i] <> #0) do
  begin
    Dst^[i + 1] := Src[i];
    Inc(i);
  end;
  {if i > 0 then
    Dec(i);} // это не надо на самом деле, лишний код в оригинале
  Byte(Dst^[0]) := i;
end;

procedure __CToPasStr(Dst: PShortString; const Src: PAnsiChar);
begin
  __CLenToPasStr(Dst, Src, High(ShortString));
end;

function _LStrAddRef(var S): Pointer;
var
  P: PStrRec;
begin
  Result := Pointer(S);
  P := PStrRec(@(PAnsiChar(S)[-SizeOf(TStrRec)]));
  if P = nil then Exit;
  if P.RefCount < 0 then Exit;
  InterlockedIncrement(P.RefCount);
end;

function _LStrOfChar(Ch: AnsiChar; Count: Integer; var Dst: AnsiString): AnsiString;
begin
  _LStrClr(Dst);
  if Count > 0 then
  begin
    Pointer(Dst) := _NewAnsiString(Count);
    FillChar(Pointer(Dst)^, Count, Ch);
  end;
  Result := Dst;
end;

procedure _LStrFromArray(var Dst: AnsiString; Src: PAnsiChar; Length: LongInt);
var
  P: PAnsiChar;
begin
  P := Src;
  while (Length >= 0 ) and (P^ <> #0) do
  begin
    Inc(P);
    Dec(Length);
  end;
  _LStrFromPCharLen(Dst, Src, P - Src);
end;

procedure _LStrFromPChar(var Dst: AnsiString; Src: PAnsiChar);
var
  P: PAnsiChar;
begin
  P := Src;
  if Src <> nil then
    while P^ <> #0 do
      Inc(P);
  _LStrFromPCharLen(Dst, Src, P - Src);
end;

procedure _LStrLAsg(var Dst; const Src);
var
  P: Pointer;
begin
  P := Pointer(Src);
  _LStrAddRef(P);
  P := Pointer(Dst);
  Pointer(Dst) := Pointer(Src);
  _LStrClr(P);
end;

procedure _LStrAsg(var Dst; const Src);
var
  P: PStrRec;
  Len: Longint;
  S, D: Pointer;
begin
  S := Pointer(Src);
  if S <> nil then
  begin
    P := PStrRec(@(PAnsiChar(S)[-SizeOf(TStrRec)]));
    if P.RefCount< 0 then
    begin
      Len := P.Length;
      S := _NewAnsiString(Len);
      Move(Pointer(Src)^, S^, Len);
      P := PStrRec(@(PAnsiChar(S)[-SizeOf(TStrRec)]));
    end //!!! в оригинале тут неточность
    else//!!! по сравнению с ассемблерной версией
      InterlockedIncrement(P.RefCount);
  end;
  D := Pointer(Dst);
  Pointer(Dst) := S;
  if D = nil then Exit;
  P := PStrRec(@(PAnsiChar(D)[-SizeOf(TStrRec)]));
  if P.RefCount <= 0 then Exit;
  if InterlockedDecrement(P.RefCount) <> 0 then Exit;
  FreeMem(P);
end;

procedure _LStrArrayClr(var StrArray; Count: LongInt);
var
  P: PPointer;
begin
  if Count = 0 then Exit;
  P := @StrArray;
  repeat
    _LStrClr(P^);
    Dec(Count);
    Inc(P);
  until Count = 0;
end;

procedure _LStrSetLength(var S: AnsiString; NewLength: Integer);
var
  P: Pointer;
begin
  if NewLength <= 0 then
  begin
    _LStrClr(S);
    Pointer(S) := nil;
  end
  else if (Pointer(S) <> nil) and (PStrRec(@(PAnsiChar(S)[-SizeOf(TStrRec)])).RefCount = 1) then
  begin
    P := @(PAnsiChar(S)[-SizeOf(TStrRec)]);
    ReallocMem(P, NewLength + SizeOf(TStrRec) + 1);
    Pointer(S) := @(PAnsiChar(P)[SizeOf(TStrRec)]);
    PStrRec(@(PAnsiChar(S)[-SizeOf(TStrRec)])).Length := NewLength;
    PAnsiChar(S)[NewLength] := #0;
  end
  else
  begin
    P := _NewAnsiString(NewLength);
    if Pointer(S) <> nil then
    begin
      if PStrRec(@(PAnsiChar(S)[-SizeOf(TStrRec)])).Length < NewLength then
        NewLength := PStrRec(@(PAnsiChar(S)[-SizeOf(TStrRec)])).Length;
      Move(Pointer(S)^, P^, NewLength);
      _LStrClr(S);
    end;
    Pointer(S) := P;
  end;
end;

procedure _LStrCat(var Dst: AnsiString; Src: AnsiString);
var
  DstLength, SrcLength: LongInt;
begin
  if Pointer(Src) = nil then Exit;
  if Pointer(Dst) = nil then
  _LStrAsg(Dst, Src)
  else
  begin
    SrcLength := PStrRec(@(PAnsiChar(Src)[-SizeOf(TStrRec)])).Length;
    DstLength := PStrRec(@(PAnsiChar(Dst)[-SizeOf(TStrRec)])).Length;
    _LStrSetLength(Dst, SrcLength + DstLength);
    Move(Pointer(Src)^, PAnsiChar(Dst)[DstLength], SrcLength);
  end;
end;

procedure _LStrCatN(var Dst: AnsiString; Count: Integer);
asm
  PUSH EBX                // сохраняем регистр по соглашению вызова
  PUSH ESI                // сохраняем регистр по соглашению вызова
  PUSH EDI                // сохраняем регистр по соглашению вызова
  PUSH EDX                // количество понадобится перед выходом
  MOV EDI, EAX
  MOV EBX, EDX
  LEA ESI, [ESP + EDX * 4 + 4*4]
(* EDI - Dst; ESI - текущий аргумент; EBX - Count *)
@@next:                   // repeat
  MOV EAX, EDI
  MOV EDX, [ESI]
  call _LStrCat           //   Dst := Dst + Arg^;
  SUB ESI, 4 // следующий //   Dec(Arg);
  DEC EBX                 //   Dec(Count);
  JNZ @@next              // until Count = 0;
  POP EDX                 // количество аргументов в EDX
  POP EDI                 // восстанавливаем регистр по соглашению вызова
  POP ESI                 // восстанавливаем регистр по соглашению вызова
  POP EBX                 // восстанавливаем регистр по соглашению вызова
  POP EAX                 // адрес возврата в EAX
  LEA ESP,[ESP + EDX * 4] // восстанавливаем стек
  JMP EAX                 // возвращаемся, откуда нас вызывали
end;

procedure _LStrCat3(var Dst: AnsiString; Src1, Src2: AnsiString);
var
  Len1, Len2: LongInt;
  P: Pointer;
begin
  if Pointer(Src1) = nil then
    _LStrAsg(Dst, Src2)
  else if Pointer(Src2) = nil then
    _LStrAsg(Dst, Src1)
  else if Pointer(Src1) = Pointer(Dst) then
    _LStrCat(Dst, Src2)
  else if Pointer(Src2) = Pointer(Dst) then
  begin
    Len1 := PStrRec(@(PAnsiChar(Src1)[-SizeOf(TStrRec)])).Length;
    Len2 := PStrRec(@(PAnsiChar(Src2)[-SizeOf(TStrRec)])).Length;
    P := _NewAnsiString(Len1 + Len2);
    Move(Pointer(Src1)^, P^, Len1);
    Move(Pointer(Src2)^, PAnsiChar(P)[Len1], Len2);
    if P <> nil then
      Dec(PStrRec(@(PAnsiChar(P)[-SizeOf(TStrRec)])).RefCount);
    _LStrAsg(Dst, P);
  end
  else
  begin
    _LStrAsg(Dst, Src1);
    _LStrCat(Dst, Src2);
  end;
end;

procedure _LStrCmp(Left, Right: AnsiString);
const
  STR_REC_SIZE = SizeOf(TStrRec);
asm
  PUSH EBX
  CMP EAX, EDX // указатели равны?
  JE @@exit
  TEST EAX,EAX // первая строка пустая?
  JZ @@nil
  TEST EDX,EDX // вторая строка пустая?
  JNZ @@notnil
@@nil:
  CMP EAX, EDX
  JMP @@exit
@@notnil:
  MOV ECX, [EAX - STR_REC_SIZE + TStrRec.Length]
  MOV EBX, [EDX - STR_REC_SIZE + TStrRec.Length]
  CMP ECX, EBX // длина первой строки больше?
  JGE @@cmp
  MOV EBX, ECX
  JMP @@cmp
@@next:
  INC EAX      // двигаем указатель первой строки
  INC EDX      // двигаем указатель второй строки
  DEC EBX      // уменьшаем счётчик цикла
@@cmp:
  MOV CL, [EAX]
  CMP CL, [EDX]
  JNE @@break  // если символы не равны, прекращаем сравнивать
  TEST EBX, EBX
  JG @@next   // если (счётчик > 0), продолжаем сравнивать 
@@break:
  CMP CL, [EDX]
@@exit:
  POP EBX
end;

// Result нигде не используется, это чтобы компилятор вдруг не выкинул неиспользуемый код
function _LStrCmp(Left, Right: AnsiString): Integer;
var
  Len1, Len2, N: Integer;
  S1, S2: PAnsiChar;
begin
  S1 := PAnsiChar(Left);
  S2 := PAnsiChar(Right);
  Result := 0;
  if S1 = S2 then Exit; // после сравнения устанавливаются флаги
  Len1 := PStrRec(@(S1[-SizeOf(TStrRec)])).Length;
  Len2 := PStrRec(@(S2[-SizeOf(TStrRec)])).Length;
  if Len1 < Len2 then
    N := Len1
  else
    N := Len2;
  while (S1^ = S2^) and (N  >  0) do
  begin
    Inc(S1);
    Inc(S2);
    Dec(N);
  end;
  Result := Byte(S1^) - Byte(S2^); // после вычитания устанавливаются флаги
end;

procedure _LStrCatN(var Dst: AnsiString; Count: Integer);
var
  Args: PPointerArray;
begin // в Delphi7, если оптимизация включена, множитель (*3), иначе (*5)
  Args := Pointer(Integer(@Args) + SizeOf(Pointer) * 5);
  for Count := Count - 1 downto 0 do
    Dst := Dst + AnsiString(Args[Count]);
// а тут надо восстановить стек и реистры, 
// но мы не знаем наверняка, какие из них были сохранены
end;

procedure _LStrOfChar(Ch: AnsiChar; Count: Integer; var Dst: AnsiString);
begin
  _LStrClr(Dst);
  if Count > 0 then
  begin
    Pointer(Dst) := _NewAnsiString(Count);
    FillChar(Pointer(Dst)^, Count, Ch);
  end;
end;

function _LStrCopy(const Src: AnsiString; Index, Count: LongInt): AnsiString;
var
  N, Len: LongInt;
begin
  Len := Length(Src);
  if Index >= 1 then
  begin
    Dec(Index);
    if Index > Len then
      Index := Len;
  end
  else
    Index := 0;
  if Count >= 0 then
  begin
    N := Len - Index;
    if N > Count then
      N := Count;
  end
  else
    N := 0;
  _LStrFromPCharLen(Result, @PAnsiChar(Pointer(Src))[Index], N);
end;

procedure _PStrCmp(Left, Right: ShortString);
asm
  PUSH ESI
  PUSH EDI
  MOV ESI, Left
  MOV EDI, Right
  MOVZX ECX, [ESI].Byte // длина строки Left в ECX
  MOVZX EDX, [EDI].Byte // длина строки Right в EDX
  INC ESI               // двигаем указатель на начало строки
  INC EDI               // двигаем указатель на начало строки
  CMP ECX, EDX          // какая строка длиннее?
  LAHF                  // сохраним флаги в регистр AH
  JLE @@cmp             // если первая длиннее, то
  MOV ECX, EDX          //   сравниваем не более, чем длина второй
@@cmp:                  
  REPE CMPSB            
  jne @@exit            // если равны, то больше та, что длиннее
  SAHF                  // грузим сохранённые при сравнении длин флаги
@@exit:
  POP EDI
  POP ESI
end;

procedure _AStrCmp(Left, Right: PAnsiChar; Count: LongInt);
asm
  PUSH ESI
  PUSH EDI
  MOV ESI, Left
  MOV EDI, Right
  TEST ECX, ECX         // установим флаги на случай Count = 0
  REPE CMPSB
  POP EDI
  POP ESI
end;

function InternalUniqueString(var Str): Pointer;
var
  P: Pointer;
  Len: LongInt;
begin
  if (Pointer(Str) <> nil) and (PStrRec(@PAnsiChar(Str)[-SizeOf(TStrRec)]).RefCount <> 1) then
  begin
    Len := PStrRec(@PAnsiChar(Str)[-SizeOf(TStrRec)]).Length;
    P := _NewAnsiString(Len);
    Move(Pointer(Str)^, P^, Len);
    if PStrRec(@PAnsiChar(Str)[-SizeOf(TStrRec)]).RefCount >= 1 then
    begin
      InterlockedDecrement(PStrRec(@PAnsiChar(Str)[-SizeOf(TStrRec)]).RefCount);
      if PStrRec(@PAnsiChar(Str)[-SizeOf(TStrRec)]).RefCount = 0 then
        FreeMem(PStrRec(@PAnsiChar(Str)[-SizeOf(TStrRec)]));
    end;
    Pointer(Str) := P;
  end;
  Result := Pointer(Str);
end;

function _LStrPos(const SubStr, S: AnsiString): LongInt;
var
  N, K, LenStr, LenSubStr: LongInt;
begin
  Result := 0;
  if (Pointer(SubStr) <> nil) and (Pointer(S) <> nil) then
  begin
    LenSubStr := Length(SubStr);
    LenStr := Length(S) - LenSubStr + 1;
    for N := 1 to LenStr do
      if S[N] = SubStr[1] then
      begin
        K := 1;
        while (K < LenSubStr) and (S[K + N] = SubStr[K + 1]) do
          Inc(K);
        if K = LenSubStr then
        begin
          Result := N;
          Break;
        end;
      end;
  end;
end;

procedure _SetLength(S: PShortString; NewLength: Byte);
begin
  Length(S^) := NewLength;
end;

function _Copy(const S: ShortString; Index, Count: LongInt): ShortString;
begin
  // 1 <= Index <= Length(S)
  if Index < 1 then
    Index := 1
  else if Index > Length(S) then
    Index := Length(S);
  // 0 <= Count <= Length(S) - Index + 1
  if count < 0 then
    Count := 0
  else if Count > Length(S) - Index + 1 then
    Count := Length(S) - Index + 1;
  Length(Result) := Count;//SetLength(Result, Count);
  Move(S[Index], Result[1], Count);
end;

// вместо OpenString объявлено ShortString,
// иначе будет неверно работать
procedure _Delete(var S: ShortString; Index, Count: LongInt);
begin
  if (Index >= 1) and (Index <= Length(S)) then
  begin
    // 0 <= Count <= Length(S) - Index + 1
    if Count < 0 then
      Count := 0
    else if Count > Length(S) - Index + 1 then
      Count := Length(S) - Index + 1;
    Move(S[Index + Count], S[Index], Length(S) - Index + 1 - Count);
    Length(S) := Length(S) - Count;//SetLength(S, Length(S) - Count);
  end;
end;

// фактически передаётся 4 параметра(3-ий — High(Dst)):
//   (Src: ShortString; var Dst: OpenString; High(Dst), Index: LongInt)
// при этом Sizeof(Dst) будет на единицу больше High(Dst) + 1
procedure _Insert(const Src: ShortString; var Dst: OpenString; Index: LongInt);
var
  Buf: array [0..511] of AnsiChar;
  DstSize: LongInt; // сколько выделено памяти под саму строку Dst(без учёта нулевого байта длины)
begin
  // устанавливаем Index в пределах [1 .. Length(Dst) + 1]
  if Index < 1 then
    Index := 1
  else if Index > Length(Dst) + 1 then
    Index := Length(Dst) + 1;
  Move(Dst[1], Buf[0], Index - 1);
  Move(Src[1], Buf[Index - 1], Length(Src));
  Move(Dst[Index], Buf[Index - 1 + Length(Src)], Length(Dst) - (Index - 1));
  DstSize:= High(Dst);
  if DstSize > Length(Src) + Length(Dst) then
    DstSize := Length(Src) + Length(Dst);
  Length(Dst) := DstSize;//SetLength(Dst, DstSize);
  Move(Buf, Dst[1], DstSize);
end;

procedure _LStrDelete(var S: AnsiString; Index, Count: LongInt);
var
  Len: LongInt;
begin
  UniqueString(S);
  if (Pointer(S) = nil) or (Count <= 0) then Exit;
  Len := PStrRec(@PAnsiChar(S)[-SizeOf(TStrRec)]).Length;
  Dec(Index);
  if (Index < 0) or (Index >= Len) then Exit;
  if Count < 0 then
    Count := 0
  else if Count > Len - Index then
    Count := Len - Index;
  Move(S[Index + 1 + Count], S[Index + 1], Len - Index - Count);
  _LStrSetLength(S, Len - Count);
end;

procedure _LStrInsert(const Src: AnsiString; var Dst: AnsiString; Index: LongInt);
var
  SrcLen, DstLen: LongInt;
begin
  if Pointer(Src) = nil then Exit;
  SrcLen := PStrRec(@PAnsiChar(Src)[-SizeOf(TStrRec)]).Length;
  if Pointer(Dst) <> nil then
    DstLen := PStrRec(@PAnsiChar(Dst)[-SizeOf(TStrRec)]).Length
  else
    DstLen := 0;
  Dec(Index); // делаем Index 0-based
  // 0 <= Index <= Length(Dst)
  if Index < 0 then
    Index := 0
  else if Index > DstLen then
    Index := DstLen;
  _LStrSetLength(Dst, SrcLen + DstLen);
  Move(Dst[Index + 1], Dst[Index + 1 + SrcLen], DstLen - Index);
  Move(Pointer(Src)^, Dst[Index + 1], SrcLen);
end;

procedure _PStrNCpy(Dst, Src: PShortString; MaxLen: Byte);
begin
  if Length(Src^) < MaxLen then
    MaxLen := Length(Src^);
  Move(Src^[1], Dst^[1], MaxLen);
  Length(Dst^) := MaxLen;
end;

procedure _PStrNCat(Dst, Src: PShortString; MaxLen: Byte);
var
  LenToCopy, FinalLen: Byte;
begin
  if (Length(Src^) + Length(Dst^) > High(ShortString)) or
    (Length(Src^) > MaxLen) then
  begin
    FinalLen := MaxLen;
    Dec(MaxLen, Length(Dst^));
    if MaxLen <= 0 then Exit;
    LenToCopy := MaxLen;
  end
  else
  begin
    LenToCopy := Length(Src^);
    FinalLen := Length(Src^) + Length(Dst^);
  end;
  Move(Src^[1], Dst^[Length(Dst^) + 1], LenToCopy);
  Length(Dst^) := FinalLen;
end;

procedure _SetString(S: PShortString; Buffer: PAnsiChar; NewLength: Byte);
begin
  Length(S^) := NewLength;
  if Buffer = nil then Exit;
  Move(Buffer^, S^[1], NewLength);
end;

function _Pos(const SubStr, S: ShortString): LongInt;
var
  N, K, LenStr, LenSubStr: LongInt;
begin
  Result := 0;
  LenSubStr := Length(SubStr);
  LenStr := Length(S) - LenSubStr + 1;
  for N := 1 to LenStr do
    if S[N] = SubStr[1] then
    begin
      K := 1;
      while (K < LenSubStr) and (S[K + N] = SubStr[K + 1]) do
        Inc(K);
      if K = LenSubStr then
      begin
        Result := N;
        Break;
      end;
    end;
end;

LAHF

MOV EAX, ECX

SAHF

CMP EAX, EDX

var
  S20: string[20];
  S30: string[30];
.......  
  S20 := S20 + S30;
  S20 := S30;

{$if CompilerVersion < 17}
function _LStrPos(const SubStr, S: AnsiString): LongInt;
procedure _LStrOfChar(Ch: AnsiChar; Count: LongInt; var Dst: AnsiString);
{$else}
function Pos(const SubStr, S: AnsiString): LongInt; overload;
procedure StringOfChar(Ch: AnsiChar; Count: LongInt; var Dst: AnsiString); overload;
{$ifend CompilerVersion < 17}

var ShortString

var OpenString

const OpenString

const ShortString

var ShortString

Length(S) := NewLength

var s : openstring;

(Src: ShortString; var Dst: OpenString; High(Dst), Index: LongInt)

ECX = length(s) - length(source) - index 

DstLen - Index