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