home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / ITPJAN90.ZIP / FINDER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-12-15  |  8.0 KB  |  287 lines
  1. { Turbo Pascal File Viewer Object  }
  2. PROGRAM Finder;
  3.  
  4. USES Dos, Crt;
  5.  
  6. CONST
  7.    PrintSet: SET OF $20..$7E = [$20..$7E];
  8.    ExtenSet: SET OF $80..$FE = [$80..$FE];
  9.    NoPrnSet: SET OF $09..$0D = [$09, $0A, $0D];
  10.  
  11. TYPE
  12.    CharType = (Unknown, Ascii, Hex);
  13.    DataBlock = ARRAY[1..256] OF Byte;
  14.    Viewer = OBJECT
  15.       XOrg, YOrg,
  16.       LineLen, LineCnt, BlockCount:Integer;
  17.       FileName:STRING;
  18.       FileType:CharType;
  19.       PROCEDURE FileOpen(Fn:STRING;
  20.                          X1,Y1,X2,Y2:Integer);
  21.       FUNCTION  TestBlock(FileBlock:DataBlock;
  22.                          Count:Integer):CharType;
  23.       PROCEDURE ListHex(FileBlock:DataBlock;
  24.                          Count, Ofs:Integer);
  25.       PROCEDURE ListAscii(FileBlock:DataBlock;
  26.                          Count:Integer);
  27.             END;
  28.  
  29.    Finder = OBJECT(Viewer)
  30.       PROCEDURE Search(Fn, SearchStr:STRING;
  31.                        X1, Y1, X2, Y2:Integer);
  32.             END;
  33.  
  34. PROCEDURE Finder.Search;
  35.  VAR
  36.    VF:FILE;
  37.    Result1, Result2:Word;
  38.    BlkOfs, i, j, SearchLen:Integer;
  39.    SearchArray:ARRAY[1..128] OF Byte;
  40.    EndFlag, BlkDone, SearchResult:boolean;
  41.    FileBlock1, FileBlock2, ResultArray:DataBlock;
  42.  BEGIN
  43.    BlockCount := 0;
  44.    XOrg := X1;
  45.    YOrg := Y1;
  46.    LineLen := X2;
  47.    LineCnt := Y2;
  48.    FileType := Unknown;
  49.    SearchLen := Ord(SearchStr[0]);
  50.    FOR i := 1 TO SearchLen DO
  51.       SearchArray[i] := Ord(SearchStr[i]);
  52.    FOR i := 1 TO SizeOf(ResultArray) DO
  53.       ResultArray[i] := $00;
  54.  
  55.    Assign(VF, Fn);
  56.    {$I-} Reset(VF, 1); {$I+}
  57.    IF IOResult = 0 THEN
  58.    BEGIN
  59.     EndFlag := FALSE;
  60.     BlkDone := FALSE;
  61.     SearchResult := FALSE;
  62.     BlockRead(VF, FileBlock2,
  63.               SizeOf(FileBlock2),Result2);
  64.     EndFlag := Result2 <> SizeOf(FileBlock2);
  65.      REPEAT
  66.       FileBlock1 := FileBlock2;
  67.       Result1 := Result2;
  68.       FileBlock2 := ResultArray;
  69.       IF NOT EndFlag THEN
  70.        BEGIN
  71.         BlockRead(VF, FileBlock2,
  72.                   SizeOf(FileBlock2), Result2);
  73.         Inc(BlockCount);
  74.         EndFlag := Result2 <> SizeOf(FileBlock2);
  75.        END ELSE BlkDone := TRUE;
  76.        FOR i := 1 TO Result1 DO
  77.         BEGIN
  78.          IF SearchArray[1] = FileBlock1[i] THEN
  79.           BEGIN
  80.            BlkOfs := i-1;
  81.            SearchResult := TRUE;
  82.            FOR j := 1 TO SearchLen DO
  83.             BEGIN
  84.              IF i+j-1 <= Result1 THEN
  85.               BEGIN
  86.                IF SearchArray[j] =
  87.                 FileBlock1[i+j-1] THEN
  88.                   ResultArray[j] :=
  89.                     FileBlock1[i+j-1]
  90.                ELSE
  91.                  BEGIN
  92.                   SearchResult := FALSE;
  93.                   j := SearchLen;
  94.                  END;
  95.                END
  96.               ELSE
  97.                IF SearchArray[j] =
  98.                   FileBlock2[i+j-257] THEN
  99.                     ResultArray[j] :=
  100.                       FileBlock2[i+j-257]
  101.                ELSE
  102.                 BEGIN
  103.                  SearchResult := FALSE;
  104.                  j := SearchLen;
  105.                 END;
  106.                END;
  107.               IF SearchResult THEN
  108.                BEGIN
  109.                 FOR j := SearchLen+1 TO
  110.                          SizeOf(ResultArray) DO
  111.                  IF i+j-1 <= Result1 THEN
  112.                   ResultArray[j] :=
  113.                        FileBlock1[i+j-1]
  114.                  ELSE
  115.                   ResultArray[j] :=
  116.                        FileBlock2[i+j-257];
  117.                 i := Result1;
  118.                END;
  119.               END;
  120.              END;
  121.          UNTIL BlkDone OR SearchResult;
  122.       IF SearchResult THEN
  123.        BEGIN
  124.         Write('Search string found ');
  125.         WriteLn('in file block ', BlockCount);
  126.         Write(' beginning at byte offset ');
  127.         WriteLn(BlkOfs, ' ...');
  128.         WriteLn;
  129.         IF FileType = Unknown THEN
  130.           FileType := TestBlock(ResultArray,
  131.                       SizeOf(ResultArray));
  132.           CASE FileType OF
  133.             Hex:ListHex(ResultArray,
  134.                 SizeOf(ResultArray), BlkOfs);
  135.             Ascii:ListAscii(ResultArray,
  136.                 SizeOf(ResultArray));
  137.           END;
  138.        END
  139.        ELSE
  140.         BEGIN
  141.          Write('"', SearchStr, '" not found in ');
  142.          WriteLn(Fn);
  143.         END;
  144.        Close(VF);
  145.        Window(1, 1, 80, 25);
  146.       END
  147.       ELSE
  148.        WriteLn(Fn, ' invalid file name!');
  149.    END;
  150.  
  151. PROCEDURE Viewer.FileOpen;
  152.    VAR
  153.       VF:FILE;      Ch:Char;
  154.       Result, CrtX, CrtY:Word;
  155.       EndFlag:boolean;
  156.       FileBlock:DataBlock;
  157.    BEGIN
  158.       BlockCount := 0;
  159.       XOrg := X1;
  160.       YOrg := Y1;
  161.       LineLen := X2;
  162.       LineCnt := Y2;
  163.       FileType := Unknown;
  164.       Assign(VF, Fn);
  165.       {$I-} Reset(VF, 1); {$I+}
  166.       IF IOResult = 0 THEN
  167.       BEGIN
  168.          Window(X1, Y1, X1+X2-1, Y1+Y2-1);
  169.          WriteLn;
  170.          EndFlag := FALSE;
  171.          REPEAT
  172.             BlockRead(VF, FileBlock,
  173.                       SizeOf(FileBlock), Result);
  174.             Inc(BlockCount);
  175.             EndFlag := Result <>
  176.                   SizeOf(FileBlock);
  177.             IF FileType = Unknown THEN
  178.                FileType := TestBlock(FileBlock,
  179.                                      Result);
  180.             CASE FileType OF
  181.               Hex:ListHex(FileBlock, Result, 0);
  182.               Ascii:ListAscii(FileBlock, Result);
  183.             END;
  184.             IF NOT EndFlag THEN
  185.             BEGIN
  186.                CrtX := WhereX;    CrtY := WhereY;
  187.                IF WhereY = LineCnt THEN
  188.                BEGIN
  189.                 WriteLn;
  190.                 Dec(CrtY);
  191.                END;
  192.                GotoXY(1, 1); clreol;
  193.                Write(' Viewing: ', Fn);
  194.                GotoXY(1, LineCnt); clreol;
  195.                Write(' Press (+) to continue,');
  196.                Write(' (Enter) to exit: ');
  197.                Ch := ReadKey;
  198.                EndFlag := Ch <> '+';
  199.                GotoXY(1, LineCnt); clreol;
  200.                GotoXY(CrtX, CrtY);
  201.             END;
  202.          UNTIL EndFlag;
  203.          Close(VF);
  204.          sound(440); delay(100);
  205.          sound(220); delay(100); nosound;
  206.          Window(1, 1, 80, 25);
  207.       END
  208.       ELSE
  209.        WriteLn(Fn, ' invalid file name!');
  210.    END;
  211.  
  212. FUNCTION Viewer.TestBlock;
  213.    VAR
  214.       i:Integer;
  215.    BEGIN
  216.       FileType := Ascii;
  217.       FOR i := 1 TO Count DO
  218.          IF NOT FileBlock[i] IN
  219.             NoPrnSet+PrintSet THEN
  220.              FileType := Hex;
  221.       TestBlock := FileType;
  222.    END;
  223.  
  224. PROCEDURE Viewer.ListHex;
  225.    CONST
  226.       HexStr: STRING[16] = '0123456789ABCDEF';
  227.    VAR
  228.       i, j, k:Integer;
  229.    BEGIN
  230.       k := 1;
  231.       REPEAT
  232.          Write(' ');
  233.          j := (BlockCount-1) * SizeOf(FileBlock)
  234.               + (k - 1) + Ofs;
  235.          FOR i := 3 DOWNTO 0 DO
  236.             Write(HexStr[j SHR (i*4) AND $0F+1]);
  237.          Write(': ');
  238.          FOR i := 1 TO 16 DO
  239.          BEGIN
  240.           IF k <= Count THEN
  241.            Write(HexStr[FileBlock[k] SHR 4+1],
  242.             HexStr[ FileBlock[k] AND $0F+1 ],' ')
  243.           ELSE Write('  ');
  244.            Inc(k);
  245.            IF(i DIV 4 = i / 4) THEN Write(' ');
  246.          END;
  247.          FOR i := k-16 TO k-1 DO
  248.          IF i <= Count THEN
  249.             IF FileBlock[i] IN PrintSet+ExtenSet
  250.                THEN Write(Chr(FileBlock[i]))
  251.                ELSE Write('.');
  252.          WriteLn;
  253.       UNTIL k >= Count;
  254.    END;
  255.  
  256. PROCEDURE Viewer.ListAscii;
  257.    VAR
  258.       i:Integer;
  259.    BEGIN
  260.       FOR i := 1 TO Count DO
  261.       BEGIN
  262.          Write(Chr(FileBlock[i]));
  263.          IF WhereX > LineLen THEN WriteLn;
  264.          IF WhereY >= LineCnt THEN
  265.          BEGIN
  266.             WriteLn;
  267.             GotoXY(1, LineCnt-1);
  268.          END;
  269.       END;
  270.    END;
  271.  
  272. {=============== end Viewer object ==============}
  273.  
  274. VAR
  275.    FileFind:Finder;
  276. BEGIN
  277.    ClrScr;
  278.    {Call FileFind.Search with file to search,
  279.     search string, and display Window}
  280.    FileFind.Search('C:\COMMAND.COM',
  281.                     'DIR',
  282.                     10, 10, 70, 22);
  283.    GotoXY(1, 25);clreol;
  284.    Write('Press any key to continue: ');
  285.    WHILE NOT KeyPressed DO;
  286. END.
  287.