Category : Pascal Source Code
Archive   : STRSRC.ZIP
Filename : STSEARCH.PAS

 
Output of file : STSEARCH.PAS contained in archive : STRSRC.ZIP
{***************************************************************

StSearch - An APL like string search routine
version 1.01 12/1/88

Based on the article "String Searching In C" by Sanford J.
Hersh in the Dec 1988 issue of Computer Language Magazine
Volume 5, Number 12

Ported from C to Turbo Pascal 5
by Richard S. Sadowsky
CIS: [74017,1670]

I did this port for "kicks" because I found the algorithm
interesting. Porting C code to Pascal and vice versa is a
hobby of mine. This particular example shows how the C
algorithm is actually MORE readable the same algorithm in
Pascal (in my opinion). I did not include the C code in this
upload. It can be found in the Dec '88 issue of CLM (I'm also
confident you could find it in the CLMForum on Compuserve,
though I haven't looked).

The purpose of this routine is to find all occurrences of a
substring within a string. It is similar to the Turbo Pascal
Pos() function, except it returns a pointer to a table of all
the occurrences of the substring within the string. The maximum
number of substrings that can be stored in the table is
controled by the constant SizeVec. The table is terminated by
a -1 (the constant Terminator). A negative value prior to the
occurrence of a -1 in the Table indicates an error. See the
sample program StTest.Pas for a sample usage of this routine.

Note: Many things in this routine could be modified to make it
"more Pascal like" as well as more efficient. For the most
part, I did a strait port from the C code for purposes of
allowing comparisons of the two languages. Anyone interested
in optimizations or adaptations of this routine should send me
a message on Compuserve's BPROGA Section 2 (the Turbo Pascal 5
topic).


This fixes a bug in the first upload which caused the StrSearch
routine to work incorrectly when any portion of the substring
was the last character of the string to search.

***************************************************************}
Unit StSearch;

Interface

const
SizeVec = 15;
Terminator = -1;

type
IntTable = Array[1..SizeVec+1] of Integer;
BoolTable = Array[0..SizeOf(String)] of Boolean;
StrSearchTable = ^IntTable;
TruthTable = ^BoolTable;

function StrSearch(St,SubSt : String) : StrSearchTable;
{ Uses a Truth table to find all occurrences of a substring within a }
{ string. Returns a pointer (type StrSearchTable) to a list of the }
{ found positions. A -1 terminates the list. A negative number }
{ prior to the -1 indicates an error. }

Implementation

function StrSearch(St,SubSt : String) : StrSearchTable;

const
Vec : IntTable = (-1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);

var
X,Y : Integer;
AryIndex : Word;
SizeSt : Byte Absolute St;
SizeSub : Byte Absolute SubSt;
EndSize : Byte;
Ary : TruthTable;

begin
StrSearch := @Vec;
EndSize := SizeSt - SizeSub + 1;

if (SizeSt = 0) and (SizeSub = 0) then begin
Vec[1] := -5;
Vec[2] := Terminator;
Exit;
end;

if (SizeSub = 0) then begin
Vec[1] := -3;
Vec[2] := Terminator;
Exit;
end;

if (SizeSt = 0) then begin
Vec[1] := -2;
Vec[2] := Terminator;
Exit;
end;

if (SizeSub > SizeSt) then begin
Vec[1] := -6;
Vec[2] := Terminator;
Exit;
end;

GetMem(Ary,EndSize * SizeOf(Boolean));

X := 1;
AryIndex := 0;

while (X <= EndSize) do begin
Ary^[AryIndex] := St[X] = SubSt[1];
Inc(AryIndex);
Inc(X);
end;

Y := 2;
AryIndex := 0;
while (Y <= SizeSub) do begin
X := Y;
while (X <= (EndSize + Y)) do begin
Ary^[AryIndex] := Ary^[AryIndex] AND (St[X] = SubSt[Y]);
Inc(AryIndex);
Inc(X);
end;
Inc(Y);
AryIndex := 0;
end;

Y := 1;
X := 1;
AryIndex := 0;
while (X <= EndSize) and (Y <= SizeVec) do begin
if Ary^[AryIndex] then begin
Vec[Y] := X;
Inc(Y);
end;
Inc(AryIndex);
Inc(X);
end;

Vec[Y] := Terminator;

FreeMem(Ary,EndSize * SizeOf(Boolean));
end;


end.


  3 Responses to “Category : Pascal Source Code
Archive   : STRSRC.ZIP
Filename : STSEARCH.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/