home *** CD-ROM | disk | FTP | other *** search
/ The C Users' Group Library 1994 August / wc-cdrom-cusersgrouplibrary-1994-08.iso / vol_100 / 181_01 / cugedt.pas < prev    next >
Pascal/Delphi Source File  |  1980-01-03  |  7KB  |  285 lines
  1.  
  2.  
  3. Program CUGINS;
  4.  
  5. {
  6. DESCRIPTION:
  7.  
  8. This program will replace the specified header entries in all files
  9. specified in an input file (up to 200 file names allowed).
  10.  
  11. This program is used to edit a whole series of source files for
  12. one program. It was used for initially for YACC with has almost
  13. 60 "C" Source  and "H" Header files.
  14.  
  15. AUTHOR: C.E. Thornton [ Box 55085 Houston, TX 77255: (713) 467-1651) ]
  16.  
  17. APPLICATION: Setting up CUG Disks for their library
  18.  
  19. DATE:    Sept 26, 1985
  20.  
  21. NOTE: This software may be freely distributed and used by non-commerical
  22.       users. Users Groups and Clubs may charge reasonable (less than $15)
  23.       distribution fees. Contributions are always gratefully recieved.
  24.  
  25. >>>> Copyright Sept 1985 by C.E. Thornton
  26.  
  27. }
  28. TYPE
  29.  
  30.   infile    = STRING[20];
  31.   inlist    = ARRAY[1..200] OF infile;
  32.   line        = STRING[255];
  33.   iltext    = ARRAY[1..100] OF line;
  34.  
  35. VAR
  36.  
  37.   iflist:      infile;
  38.   ilfile:      infile;
  39.  
  40.   lineuc:      line;
  41.   inbuf:      line;
  42.   key1:       line;
  43.   key2:       line;
  44.  
  45.   edtext:      iltext;
  46.   ilist:      inlist;
  47.  
  48.   il:          TEXT;
  49.   cug:          TEXT;
  50.   fin:          TEXT;
  51.   fout:       TEXT;
  52.  
  53.   ilend:      Integer;
  54.   ihend:      Integer;
  55.  
  56.   ii:          Integer;
  57.   ij:          Integer;
  58.   jj:          Integer;
  59.   fnlen:      Integer;
  60.  
  61.   ki1:          Integer;
  62.   ki2:          Integer;
  63.   ch:          Char;
  64. {
  65. ==============================================================================
  66.         C O N V E R T   S T R I N G   T O    U P P E R C A S E
  67. ==============================================================================
  68. }
  69. PROCEDURE caseupper (VAR instr,outstr: line);
  70.  
  71. VAR
  72.   ichar:      char;
  73.   ii:          integer;
  74. {
  75.   =============================
  76.    CONVERT STRING TO UPPERCASE
  77.   =============================
  78. }
  79. BEGIN;
  80.   FOR ii := 1 to length(instr) DO
  81.   BEGIN
  82.     ichar := instr[ii];
  83.     outstr[ii] := Upcase(ichar);
  84.   END;
  85.   outstr[0] := char(length(instr));
  86. END;
  87.  
  88.  
  89. {
  90. ==============================================================================
  91.         F I L E   E X I S T   T E S T   A N D   R E P O R T
  92. ==============================================================================
  93. }
  94. FUNCTION Exist (VAR filename: infile): Boolean;
  95.  
  96. VAR
  97.   Tstfil:      FILE;
  98.  
  99. {
  100.   =============================
  101.        DOES FILE EXIST?
  102.   =============================
  103. }
  104. BEGIN;
  105.   Assign(Tstfil, Filename);
  106.   {$I-}
  107.   Reset(Tstfil);
  108.   {$I+}
  109.   Exist := (IOresult = 0);
  110.   close(Tstfil);
  111.  
  112.   If IOresult <> 0 THEN
  113.   BEGIN
  114.     Writeln('');
  115.     Writeln(' *** ERROR - File "'+filename+'" does not exist!');
  116.     Writeln(' ');
  117.   END;
  118. END;
  119.  
  120. {
  121. ==============================================================================
  122.              M A I N   P R O G R A M
  123. ==============================================================================
  124. }
  125.  
  126. BEGIN;
  127. {
  128.   ===========================
  129.      Check for Usage
  130.   ===========================
  131. }
  132.   If (PARAMCOUNT <> 2) THEN
  133.   BEGIN
  134.     Writeln('Usage:   CUGEDT Infile Editfile');
  135.     Writeln;
  136.     Writeln('  Where: "Infile" is the name of a file containing a list');
  137.     Writeln('         of files, one file specification per line, which are');
  138.     Writeln('         to be prefixed with the specified edtext information');
  139.     Writeln('  Where: "Editfile" is the name of a file containing the edit');
  140.     Writeln('         information. The first line is the starting key and');
  141.     Writeln('         second line is termination key. The program deletes');
  142.     Writeln('         all text between the two keys and inserts all lines');
  143.     Writeln('         following the two keys into the file in place of the');
  144.     Writeln('         deleted Text. NOTE: The line containing the start key');
  145.     Writeln('         is deleted and the termination line is left intact!');
  146.     Writeln;
  147.     Write('AUTHOR: C.E. Thornton [ Box 55085 Houston, TX ');
  148.     Writeln('77255: (713) 467-1651) ]');
  149.     Writeln('APPLICATION: Setting up CUG Library Disks');
  150.     Writeln('DATE:   JAN 28, 1985     (Version 1.1)');
  151.     Writeln;
  152.     Write('NOTE: This software may be freely distributed ');
  153.     Writeln('and used by non-commerical');
  154.     Write('      users. Users Groups and Clubs may charge');
  155.     Writeln(' reasonable (less than $15)');
  156.     Write('      distribution fees. Contributions are always ');
  157.     Writeln('gratefully recieved.');
  158.     Writeln;
  159.     Writeln('>>>> Copyright Sept 1985 by C.E. Thornton');
  160.   END
  161.   ELSE
  162.   BEGIN
  163. {
  164.   ===========================
  165.      LOAD INPUT FILE LIST
  166.   ===========================
  167. }
  168.   iflist := PARAMSTR(1);
  169.   While NOT Exist(iflist) Do
  170.   BEGIN
  171.     Write('Enter Correct input file list Name: ');
  172.     Readln(iflist);
  173.   END;
  174.  
  175.   assign(il,iflist);
  176.   reset(il);
  177.  
  178.   ii := 1;
  179.   WHILE ii <= 200 DO
  180.   If NOT EOF(il) THEN
  181.   BEGIN
  182.     Readln(il,ilist[ii]);
  183.     if ilist[ii] <> ' ' THEN
  184.       ii := ii + 1;
  185.   END
  186.   ELSE
  187.   BEGIN
  188.     ilend := ii - 1;
  189.     ii := 999;       {force terminate the loop}
  190.   END;
  191.  
  192.  Close(il);
  193. {
  194.   ===========================
  195.       LOAD EDIT FILE
  196.   ===========================
  197. }
  198.   iflist := PARAMSTR(2);
  199.   While NOT Exist(iflist) Do
  200.   BEGIN
  201.     Write('Enter Correct Edit File Name: ');
  202.     Readln(iflist);
  203.   END;
  204.  
  205.   assign(cug,iflist);
  206.   reset(cug);
  207.  
  208.   ii := 1;
  209.   WHILE ii <= 100 DO
  210.   If NOT EOF(cug) THEN
  211.   BEGIN
  212.     Readln(cug,edtext[ii]);
  213.     ii := ii + 1;
  214.   END
  215.   ELSE
  216.   BEGIN
  217.     ihend := ii - 1;
  218.     ii := 999;       {force terminate the loop}
  219.   END;
  220.  
  221.  Close(cug);
  222.  
  223.  
  224. {
  225.   ============================================================================
  226.            M A I N   P R O C E S S I N G   L O O P
  227.   ============================================================================
  228. }
  229.  
  230.  
  231.   FOR ij := 1 to ilend DO
  232.     If NOT Exist(ilist[ij]) THEN
  233.       Writeln
  234.       ('File "',ilist[ij],'" Does not exist!')
  235.     ELSE
  236.     BEGIN
  237.       assign(fout,'cugins.tmp');
  238.       rewrite(fout);
  239.       writeln(ilist[ij]);
  240.       assign(fin,ilist[ij]);
  241.       reset(fin);
  242.  
  243.       caseupper(edtext[1],key1);
  244.       ki1 := POS(':',key1);
  245.       if ki1 <> 0 THEN ki1 := ki1 + 1;
  246.       caseupper(edtext[2],key2);
  247.       ki2 := POS(':',key2);
  248.       if ki2 <> 0 THEN ki2 := ki2 + 1;
  249.  
  250.  
  251.       WHILE ( (NOT EOF(fin)) AND (ki1 > 0) AND (ki2 > 0) ) DO
  252.       BEGIN
  253.     IF NOT EOF(fin) THEN READLN(fin,inbuf);
  254.     caseupper(inbuf,lineuc);
  255.  
  256.     WHILE ( (NOT EOF(fin)) AND (POS(Copy(key1,1,ki1),lineuc) = 0) ) DO
  257.     BEGIN
  258.       WRITELN(fout,inbuf);
  259.       READLN(fin,inbuf);
  260.       caseupper(inbuf,lineuc);
  261.     END;
  262.  
  263.     WHILE ( (NOT EOF(fin)) AND (POS(Copy(key2,1,ki2),lineuc) = 0) ) DO
  264.     BEGIN
  265.       READLN(fin,inbuf);
  266.       caseupper(inbuf,lineuc);
  267.     END;
  268.  
  269.     IF NOT EOF(fin) THEN
  270.       FOR jj := 3 to ihend DO WRITELN(fout,edtext[jj]);
  271.  
  272.     WRITELN(fout,inbuf);
  273.  
  274.       END;
  275.  
  276.       Close(fin);
  277.       Close(fout);
  278.  
  279.       Erase(fin);
  280.       Rename(fout,ilist[ij]);
  281.  
  282.     END;
  283.   END;
  284.   END.
  285.