Contributor: SCOTT R. HOUCK
Program BannerC;
{$V-}
{ Written by Scott R. Houck
This program produces banners which can be sent to the screen
or to a file. If sent to a file, the output may be appended to
to an existing file if desired.
The syntax is as follows:
BANNER [/B=banner] [/I=infile] [/O=outfile [/A]] [/C=char]
where
banner = a character string of maximum length 10
infile = an input file containing the banner(s)
outfile = an output file to which the banner(s) will be written
char = character to be used in printing the banner
(default = the character being printed)
/A = append to file if it already exists
NOTES:
1. Options may be specified in any order, but there must be
at least one space between each one. Do not put spaces
on either side of the equals sign.
2. You may use PRN for the filename if you want to send the
output to the printer. If you choose to do this, do not
use the /A option.
3. To indicate a space in the banner when using the /B option, use
the carat symbol (^). Example: BANNER /O=DISKFILE /B=JOHN^DOE
However, this is not necessary if you are using the /I option.
4. Valid characters are 0-9, A-Z, and !"#$%&'()*+,-./:;<=>?@[\]
Any other characters will be printed as a space.
6. All lower case letters are converted to upper case.
7. Three blank lines are written before the banner is output.
8. Note that /B and /I are mutually exclusive and will produce a
syntax error if used together.
9. If all options are omitted or if the command line does not contain
either /B or /I, the command syntax is printed.
10. /A will produce a syntax error if used without /O.
11. You may not use < or > with the /B option because DOS would
interpret it as redirection of standard input and output.
}
USES DOS,CRT;
Type
str13 = string[13];
str80 = string[80];
char_pattern = array[1..10] of integer;
Const
bit_value: array[1..10] of integer = (1,2,4,8,16,32,64,128,256,512);
char_def: array[#32..#94] of char_pattern = (
{32:' '} ($000,$000,$000,$000,$000,$000,$000,$000,$000,$000),
{33:'!'} ($030,$078,$0FC,$0FC,$078,$078,$030,$000,$030,$030),
{34:'"'} ($1CE,$1CE,$1CE,$1CE,$000,$000,$000,$000,$000,$000),
{35:'#'} ($0CC,$0CC,$0CC,$3FF,$0CC,$0CC,$3FF,$0CC,$0CC,$0CC),
{36:'$'} ($030,$1FE,$3FF,$330,$3FF,$1FF,$033,$3FF,$1FE,$030),
{37:'%'} ($1C3,$366,$36C,$1D8,$030,$060,$0CE,$19B,$31B,$20E),
{38:'&'} ($1E0,$330,$330,$1C0,$1E0,$331,$31A,$31C,$1FA,$0E1),
{39:'''} ($070,$0F8,$078,$010,$020,$000,$000,$000,$000,$000),
{40:'('} ($004,$018,$030,$060,$060,$060,$060,$030,$018,$004),
{41:')'} ($080,$060,$030,$018,$018,$018,$018,$030,$060,$080),
{42:'*'} ($000,$000,$000,$084,$048,$2FD,$048,$084,$000,$000),
{43:'+'} ($000,$000,$078,$078,$3FF,$3FF,$078,$078,$000,$000),
{44:','} ($000,$000,$000,$000,$000,$070,$0F8,$078,$010,$020),
{45:'-'} ($000,$000,$000,$000,$3FF,$3FF,$000,$000,$000,$000),
{46:'.'} ($000,$000,$000,$000,$000,$000,$000,$078,$0FC,$078),
{47:'/'} ($001,$003,$006,$00C,$018,$030,$060,$0C0,$180,$100),
{48:'0'} ($078,$0FC,$186,$303,$303,$303,$303,$186,$0FC,$078),
{49:'1'} ($030,$0F0,$0B0,$030,$030,$030,$030,$030,$3FF,$3FF),
{50:'2'} ($1FE,$3FF,$203,$003,$003,$018,$060,$0C0,$3FF,$3FF),
{51:'3'} ($3FF,$3FE,$00C,$018,$038,$00E,$006,$203,$3FF,$1FE),
{52:'4'} ($01C,$03C,$06C,$0CC,$18C,$3FF,$3FF,$00C,$00C,$00C),
{53:'5'} ($3FF,$3FF,$300,$300,$3FE,$3FF,$003,$203,$3FF,$1FE),
{54:'6'} ($1FE,$3FF,$301,$300,$3FE,$3FF,$303,$303,$3FF,$1FE),
{55:'7'} ($3FF,$3FF,$006,$00C,$018,$030,$060,$0C0,$300,$300),
{56:'8'} ($1FE,$3FF,$303,$303,$1FE,$1FE,$303,$303,$3FF,$1FE),
{57:'9'} ($1FE,$3FF,$303,$303,$3FF,$1FF,$003,$003,$3FF,$1FE),
{58:':'} ($000,$000,$000,$078,$0FC,$078,$000,$078,$0FC,$078),
{59:';'} ($000,$038,$07C,$038,$000,$038,$07C,$03C,$004,$008),
{60:'<'} ($000,$000,$003,$00C,$030,$0C0,$030,$00C,$003,$000),
{61:'='} ($000,$000,$000,$3FF,$3FF,$000,$3FF,$3FF,$000,$000),
{62:'>'} ($000,$000,$0C0,$030,$00C,$003,$00C,$030,$0C0,$000),
{63:'?'} ($1FE,$3FF,$303,$006,$00C,$018,$018,$000,$018,$018),
{64:'@'} ($1FE,$303,$33B,$36B,$363,$363,$366,$37C,$300,$1FE),
{65:'A'} ($1FE,$3FF,$303,$303,$303,$3FF,$3FF,$303,$303,$303),
{66:'B'} ($3FE,$3FF,$303,$303,$3FE,$3FE,$303,$303,$3FF,$3FE),
{67:'C'} ($1FE,$3FF,$301,$300,$300,$300,$300,$301,$3FF,$1FE),
{68:'D'} ($3FE,$3FF,$303,$303,$303,$303,$303,$303,$3FF,$3FE),
{69:'E'} ($3FF,$3FF,$300,$300,$3E0,$3E0,$300,$300,$3FF,$3FF),
{70:'F'} ($3FF,$3FF,$300,$300,$3E0,$3E0,$300,$300,$300,$300),
{71:'G'} ($1FE,$3FF,$300,$300,$31F,$31F,$303,$303,$3FF,$1FF),
{72:'H'} ($303,$303,$303,$303,$3FF,$3FF,$303,$303,$303,$303),
{73:'I'} ($3FF,$3FF,$030,$030,$030,$030,$030,$030,$3FF,$3FF),
{74:'J'} ($0FF,$0FF,$018,$018,$018,$018,$318,$318,$3F8,$1F0),
{75:'K'} ($303,$306,$318,$360,$3E0,$330,$318,$30C,$306,$303),
{76:'L'} ($300,$300,$300,$300,$300,$300,$300,$300,$3FF,$3FF),
{77:'M'} ($303,$3CF,$37B,$333,$333,$303,$303,$303,$303,$303),
{78:'N'} ($303,$383,$343,$363,$333,$333,$31B,$30B,$307,$303),
{79:'O'} ($1FE,$3FF,$303,$303,$303,$303,$303,$303,$3FF,$1FE),
{80:'P'} ($3FE,$3FF,$303,$303,$3FF,$3FE,$300,$300,$300,$300),
{81:'Q'} ($1FE,$3FF,$303,$303,$303,$303,$33B,$30F,$3FE,$1FB),
{82:'R'} ($3FE,$3FF,$303,$303,$3FF,$3FE,$318,$30C,$306,$303),
{83:'S'} ($1FE,$3FF,$301,$300,$3FE,$1FF,$003,$203,$3FF,$1FE),
{84:'T'} ($3FF,$3FF,$030,$030,$030,$030,$030,$030,$030,$030),
{85:'U'} ($303,$303,$303,$303,$303,$303,$303,$303,$3FF,$1FE),
{86:'V'} ($303,$303,$186,$186,$186,$186,$0CC,$0CC,$078,$030),
{87:'W'} ($303,$303,$303,$303,$333,$333,$333,$37B,$1CE,$186),
{88:'X'} ($303,$186,$0CC,$078,$030,$078,$0CC,$186,$303,$303),
{89:'Y'} ($303,$186,$0CC,$078,$030,$030,$030,$030,$030,$030),
{90:'Z'} ($3FF,$3FE,$00C,$018,$030,$030,$060,$0C0,$1FF,$3FF),
{91:'['} ($0FE,$0FE,$0C0,$0C0,$0C0,$0C0,$0C0,$0C0,$0FE,$0FE),
{92:'\'} ($200,$300,$180,$0C0,$060,$030,$018,$00C,$006,$002),
{93:']'} ($0FE,$0FE,$006,$006,$006,$006,$006,$006,$0FE,$0FE),
{94:'^'} ($000,$000,$000,$000,$000,$000,$000,$000,$000,$000) );
Var
character: char;
banner: str13;
Param: array[1..4] of str80;
InfileName, OutfileName: str80;
Infile, Outfile: text;
Slash_A, Slash_B, Slash_C, Slash_I, Slash_O: boolean;
{----------------------------------------------------------------------}
Procedure Beep;
begin
Sound(350);
Delay(300);
NoSound;
end;
{----------------------------------------------------------------------}
Procedure UpperCase(var AnyStr: str80);
var
i: integer;
begin
For i := 1 to length(AnyStr) do AnyStr[i] := UpCase(AnyStr[i]);
end;
{----------------------------------------------------------------------}
Function Exist(filename: str80): boolean;
var
tempfile: file;
begin
Assign(tempfile,filename);
{$I-}
Reset(tempfile);
{$I+}
Exist := (IOresult = 0);
Close(tempfile);
end;
{----------------------------------------------------------------------}
Procedure Print_Syntax;
begin
Writeln('The syntax is as follows:'^J);
Writeln(' BANNER [/B=banner] [/I=infile] [/O=outfile [/A]] ',
'[/C=char]'^J);
Writeln('where'^J);
Writeln(' banner = character string of maximum length 10');
Writeln(' infile = input file containing banner text');
Writeln(' outfile = output file to which the banner(s) will be ',
'written');
Writeln(' char = character to be used in printing the banner');
Writeln(' (default = the character being printed)'^J);
Writeln(' /A = append to file if it already exists'^J);
Writeln('Note that /B and /I are mutually exclusive.');
Writeln('Use a carat (^) for a space if using /B.');
Writeln('Valid characters are 0-9, A-Z, and ',
'!"#$%&''()*+,-./:;<=>?@[\]');
end;
{----------------------------------------------------------------------}
Procedure Parse;
var
n, b, c, i, o: integer;
ch1, ch2, ch3: char;
{*} procedure Error;
begin
Beep;
Print_Syntax;
Halt;
end;
begin { Parse }
Slash_A := false;
Slash_B := false; b := 0;
Slash_C := false; c := 0;
Slash_I := false; i := 0;
Slash_O := false; o := 0;
If ParamCount = 0 then
begin
Print_Syntax;
Halt;
end;
If ParamCount > 4 then Error;
For n := 1 to ParamCount do
begin
Param[n] := ParamStr(n);
UpperCase(Param[n]);
ch1 := Param[n][1];
ch2 := Param[n][2];
ch3 := Param[n][3];
If (ch1 <> '/') or not (ch2 in ['A','B','C','I','O']) then Error;
If ch2 = 'A' then
Slash_A := true;
If ch2 = 'B' then
begin
Slash_B := true;
b := n;
end;
If ch2 = 'C' then
begin
Slash_C := true;
c := n;
end;
If ch2 = 'I' then
begin
Slash_I := true;
i := n;
end;
If ch2 = 'O' then
begin
Slash_O := true;
o := n;
end;
If (ch2 in ['B','C','I','O']) and (ch3 <> '=') then Error;
If (ch2 = 'A') and (length(ch2) > 2) then Error;
end;
If Slash_B and Slash_I then Error;
If not Slash_B and not Slash_I then Error;
If Slash_A and not Slash_O then Error;
If Slash_B then
begin
banner := Param[b];
Delete(banner,1,3);
end;
If Slash_C then character := Param[c][4];
If Slash_I then
begin
InfileName := Param[i];
Delete(InfileName,1,3);
end;
If Slash_O then
begin
OutfileName := Param[o];
Delete(OutfileName,1,3);
end;
end;
{----------------------------------------------------------------------}
Procedure Heading(message: str13);
var
i, j, k: integer;
begin
If Slash_O
then Writeln(Outfile,^M^J^M^J^M^J)
else Writeln(^J^J^J);
For i := 1 to 10 do
begin
For j := 1 to length(message) do
begin
If not (message[j] in [#32..#94]) then message[j] := #32;
For k := 10 downto 1 do
If char_def[message[j],i] and bit_value[k] = bit_value[k]
then
begin
If not Slash_C then character := message[j];
If Slash_O
then Write(Outfile,character)
else Write(character);
end
else
begin
If Slash_O
then Write(Outfile,' ')
else Write(' ');
end;
If Slash_O
then Write(Outfile,' ')
else Write(' ');
end;
If Slash_O
then Writeln(Outfile)
else Writeln;
end;
end;
{----------------------------------------------------------------------}
Begin { Banner }
Parse;
If Slash_O then
begin
Assign(Outfile,OutfileName);
If Slash_A and Exist(OutfileName)
then Append(Outfile)
else Rewrite(Outfile);
end;
If Slash_I then
begin
Assign(Infile,InfileName);
Reset(Infile);
While not Eof(Infile) do
begin
Readln(Infile,banner);
UpperCase(banner);
Heading(banner);
end;
Close(Infile);
end
else Heading(banner);
If Slash_O then Close(Outfile);
End.