home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / DELXY.ZIP / DELXY.PAS
Encoding:
Pascal/Delphi Source File  |  1987-03-09  |  4.0 KB  |  143 lines
  1. {$C-}
  2.  PROGRAM DelXY;
  3.   (* Isolate block of text - delete from original file and capture
  4.      in new file. *)
  5.     TYPE
  6.        STr64            = STRING[64];
  7.        STr255           = STRING[255];
  8.  
  9.     VAR
  10.        PS1                       : STr64;
  11.        InFile, OutFile, CUTFile  : TEXT;
  12.        QUIT                      : BOOLEAN;
  13.        RecD                      : ARRAY[1..200] OF STr255;
  14.        L,P2,P3,Result,
  15.        F2,F3,COUNT               : INTEGER;
  16.  
  17.  
  18.     PROCEDURE ErrMsg;
  19.  
  20.        BEGIN
  21.           Writeln;
  22.           Write('Syntax: DELXY <TextFile> <F#> <T#>');
  23.           Writeln;
  24.           Writeln('              Where: F# = Line number to start definition');
  25.           Write(
  26.                '                     T# = Line number ending block definition');
  27.           END;
  28.  
  29.     PROCEDURE Open(FilVar : STr64);
  30.  
  31.        VAR
  32.           NewVar,NewVar2  : STr64;
  33.           I,PosDot        : INTEGER;
  34.  
  35.        BEGIN
  36.           FOR I := 1 TO Length(FilVar) DO FilVar[I] := UpCase(FilVar[I]);
  37.     {$I-} Assign(InFile,FilVar);
  38.           Reset(InFile);   {$I+}
  39.           IF IOResult <> 0 THEN BEGIN
  40.              Writeln;
  41.              Write(FilVar,' not found.');
  42.              QUIT := TRUE;
  43.              END
  44.           ELSE BEGIN
  45.              PosDot := Pos('.',FilVar);
  46.              IF PosDot = 0 THEN NewVar := FilVar + '.OUT'
  47.              ELSE NewVar := Copy(FilVar,1,PosDot) + 'OUT';
  48.     {$I-} Assign(OutFile,NewVar);
  49.           Rewrite(OutFile); {$I+}
  50.           IF IOResult <> 0 THEN BEGIN
  51.              Writeln;
  52.              Write('Error writing ',NewVar,'.');
  53.              QUIT := TRUE;
  54.              END ELSE
  55.                BEGIN
  56.                  PosDot := Pos('.',FilVar);
  57.                  IF PosDot = 0 THEN NewVar2 := FilVar + '.CUT'
  58.                  ELSE NewVar2 := Copy(FilVar,1,PosDot) + 'CUT';
  59.     {$I-} Assign(CUTFile,NewVar2);
  60.           Rewrite(CUTFile); {$I+}
  61.           IF IOResult <> 0 THEN BEGIN
  62.              Writeln;
  63.              Write('Error writing ',NewVar2,'.');
  64.              QUIT := TRUE;
  65.              END;
  66.             END;
  67.           END;
  68.           END;
  69.  
  70.     PROCEDURE PCheck(NumP : INTEGER);
  71.  
  72.        BEGIN
  73.                 F2 := P2;
  74.                 F3 := P3;
  75.                 QUIT := ((P2 < 1) OR (P3 < P2));
  76.           END;
  77.  
  78.     PROCEDURE Read2Array;
  79.  
  80.        BEGIN
  81.           L := 0;
  82.           REPEAT
  83.              L := Succ(L);
  84.              Readln(InFile,RecD[L]);
  85.              UNTIL (L = 200) OR (Eof(InFile));  {Stay with-in array boundries}
  86.           END;
  87.  
  88.     PROCEDURE WritFile(X,Y,A,B : INTEGER);
  89.  
  90.        VAR
  91.           N    : INTEGER;
  92.  
  93.        BEGIN
  94.           FOR N := A TO B DO BEGIN
  95.           COUNT := Succ(COUNT);
  96.              IF (COUNT >= F2) AND (COUNT <= F3) THEN
  97.              BEGIN
  98.                IF COUNT = F2 THEN BEGIN
  99.                Writeln(Chr(7),'DELETING/SAVING:');
  100.                Writeln;
  101.                END;
  102.              Writeln(CUTFile,RecD[N]);
  103.              Writeln(RecD[N]);
  104.              END ELSE
  105.              Writeln(OutFile,RecD[N]);
  106.              END;
  107.           END;
  108.  
  109.     BEGIN
  110.     TextColor(15);
  111.     TextBackGround(1);
  112.     ClrSCR;
  113.        COUNT := 0;
  114.        QUIT := (ParamCount <> 3);
  115.        IF NOT QUIT THEN BEGIN
  116.           PS1 := ParamStr(1);
  117.           Val(ParamStr(2),P2,Result);
  118.           Val(ParamStr(3),P3,Result);
  119.           PCheck(ParamCount);
  120.           END;
  121.        IF NOT QUIT THEN BEGIN
  122.           Open(PS1);
  123.           IF NOT QUIT THEN BEGIN
  124.              REPEAT         { Read 200 lines or less at a time }
  125.                  Read2Array;
  126.                  IF L = 200 THEN BEGIN
  127.                  P2 := P2 - 200;
  128.                  P3 := P3 - 200;
  129.                  END;
  130.                  WritFile(P2,P3,1,L);
  131.           UNTIL Eof(InFile);
  132.              Writeln;
  133.              Write('Line number(s) ',F2,'-',F3);
  134.              Write(' isolated.');
  135.              END;
  136.              Close(InFile);
  137.              Close(OutFile);
  138.              Close(CUTFile);
  139.           END
  140.        ELSE ErrMsg;
  141.        Writeln;
  142.        END.
  143.