Category : Files from Magazines
Archive   : ITP9001.ZIP
Filename : SEARCH.PAS

 
Output of file : SEARCH.PAS contained in archive : ITP9001.ZIP
{ Turbo Pascal File Viewer Object }

uses Dos, Crt;

const
PrintSet: set of $20..$7E = [ $20..$7E ];
ExtenSet: set of $80..$FE = [ $80..$FE ];
NoPrnSet: set of $09..$0D = [ $09, $0A, $0D ];

type
CharType = ( Unknown, Ascii, Hex );
DataBlock = array[1..256] of byte;
Viewer = object
XOrg, YOrg,
LineLen, LineCnt, BlockCount : integer;
FileName : string;
FileType : CharType;
procedure FileOpen( Fn : string;
X1, Y1, X2, Y2 : integer );
function TestBlock( FileBlock : DataBlock;
Count : integer ): CharType;
procedure ListHex( FileBlock : DataBlock;
Count, Ofs : integer );
procedure ListAscii( FileBlock : DataBlock;
Count : integer );
end;

Finder = object( Viewer )
procedure Search( Fn, SearchStr : string;
X1, Y1, X2, Y2 : integer );
end;

procedure Finder.Search;
var
VF : file; Result1, Result2 : word;
BlkOfs, i, j, SearchLen : integer;
SearchArray : array[1..128] of byte;
EndFlag, BlkDone, SearchResult : boolean;
FileBlock1, FileBlock2, ResultArray : DataBlock;
begin
BlockCount := 0;
XOrg := X1;
YOrg := Y1;
LineLen := X2;
LineCnt := Y2;
FileType := Unknown;
SearchLen := ord( SearchStr[0] );
for i := 1 to Searchlen do
SearchArray[i] := ord( SearchStr[i] );
for i := 1 to sizeof( ResultArray ) do
ResultArray[i] := $00;

assign( VF, Fn );
{$I-} reset( VF, 1 ); {$I+}
if IOresult = 0 then
begin
EndFlag := false;
BlkDone := false;
SearchResult := false;
BlockRead( VF, FileBlock2, sizeof( FileBlock2 ), Result2 );
EndFlag := Result2 <> sizeof( FileBlock2 );
repeat
FileBlock1 := FileBlock2;
Result1 := Result2;
FileBlock2 := ResultArray;
if not EndFlag then
begin
BlockRead( VF, FileBlock2, sizeof( FileBlock2 ), Result2 );
inc( BlockCount );
EndFlag := Result2 <> sizeof( FileBlock2 );
end else BlkDone := True;
for i := 1 to Result1 do
begin
if SearchArray[1] = FileBlock1[i] then
begin
BlkOfs := i-1;
SearchResult := true;
for j := 1 to SearchLen do
begin
if i+j-1 <= Result1 then
begin
if SearchArray[j] = FileBlock1[i+j-1] then
ResultArray[j] := FileBlock1[i+j-1] else
begin
SearchResult := false;
j := SearchLen;
end;
end else
if SearchArray[j] = FileBlock2[i+j-257] then
ResultArray[j] := FileBlock2[i+j-257] else
begin
SearchResult := false;
j := SearchLen;
end;
end;
if SearchResult then
begin
for j := SearchLen+1 to sizeof( ResultArray ) do
if i+j-1 <= Result1
then ResultArray[j] := FileBlock1[i+j-1]
else ResultArray[j] := FileBlock2[i+j-257];
i := Result1;
end;
end;
end;
until BlkDone or SearchResult;
if SearchResult then
begin
writeln( 'Search string found in file block ', BlockCount,
' beginning at byte offset ', BlkOfs, ' ...' );
writeln;
if FileType = Unknown then
FileType := TestBlock( ResultArray,
sizeof( ResultArray ) );
case FileType of
Hex : ListHex( ResultArray, sizeof( ResultArray ), BlkOfs );
Ascii : ListAscii( ResultArray, sizeof( ResultArray ) );
end;
end else writeln( '"', SearchStr, '" not found in ', FN );
close( VF );
window( 1, 1, 80, 25 );
end else writeln( Fn, ' invalid file name!' );
end;

procedure Viewer.FileOpen;
var
VF : file; Ch : char;
Result, CrtX, CrtY : word;
EndFlag : boolean;
FileBlock : DataBlock;
begin
BlockCount := 0;
XOrg := X1;
YOrg := Y1;
LineLen := X2;
LineCnt := Y2;
FileType := Unknown;
assign( VF, Fn );
{$I-} reset( VF, 1 ); {$I+}
if IOresult = 0 then
begin
window( X1, Y1, X1+X2-1, Y1+Y2-1 );
writeln;
EndFlag := false;
repeat
BlockRead( VF, FileBlock, sizeof( FileBlock ), Result );
inc( BlockCount );
EndFlag := Result <> sizeof( FileBlock );
if FileType = Unknown then
FileType := TestBlock( FileBlock, Result );
case FileType of
Hex : ListHex( FileBlock, Result, 0 );
Ascii : ListAscii( FileBlock, Result );
end;
if not EndFlag then
begin
CrtX := WhereX; CrtY := WhereY;
if WhereY = LineCnt then
begin writeln;
dec( CrtY ); end;
gotoxy( 1, 1 ); clreol;
write(' Viewing: ', FN );
gotoxy( 1, LineCnt ); clreol;
write(' Press (+) to continue, (Enter) to exit: ');
Ch := ReadKey; EndFlag := Ch <> '+';
gotoxy( 1, LineCnt ); clreol;
gotoxy( CrtX, CrtY );
end;
until EndFlag;
close( VF );
sound( 440 ); delay( 100 );
sound( 220 ); delay( 100 ); nosound;
window( 1, 1, 80, 25 );
end else writeln( Fn, ' invalid file name!' );
end;

function Viewer.TestBlock;
var
i : integer;
begin
FileType := Ascii;
for i := 1 to Count do
if not FileBlock[i] in NoPrnSet+PrintSet then
FileType := Hex;
TestBlock := FileType;
end;

procedure Viewer.ListHex;
const
HexStr: string[16] = '0123456789ABCDEF';
var
i, j, k : integer;
begin
k := 1;
repeat
write(' ');
j := (BlockCount-1) * sizeof( FileBlock ) + ( k - 1 ) + Ofs;
for i := 3 downto 0 do
write( HexStr[ j shr (i*4) AND $0F + 1 ] );
write(': ');
for i := 1 to 16 do
begin
if k <= Count then
write( HexStr[ FileBlock[k] shr 4 + 1 ],
HexStr[ FileBlock[k] AND $0F + 1 ], ' ' )
else write( ' ' );
inc( k );
if( i div 4 = i / 4 ) then write(' ');
end;
for i := k-16 to k-1 do
if i <= Count then
if FileBlock[i] in PrintSet+ExtenSet
then write( chr( FileBlock[i] ) )
else write('.');
writeln;
until k >= Count;
end;

procedure Viewer.ListAscii;
var
i : integer;
begin
for i := 1 to Count do
begin
write( chr( FileBlock[i] ) );
if WhereX > LineLen then writeln;
if WhereY >= LineCnt then
begin
writeln;
gotoxy( 1, LineCnt-1 );
end;
end;
end;

{=============== end Viewer object ==============}

var
FileFind : Finder;
begin
clrscr;
FileFind.Search( 'D:\TP\EXE\search.EXE', { file to search }
'Press any key', { search string }
1, 1, 80, 25 ); { display window }
gotoxy( 1, 25 ); clreol;
write( 'Press any key to continue: ');
while not KeyPressed do;
end.

  3 Responses to “Category : Files from Magazines
Archive   : ITP9001.ZIP
Filename : SEARCH.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/