home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / banner / bannerc.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1994-04-21  |  11.7 KB  |  365 lines
  1. Program BannerPrg;
  2.  
  3. {$V-}
  4. Uses crt;
  5.  
  6. { Written by Scott R. Houck    11 Jan 86
  7.  
  8.   This program produces banners which can be sent to the screen
  9.   or to a file.  If sent to a file, the output may be appended to
  10.   to an existing file if desired.
  11.  
  12.   The syntax is as follows:
  13.  
  14.     BANNER [/B=banner] [/I=infile] [/O=outfile [/A]] [/C=char]
  15.  
  16.   where
  17.  
  18.     banner  = a character string of maximum length 10
  19.     infile  = an input file containing the banner(s)
  20.     outfile = an output file to which the banner(s) will be written
  21.     char    = character to be used in printing the banner
  22.                 (default = the character being printed)
  23.  
  24.          /A = append to file if it already exists
  25.  
  26.  
  27.   NOTES:
  28.  
  29.     1.  Options may be specified in any order, but there must be
  30.         at least one space between each one.  Do not put spaces
  31.         on either side of the equals sign.
  32.  
  33.     2.  You may use PRN for the filename if you want to send the
  34.         output to the printer. If you choose to do this, do not
  35.         use the /A option.
  36.  
  37.     3.  To indicate a space in the banner when using the /B option, use
  38.         the carat symbol (^).  Example:  BANNER /O=DISKFILE /B=JOHN^DOE
  39.         However, this is not necessary if you are using the /I option.
  40.  
  41.     4.  Valid characters are 0-9, A-Z, and !"#$%&'()*+,-./:;<=>?@[\]
  42.         Any other characters will be printed as a space.
  43.  
  44.     6.  All lower case letters are converted to upper case.
  45.  
  46.     7.  Three blank lines are written before the banner is output.
  47.  
  48.     8.  Note that /B and /I are mutually exclusive and will produce a
  49.         syntax error if used together.
  50.  
  51.     9.  If all options are omitted or if the command line does not contain
  52.         either /B or /I, the command syntax is printed.
  53.  
  54.    10.  /A will produce a syntax error if used without /O.
  55.  
  56.    11.  You may not use < or > with the /B option because DOS would
  57.         interpret it as redirection of standard input and output.
  58.  
  59. }
  60.  
  61. Type
  62.   str13 = string[13];
  63.   str80 = string[80];
  64.   char_pattern = array[1..10] of integer;
  65.  
  66. Const
  67.   bit_value: array[1..10] of integer = (1,2,4,8,16,32,64,128,256,512);
  68.  
  69.   char_def:  array[#32..#94] of char_pattern = (
  70.  
  71.     {32:' '}   ($000,$000,$000,$000,$000,$000,$000,$000,$000,$000),
  72.     {33:'!'}   ($030,$078,$0FC,$0FC,$078,$078,$030,$000,$030,$030),
  73.     {34:'"'}   ($1CE,$1CE,$1CE,$1CE,$000,$000,$000,$000,$000,$000),     
  74.     {35:'#'}   ($0CC,$0CC,$0CC,$3FF,$0CC,$0CC,$3FF,$0CC,$0CC,$0CC),     
  75.     {36:'$'}   ($030,$1FE,$3FF,$330,$3FF,$1FF,$033,$3FF,$1FE,$030),
  76.     {37:'%'}   ($1C3,$366,$36C,$1D8,$030,$060,$0CE,$19B,$31B,$20E),
  77.     {38:'&'}   ($1E0,$330,$330,$1C0,$1E0,$331,$31A,$31C,$1FA,$0E1),     
  78.     {39:'''}   ($070,$0F8,$078,$010,$020,$000,$000,$000,$000,$000),
  79.     {40:'('}   ($004,$018,$030,$060,$060,$060,$060,$030,$018,$004),
  80.     {41:')'}   ($080,$060,$030,$018,$018,$018,$018,$030,$060,$080),
  81.     {42:'*'}   ($000,$000,$000,$084,$048,$2FD,$048,$084,$000,$000),
  82.     {43:'+'}   ($000,$000,$078,$078,$3FF,$3FF,$078,$078,$000,$000),
  83.     {44:','}   ($000,$000,$000,$000,$000,$070,$0F8,$078,$010,$020),
  84.     {45:'-'}   ($000,$000,$000,$000,$3FF,$3FF,$000,$000,$000,$000),     
  85.     {46:'.'}   ($000,$000,$000,$000,$000,$000,$000,$078,$0FC,$078),
  86.     {47:'/'}   ($001,$003,$006,$00C,$018,$030,$060,$0C0,$180,$100),
  87.     {48:'0'}   ($078,$0FC,$186,$303,$303,$303,$303,$186,$0FC,$078),
  88.     {49:'1'}   ($030,$0F0,$0B0,$030,$030,$030,$030,$030,$3FF,$3FF),
  89.     {50:'2'}   ($1FE,$3FF,$203,$003,$003,$018,$060,$0C0,$3FF,$3FF),
  90.     {51:'3'}   ($3FF,$3FE,$00C,$018,$038,$00E,$006,$203,$3FF,$1FE),
  91.     {52:'4'}   ($01C,$03C,$06C,$0CC,$18C,$3FF,$3FF,$00C,$00C,$00C),
  92.     {53:'5'}   ($3FF,$3FF,$300,$300,$3FE,$3FF,$003,$203,$3FF,$1FE),
  93.     {54:'6'}   ($1FE,$3FF,$301,$300,$3FE,$3FF,$303,$303,$3FF,$1FE),
  94.     {55:'7'}   ($3FF,$3FF,$006,$00C,$018,$030,$060,$0C0,$300,$300),
  95.     {56:'8'}   ($1FE,$3FF,$303,$303,$1FE,$1FE,$303,$303,$3FF,$1FE),
  96.     {57:'9'}   ($1FE,$3FF,$303,$303,$3FF,$1FF,$003,$003,$3FF,$1FE),
  97.     {58:':'}   ($000,$000,$000,$078,$0FC,$078,$000,$078,$0FC,$078),
  98.     {59:';'}   ($000,$038,$07C,$038,$000,$038,$07C,$03C,$004,$008),
  99.     {60:'<'}   ($000,$000,$003,$00C,$030,$0C0,$030,$00C,$003,$000),
  100.     {61:'='}   ($000,$000,$000,$3FF,$3FF,$000,$3FF,$3FF,$000,$000),
  101.     {62:'>'}   ($000,$000,$0C0,$030,$00C,$003,$00C,$030,$0C0,$000),
  102.     {63:'?'}   ($1FE,$3FF,$303,$006,$00C,$018,$018,$000,$018,$018),     
  103.     {64:'@'}   ($1FE,$303,$33B,$36B,$363,$363,$366,$37C,$300,$1FE),     
  104.     {65:'A'}   ($1FE,$3FF,$303,$303,$303,$3FF,$3FF,$303,$303,$303),
  105.     {66:'B'}   ($3FE,$3FF,$303,$303,$3FE,$3FE,$303,$303,$3FF,$3FE),
  106.     {67:'C'}   ($1FE,$3FF,$301,$300,$300,$300,$300,$301,$3FF,$1FE),
  107.     {68:'D'}   ($3FE,$3FF,$303,$303,$303,$303,$303,$303,$3FF,$3FE),
  108.     {69:'E'}   ($3FF,$3FF,$300,$300,$3E0,$3E0,$300,$300,$3FF,$3FF),
  109.     {70:'F'}   ($3FF,$3FF,$300,$300,$3E0,$3E0,$300,$300,$300,$300),
  110.     {71:'G'}   ($1FE,$3FF,$300,$300,$31F,$31F,$303,$303,$3FF,$1FF),
  111.     {72:'H'}   ($303,$303,$303,$303,$3FF,$3FF,$303,$303,$303,$303),
  112.     {73:'I'}   ($3FF,$3FF,$030,$030,$030,$030,$030,$030,$3FF,$3FF),
  113.     {74:'J'}   ($0FF,$0FF,$018,$018,$018,$018,$318,$318,$3F8,$1F0),
  114.     {75:'K'}   ($303,$306,$318,$360,$3E0,$330,$318,$30C,$306,$303),
  115.     {76:'L'}   ($300,$300,$300,$300,$300,$300,$300,$300,$3FF,$3FF),
  116.     {77:'M'}   ($303,$3CF,$37B,$333,$333,$303,$303,$303,$303,$303),
  117.     {78:'N'}   ($303,$383,$343,$363,$333,$333,$31B,$30B,$307,$303),
  118.     {79:'O'}   ($1FE,$3FF,$303,$303,$303,$303,$303,$303,$3FF,$1FE),
  119.     {80:'P'}   ($3FE,$3FF,$303,$303,$3FF,$3FE,$300,$300,$300,$300),
  120.     {81:'Q'}   ($1FE,$3FF,$303,$303,$303,$303,$33B,$30F,$3FE,$1FB),
  121.     {82:'R'}   ($3FE,$3FF,$303,$303,$3FF,$3FE,$318,$30C,$306,$303),
  122.     {83:'S'}   ($1FE,$3FF,$301,$300,$3FE,$1FF,$003,$203,$3FF,$1FE),
  123.     {84:'T'}   ($3FF,$3FF,$030,$030,$030,$030,$030,$030,$030,$030),
  124.     {85:'U'}   ($303,$303,$303,$303,$303,$303,$303,$303,$3FF,$1FE),
  125.     {86:'V'}   ($303,$303,$186,$186,$186,$186,$0CC,$0CC,$078,$030),
  126.     {87:'W'}   ($303,$303,$303,$303,$333,$333,$333,$37B,$1CE,$186),
  127.     {88:'X'}   ($303,$186,$0CC,$078,$030,$078,$0CC,$186,$303,$303),
  128.     {89:'Y'}   ($303,$186,$0CC,$078,$030,$030,$030,$030,$030,$030),
  129.     {90:'Z'}   ($3FF,$3FE,$00C,$018,$030,$030,$060,$0C0,$1FF,$3FF),
  130.     {91:'['}   ($0FE,$0FE,$0C0,$0C0,$0C0,$0C0,$0C0,$0C0,$0FE,$0FE),
  131.     {92:'\'}   ($200,$300,$180,$0C0,$060,$030,$018,$00C,$006,$002),
  132.     {93:']'}   ($0FE,$0FE,$006,$006,$006,$006,$006,$006,$0FE,$0FE),
  133.     {94:'^'}   ($000,$000,$000,$000,$000,$000,$000,$000,$000,$000)    );
  134.  
  135. Var
  136.   character: char;
  137.   banner: str13;
  138.   Param: array[1..4] of str80;
  139.   InfileName, OutfileName: str80;
  140.   Infile, Outfile: text;
  141.   Slash_A, Slash_B, Slash_C, Slash_I, Slash_O: boolean;
  142.  
  143. {----------------------------------------------------------------------}
  144.  
  145. Procedure Beep;
  146.  
  147. begin
  148.   Sound(350);
  149.   Delay(300);
  150.   NoSound;
  151. end;
  152.  
  153. {----------------------------------------------------------------------}
  154.  
  155. Procedure UpperCase(var AnyStr: str80);
  156.  
  157. var
  158.   i: integer;
  159.  
  160. begin
  161.   For i := 1 to length(AnyStr) do AnyStr[i] := UpCase(AnyStr[i]);
  162. end;
  163.  
  164. {----------------------------------------------------------------------}
  165.  
  166. Function Exist(filename: str80): boolean;
  167.  
  168. var
  169.   tempfile: file;
  170.  
  171. begin
  172.   Assign(tempfile,filename);
  173.   {$I-}
  174.   Reset(tempfile);
  175.   {$I+}
  176.   Exist := (IOresult = 0);
  177.   Close(tempfile);
  178. end;
  179.  
  180. {----------------------------------------------------------------------}
  181.  
  182. Procedure Print_Syntax;
  183.  
  184. begin
  185.   Writeln('The syntax is as follows:'^J);
  186.   Writeln('  BANNER [/B=banner] [/I=infile] [/O=outfile [/A]] ',
  187.           '[/C=char]'^J);
  188.   Writeln('where'^J);
  189.   Writeln('  banner  = character string of maximum length 10');
  190.   Writeln('  infile  = input file containing banner text');
  191.   Writeln('  outfile = output file to which the banner(s) will be ',
  192.           'written');
  193.   Writeln('  char    = character to be used in printing the banner');
  194.   Writeln('              (default = the character being printed)'^J);
  195.   Writeln('       /A = append to file if it already exists'^J);
  196.   Writeln('Note that /B and /I are mutually exclusive.');
  197.   Writeln('Use a carat (^) for a space if using /B.');
  198.   Writeln('Valid characters are 0-9, A-Z, and ',
  199.           '!"#$%&''()*+,-./:;<=>?@[\]');
  200. end;
  201.  
  202. {----------------------------------------------------------------------}
  203.  
  204. Procedure Parse;
  205.  
  206. var
  207.   n, b, c, i, o: integer;
  208.   ch1, ch2, ch3: char;
  209.  
  210.   {*} procedure Error;
  211.         begin
  212.           Beep;
  213.           Print_Syntax;
  214.           Halt;
  215.         end;
  216.  
  217. begin  { Parse }
  218.  
  219.   Slash_A := false;
  220.   Slash_B := false;    b := 0;
  221.   Slash_C := false;    c := 0;
  222.   Slash_I := false;    i := 0;
  223.   Slash_O := false;    o := 0;
  224.  
  225.   If ParamCount = 0 then
  226.     begin
  227.       Print_Syntax;
  228.       Halt;
  229.     end;
  230.  
  231.   If ParamCount > 4 then Error;
  232.  
  233.   For n := 1 to ParamCount do
  234.     begin
  235.       Param[n] := ParamStr(n);
  236.       UpperCase(Param[n]);
  237.       ch1 := Param[n][1];
  238.       ch2 := Param[n][2];
  239.       ch3 := Param[n][3];
  240.       If (ch1 <> '/') or not (ch2 in ['A','B','C','I','O']) then Error;
  241.       If ch2 = 'A' then
  242.         Slash_A := true;
  243.       If ch2 = 'B' then
  244.         begin
  245.           Slash_B := true;
  246.           b := n;
  247.         end;
  248.       If ch2 = 'C' then
  249.         begin
  250.           Slash_C := true;
  251.           c := n;
  252.         end;
  253.       If ch2 = 'I' then
  254.         begin
  255.           Slash_I := true;
  256.           i := n;
  257.         end;
  258.       If ch2 = 'O' then
  259.         begin
  260.           Slash_O := true;
  261.           o := n;
  262.         end;
  263.       If (ch2 in ['B','C','I','O']) and (ch3 <> '=') then Error;
  264.       If (ch2 = 'A') and (length(ch2) > 2) then Error;
  265.     end;
  266.  
  267.   If Slash_B and Slash_I then Error;
  268.   If not Slash_B and not Slash_I then Error;
  269.   If Slash_A and not Slash_O then Error;
  270.   If Slash_B then
  271.     begin
  272.       banner := Param[b];
  273.       Delete(banner,1,3);
  274.     end;
  275.   If Slash_C then character := Param[c][4];
  276.   If Slash_I then
  277.     begin
  278.       InfileName := Param[i];
  279.       Delete(InfileName,1,3);
  280.     end;
  281.   If Slash_O then
  282.     begin
  283.       OutfileName := Param[o];
  284.       Delete(OutfileName,1,3);
  285.     end;
  286.  
  287. end;
  288.  
  289. {----------------------------------------------------------------------}
  290.  
  291. Procedure Heading(message: str13);
  292.  
  293. var
  294.   i, j, k: integer;
  295.  
  296. begin
  297.  
  298.   If Slash_O
  299.     then Writeln(Outfile,^M^J^M^J^M^J)
  300.     else Writeln(^J^J^J);
  301.  
  302.   For i := 1 to 10 do
  303.     begin
  304.       For j := 1 to length(message) do
  305.         begin
  306.           If not (message[j] in [#32..#94]) then message[j] := #32;
  307.           For k := 10 downto 1 do
  308.             If char_def[message[j],i] and bit_value[k] = bit_value[k]
  309.               then
  310.                 begin
  311.                   If not Slash_C then character := message[j];
  312.                   If Slash_O
  313.                     then Write(Outfile,character)
  314.                     else Write(character);
  315.                 end
  316.               else
  317.                 begin
  318.                   If Slash_O
  319.                     then Write(Outfile,' ')
  320.                     else Write(' ');
  321.                 end;
  322.               If Slash_O
  323.                 then Write(Outfile,'  ')
  324.                 else Write('  ');
  325.         end;
  326.       If Slash_O
  327.         then Writeln(Outfile)
  328.         else Writeln;
  329.     end;
  330.  
  331. end;
  332.  
  333. {----------------------------------------------------------------------}
  334.  
  335. Begin  { Banner }
  336.  
  337.   Parse;
  338.  
  339.   If Slash_O then
  340.     begin
  341.       Assign(Outfile,OutfileName);
  342.       If Slash_A and Exist(OutfileName)
  343.         then Append(Outfile)
  344.         else Rewrite(Outfile);
  345.     end;
  346.  
  347.   If Slash_I then
  348.     begin
  349.       Assign(Infile,InfileName);
  350.       Reset(Infile);
  351.       While not Eof(Infile) do
  352.         begin
  353.           Readln(Infile,banner);
  354.           UpperCase(banner);
  355.           Heading(banner);
  356.         end;
  357.       Close(Infile);
  358.     end
  359.  
  360.   else Heading(banner);
  361.  
  362.   If Slash_O then Close(Outfile);
  363.  
  364. End.
  365.