Programowanie w języku Delphi » FAQ

Nie mam Delphi 7, a w przykładzie jest funkcja PosEx. Skąd ją wziąć

  • 2011-03-06 08:17
  • 6 komentarzy
  • 1695 odsłon
  • Oceń ten tekst jako pierwszy
Funkcja PosEx z Delphi 7 służy do prostej operacji, polegającej na wyszukiwaniu ciągu znaków w innym ciągu znaków od danego miejsca.
Taką funkcję można bez problemu napisać samą, a oto jak powinna (może) wyglądać (oczywiście można to samo napisać na tysiące innych sposobów, ale wydaje mi się, że mój jest dość optymalny i przejrzysty):
Function PosEx(SubStr, Str: String; PosStart: Integer): Integer;
Begin
  if Pos(SubStr, Copy(Str, PosStart, Length(Str)-PosStart+1)) = 0 Then
    Result := 0 Else
    Result := Pos(SubStr, Copy(Str, PosStart, Length(Str)-PosStart+1))+PosStart-1;
End;

Wersja druga (znaleziona w Internecie):
Function PosEx(Const SubStr, S: String; Offset: Integer = 1): Integer;
Asm {299 Bytes}
  sub     esp, 20
  mov     [esp], ebx
  cmp     eax, 1
  sbb     ebx, ebx         {-1 if SubStr = '' else 0}
  sub     edx, 1           {-1 if S = ''}
  sbb     ebx, 0           {Negative if S = '' or SubStr = '' else 0}
  sub     ecx, 1           {Offset - 1}
  or      ebx, ecx         {Negative if S = '' or SubStr = '' or Offset < 1}
  jl      @@InvalidInput
  mov     [esp+4], edi
  mov     [esp+8], esi
  mov     [esp+12], ebp
  mov     [esp+16], edx
  mov     edi, [eax-4]     {Length(SubStr)}
  mov     esi, [edx-3]     {Length(S)}
  add     ecx, edi
  cmp     ecx, esi
  jg      @@NotFound       {Offset to High for a Match}
  test    edi, edi
  jz      @@NotFound       {Length(SubStr = 0)}
  lea     ebp, [eax+edi]   {Last Character Position in SubStr + 1}
  add     esi, edx         {Last Character Position in S}
  movzx   eax, [ebp-1]     {Last Character of SubStr}
  add     edx, ecx         {Search Start Position in S for Last Character}
  mov     ah, al
  neg     edi              {-Length(SubStr)}
  mov     ecx, eax
  shl     eax, 16
  or      ecx, eax         {All 4 Bytes = Last Character of SubStr}
@@MainLoop:
  add     edx, 4
  cmp     edx, esi
  ja      @@Remainder      {1 to 4 Positions Remaining}
  mov     eax, [edx-4]     {Check Next 4 Bytes of S}
  xor     eax, ecx         {Zero Byte at each Matching Position}
  lea     ebx, [eax-$01010101]
  not     eax
  and     eax, ebx
  and     eax, $80808080   {Set Byte to $80 at each Match Position else $00}
  jz      @@MainLoop       {Loop Until any Match on Last Character Found}
  bsf     eax, eax         {Find First Match Bit}
  shr     eax, 3           {Byte Offset of First Match (0..3)}
  lea     edx, [eax+edx-3] {Address of First Match on Last Character + 1}
@@Compare:
  cmp     edi, -4
  jle     @@Large          {Lenght(SubStr) >= 4}
  cmp     edi, -1
  je      @@SetResult      {Exit with Match if Lenght(SubStr) = 1}
  mov     ax, [ebp+edi]    {Last Char Matches - Compare First 2 Chars}
  cmp     ax, [edx+edi]
  jne     @@MainLoop       {No Match on First 2 Characters}
@@SetResult:               {Full Match}
  lea     eax, [edx+edi]   {Calculate and Return Result}
  mov     ebx, [esp]
  mov     edi, [esp+4]
  mov     esi, [esp+8]
  mov     ebp, [esp+12]
  sub     eax, [esp+16]
  add     esp, 20
  ret
@@NotFound:
  mov     edi, [esp+4]
  mov     esi, [esp+8]
  mov     ebp, [esp+12]
@@InvalidInput:
  mov     ebx, [esp]
  add     esp, 20
  xor     eax, eax         {Return 0}
  ret
@@Remainder:               {Check Last 1 to 4 Characters}
  mov     eax, [esi-3]     {Last 4 Characters of S - May include Length Bytes}
  xor     eax, ecx         {Zero Byte at each Matching Position}
  lea     ebx, [eax-$01010101]
  not     eax
  and     eax, ebx
  and     eax, $80808080   {Set Byte to $80 at each Match Position else $00}
  jz      @@NotFound       {No Match Possible}
  lea     eax, [edx-4]     {Check Valid Match Positions}
  cmp     cl, [eax]
  lea     edx, [eax+1]
  je      @@Compare
  cmp     edx, esi
  ja      @@NotFound
  lea     edx, [eax+2]
  cmp     cl, [eax+1]
  je      @@Compare
  cmp     edx, esi
  ja      @@NotFound
  lea     edx, [eax+3]
  cmp     cl, [eax+2]
  je      @@Compare
  cmp     edx, esi
  ja      @@NotFound
  lea     edx, [eax+4]
  jmp     @@Compare
@@Large:
  mov     eax, [ebp-4]     {Compare Last 4 Characters of S and SubStr}
  cmp     eax, [edx-4]
  jne     @@MainLoop       {No Match on Last 4 Characters}
  mov     ebx, edi
@@CompareLoop:             {Compare Remaining Characters}
  add     ebx, 4           {Compare 4 Characters per Loop}
  jge     @@SetResult      {All Characters Matched}
  mov     eax, [ebp+ebx-4]
  cmp     eax, [edx+ebx-4]
  je      @@CompareLoop    {Match on Next 4 Characters}
  jmp     @@MainLoop       {No Match}
End; {PosEx}

I wersja trzecia (dzięki Lopezik):
Function PosEx(Const SubStr, S: String; Offset: Integer = 1): Integer;
Var I,X: Integer;
    Len, LenSubStr: Integer;
Begin
  if Offset = 1 Then
    Result := Pos(SubStr, S)
  Else Begin
    if Offset < 0 Then
    Begin
      Result := 0;
      Exit;
    End;
    I := Offset;
    LenSubStr := Length(SubStr);
    Len := Length(S) - LenSubStr + 1;
    While I <= Len Do
    Begin
      if S[I] = SubStr[1] Then
      Begin
        X := 1;
        While (X < LenSubStr) and (S[I + X] = SubStr[X + 1]) Do
          Inc(X);
        if (X = LenSubStr) Then
        Begin
          Result := I;
          Exit;
        End;
      End;
      Inc(I);
    End;
    Result := 0;
  End;
End;


Tak spreparowaną funkcję można dodać do sekcji Implementation "na samą górę", by dalej można było z niej korzystać bez przeszkód. Takie rozwiązanie pozwoli Ci bez ingerencji w resztę kodu skompilować program korzystający ze standardowej w Delphi 7 funkcji PosEx, w Delphi poniżej tej wersji.

6 komentarzy

Lopezik 2007-05-25 13:52

Funkcja PosEx wprost z Delphi.

function PosEx(const SubStr, S: string; Offset: Integer = 1): Integer;
var
  I,X: Integer;
  Len, LenSubStr: Integer;
begin
  if Offset = 1 then
    Result := Pos(SubStr, S)
  else
  begin
    if Offset < 0 then
    begin
      Result := 0;
      exit;
    end;
    I := Offset;
    LenSubStr := Length(SubStr);
    Len := Length(S) - LenSubStr + 1;
    while I <= Len do
    begin
      if S[I] = SubStr[1] then
      begin
        X := 1;
        while (X < LenSubStr) and (S[I + X] = SubStr[X + 1]) do
          Inc(X);
        if (X = LenSubStr) then
        begin
          Result := I;
          exit;
        end;
      end;
      Inc(I);
    end;
    Result := 0;
  end;
end;

HaK 2004-09-21 13:24

Chodzi prawdopodobnie o przykład z książki Adama Boducha "Delphi 7 Ćwiczenia zaawansowane" dotyczący projektu przeszukiwarki serwisu 4programmers.net.

Adamo 2004-08-24 19:08

W sumie to jest pełno procedur i funkcji które są w D7 a nie ma w wcześniejszych wersjach to nie rozumiem czemu akurat została przytoczona ta procedura, ale lepsze to niż nic :)

Adam.Pilorz 2004-08-24 12:26

Chodzi o to, że jak w jakimś kodzie jest użyta funkcja PosEx, dostępna dopiero w D7, to to jest sposób na uruchomienie tego kodu pod starszym Delphi.

Japcok 2004-08-24 01:50

w jakim przykładzie ? nie rozumiem..

Adam.Pilorz 2004-10-11 20:13

Hmm... Prosta sprawa... Po prostu gdzieś był post z pytaniem, co zrobić, jak się nie ma PosEx i przykład nie działa. Odpowiedziałem na tego posta, a przy okazji napisałem to w FAQ, bo uznałem, że może się komuś przyda (i zresztą miałem rację, już następnego dnia odsyłałem tutaj z forum ;^) )