paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 17:06:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

* initial version

Browse Source
This commit is contained in:
peter 1999-11-09 14:40:50 +00:00
parent a526026966
commit 1ab0f87f7f
2 changed files with 923 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

140
utils/data2inc.exm Normal file
View File

@ -0,0 +1,140 @@
# Please compile this file with data2inc (e.g. data2inc data2inc.exm demo.inc)
#
# This demo file should show all possibilities of the data2inc program.
# (comment chars are %;#, empty lines are ignored)
# First, the standard purpose of data2inc.
# FPC (before 0.99.12) allowed only textual constants of up to 255 bytes.
# The main use of data2inc is to circumvent this by defining a constant of
# type ARRAY OF BYTE in an include file.
#
# Some of my utils have a small screen of text to show when wrong or no
# commandline parameters are passed. The below example is for ../demo/crtolf.pp
# I use an extremely small procedure in EFIO (EFIO.WrArrChar) to display such
# constants.
#
# CrToLf Usage text.
#
# First, a '!' to indictate a new record (constant in the include file). This
# also defines the type of the constant. The record ends at the next line
# starting with '!' or at the end of the file.
#
# !name is an array of char type constant
# !$name is an array of byte type constant.
# This is an array of char, named UsageCrtolf
!UsageCrtolf
# Now the contents of the type. Empty lines are deleted, so we have to put
# some constant to indicate an empty line. To ease this, \xxx octal character
# codes are allowed. (The \015's below translate to CHR(13) which is CR).
# In data2inc, all characters (and I mean all, even #0 #13 etc) are allowed
# as long as unprintable characters are noted as with octal code.
# Beware that a single \ has to be escaped as \\ !!!!!!!!
Usage: CrToLf <FileName1> [FileName2] [Switches]\015
Default all separators are translated to CrLf, spaces are tabbed\015
with a default tablength of 8\015
Switches:\015
/C : Lineseparator always Cr\015
/L : Lineseparator always Lf\015
/B : Lineseparator always CrLf(default)\015
/T : Convert spaces to hardtabs, default the otherway around\015
/S:<Nr> : Use tabsize <Nr> (default:8)\015
\015
/W[:size] : word wrap the file to a width of 80 (default) or <size>\015
characters if /W is used, tabbing is off\015
\015
/P : (only together with /W) Strip multiple points too (.... becomes .)\015
/R : (Ignored with /W): Never write more than one linefeed.\015
/D : ROT 13 file (not together with /w)\015
/M : Clean up MAN pages linux\015\015
# Now we define a new constant, the same principle as above, but we let it
# translate to an ARRAY OF BYTE typed constant.
#
# indexer usage text, translate to array of byte. (The dollarsign after the
# exclamation mark).
#
!$usageindexer
Usage: Indexer <directory>\015
Creates indexes and Files.bbs from descript.ion, recursing directories.\015
Usage : Indexer <Starting-Directory>\015
E.g. Indexer c:..\\source\015\015
#
# Now we are moving up to the more advanced possibilities. Everywhere in
# a record you can add data by placing keyword DATA on a new line, and
# put your data after it, which works pretty much like the BASIC data command
#
# After the DATA keyword, you should put a space, and then several fields
# with either (integer)nummerical or textual constants.
#
# Textual constants are similar to TP textual constants except that you can also
# use double quotes instead of single, and you can use single quotes inside
# double quotes. Also #xxx character codes are allowed, and '+' characters
# which indicate concatenation of strings under BP.
#
# Nummerical integer constants come in quite much flavours.
# $123 , 0x123 , 123h and 123H are equivalent to hexadecimal 123 (= 291 decimal)
# \666 , 666o and 666O are equivalent to octal 666 (=438 decimal)
# 123 , 123d and 123D is plain decimal 123
# %010 , 010b and 010B are equivalent to binary 010 (= 4 decimal)
#
#
# The only problem with integer constants is that 123 is NOT equal to 0123 or
# 000123
# 123 will occupy 1 byte
# 0123 will occupy 2 bytes.
# 000123 will occupy 4 bytes
#
# Same for hexadecimal constants (and the others)
#
# FFh will occupy 1 byte
# 0FFh will occupy 2 bytes.
# 000FFh will occupy 4 bytes
#
# First define a new record, ARRAY OF BYTE style
# If you want to verify DATA, try removing the '$' in the line below and
# view the ARRAY OF CHAR data.
!$weirddata
This line is just text
# now a data statement
# textual , rest nummerical
DATA 'Hello :'#12+"another 'hello'"#39,123,$123,0x456,789d,776o
Again normal text.
DATA \666,12d,13h,%10101010
# Be carefull with statements as below. Data2inc syntax isn't entirely basic.
# If you do define lines like the one below, you can't tell one,two,three apart.
DATA 'one','two','three'
# A solution would be:
DATA 'one'#0,'two'#0,'three'#0,0
#
# A demonstration line for the difference between $FF, $0FF and $000FF
#
DATA $FF,$00FF,$000FF
#
# Everything between the !$weirddata line and this line will be added to
# the constant weirddata. The empty and comment lines are of course not added.

783
utils/data2inc.pp Normal file
View File

@ -0,0 +1,783 @@
{
$Id$
Copyright (c) 1999 by Peter Vreman (msg2inc) and
Marco van de Voort (data2inc)
Placed under LGPL (See the file COPYING.FPC, included in this
distribution, for details about the copyright)
E-Mail Marco : Marcov@stack.nl
Homepage Marco: www.stack.nl/~marcov/xtdlib.htm
Data2Inc is a heavily modified version of msg2inc.pp which compiles the
inputfile to include files containing array of char( or byte) typed
constants.
(e.g. CONST xxx : ARRAY[0..xxx] OF CHAR =( aa,bb,cc,dd,ee); ,
or the same but ARRAY OF BYTE )
Two types of input file are allowed:
1 A special kind of textfile. Records start with '!'name and all following
non empty and non comment (starting with '#',':' or '%') lines until
the next line starting with '!' or EOF are the data. Data are either
plain text (with \xxx ordinal constants) lines or a kinbd of
Basic DATA command (these lines start with DATA).
See demo.txt included with this package for a commented example.
2 (special parameter -b)
An arbitrary binary file can get converted to constants. In this mode
only one constant per include file is possible.
This program has been working for three weeks now, all major bugs are fixed I
hope. A different kind of (possible) problems are the amounts of memory
allocated for the temporary buffer (MaxBuffersize variable), which
is now initialised to 256000 bytes (for textfile type, per record), and 1 MB
maximum for binary files. Also the program has to be compiled with a large
enough heap (-CH parameter of FPC) to allow this. This is the case without
modifying the default ppc386.cfg or adding -Ch parameters.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
program data2inc;
uses strings;
CONST
version='0.99.13';
{ ************
Simple service routines. These are copied from EPasStr.
The program doesn't use EPasStr, because I want it to function
BEFORE EPasStr is compiled, and distributable without XTDFPC.}
TYPE CHARSET=SET OF CHAR;
FUNCTION NextCharPos(CONST S : String;C:CHAR;Count:LONGINT):LONGINT;
VAR I,J:LONGINT;
BEGIN
I:=ORD(S[0]);
IF I=0 THEN
J:=0
ELSE
BEGIN
J:=Count;
IF J>I THEN
BEGIN
NextCharPos:=0;
EXIT
END;
WHILE (S[J]<>C) AND (J<=I) DO INC(J);
IF (J>I) THEN
J:=0;
END;
NextCharPos:=J;
END;
FUNCTION NextCharPosSet(CONST S : String;CONST C:CHARSET;Count:LONGINT):LONGINT;
VAR I,J:LONGINT;
BEGIN
I:=Length(S);
IF I=0 THEN
J:=0
ELSE
BEGIN
J:=Count;
IF J>I THEN
BEGIN
NextCharPosSet:=0;
EXIT;
END;
WHILE (j<=i) AND (NOT (S[J] IN C)) DO INC(J);
IF (J>I) THEN
J:=0; // NOT found.
END;
NextCharPosSet:=J;
END;
PROCEDURE RTrim(VAR P : String;Ch:Char);
VAR I,J : LONGINT;
BEGIN
I:=ORD(P[0]); { Keeping length in local data eases optimalisations}
IF (I>0) THEN
BEGIN
J:=I;
WHILE (P[J]=Ch) AND (J>0) DO DEC(J);
IF J<>I THEN
Delete(P,J+1,I-J+1);
END;
END;
PROCEDURE UpperCase(VAR S : String);
VAR L,I : LONGINT;
BEGIN
L:=Length(S);
IF L>0 THEN
FOR I:=1 TO L DO
IF (S[I]>CHR(96)) AND (S[I]<CHR(123)) THEN
S[I]:=CHR(ORD(S[I])-32);
END;
PROCEDURE LTrim(VAR P : String;Ch:Char);
VAR I,J : LONGINT;
BEGIN
I:=ORD(P[0]); { Keeping length in local data eases optimalisations}
IF (I>0) THEN
BEGIN
J:=1;
WHILE (P[J]=Ch) AND (J<=I) DO INC(J);
IF J>1 THEN
Delete(P,1,J-1);
END;
END;
{---- End EPasStr routines ----}
FUNCTION XlatString(Var S : String):BOOLEAN;
{replaces \xxx in string S with #x, and \\ with \ (escaped)
which can reduce size of string.
Returns false when an error in the line exists}
Function GetNumber(Position:LONGINT):LONGINT;
VAR C,
Value,
I : LONGINT;
BEGIN
I:=0; Value:=0;
WHILE I<3 DO
BEGIN
C:=ORD(S[Position+I]);
IF (C>47) AND (C<56) THEN
C:=C-48
ELSE
BEGIN
GetNumber:=-1;
EXIT;
END;
IF I=0 THEN
C:=C SHL 6;
IF I=1 THEN
C:=C SHL 3;
Value:=Value + C;
INC(I);
END;
GetNumber:=Value;
END;
VAR S2:String;
A,B : LONGINT;
Value : LONGINT;
BEGIN
A:=1; B:=1;
WHILE A<=Length(S) DO
BEGIN
IF S[A]='\' THEN
IF S[A+1]='\' THEN
BEGIN
S2[B]:='\';
INC (A,2); INC(B);
END
ELSE
BEGIN
Value:=GetNumber(A+1);
IF Value=-1 THEN
BEGIN
XlatString:=FALSE;
EXIT;
END;
S2[B]:=CHR(Value);
INC(B); INC(A,4);
END
ELSE
BEGIN
S2[B]:=S[A];
INC (A);
INC (B);
END;
END;
S2[0]:=CHR(B-1);
S:=S2;
XlatString:=TRUE;
END;
{Global equates}
VAR
Inname, {Name of input file}
OutName, {Name of output (.inc) file}
BinConstName: string; {(-b only) commandline name of constant}
ArrayByte, {TRUE when output of ARRAY OF BYTE is desired
ARRAY OF CHAR otherwise}
I_Binary : BOOLEAN; {TRUE is binary input, FALSE textual}
MsgTxt : pchar; {Temporary storage of data}
msgsize : longint; {Bytes used in MsgTxt}
maxbufsize : LONGINT; {Bytes allocated for MsgTxt}
C : CHAR;
{Dump the contents of MsgTxt (msgsize bytes) to file T (which has been opened),
using CONSTNAME as the name of the ARRAY OF CHAR constant}
procedure WriteCharFile(var t:text;constname:string);
function createconst(b:byte):string;
{decides whether to use the #xxx code or 'c' style for each char}
begin
if (b in [32..127]) and (b<>39) then
createconst:=''''+chr(b)+''''
else
createconst:='#'+chr(b div 100+48)+chr((b mod 100) div 10+48)+chr(b mod 10+48)
end;
var
cidx,i : longint;
p : PCHAR;
begin
Writeln('Writing constant: ',constname,' to file '#39,outname,#39);
{Open textfile}
write(t,'const ',constname,' : array[0..'); Writeln(t,msgsize-1,'] of char=(');
p:=msgtxt;
cidx:=0;
for i:=0 to msgsize-1 do
begin
if cidx=15 then
begin
if cidx>0 then
writeln(t,',')
else
writeln(t,'');
write(t,' ');
cidx:=0;
end
else
IF cidx>0 THEN
write(t,',')
ELSE
Write(T,' ');
write(t,createconst(ord(p^)));
inc(cidx);
inc(p);
end;
writeln(t,');');
Writeln(T);
end;
{Dump the contents of MsgTxt (msgsize bytes) to file T (which has been opened),
using CONSTNAME as the name of the ARRAY OF BYTE constant}
procedure WriteByteFile(var t:text;constname:string);
function createconst(b:byte):string;
{Translates byte B to a $xx hex constant}
VAR l : Byte;
begin
createconst[1]:='$'; createconst[0]:=#3;
l:=ORD(B SHR 4) +48;
IF l>57 THEN
l:=L+7;
createconst[2]:=CHR(l);
l:=ORD(B and 15) +48;
IF l>57 THEN
INC(L,7);
createconst[3]:=CHR(l);
end;
var
cidx,i : longint;
p : pchar;
begin
Writeln('Writing constant: ',constname,' to file '#39,outname,#39);
{Open textfile}
write(t,'const ',constname,' : array[0..'); Writeln(t,msgsize-1,'] of byte=(');
p:=msgtxt;
cidx:=0;
for i:=0 to msgsize-1 do
begin
if cidx=15 then
begin
if cidx>0 then
writeln(t,',')
else
writeln(t,'');
write(t,' ');
cidx:=0;
end
else
IF cidx>0 THEN
write(t,',')
ELSE
Write(T,' ');
write(t,createconst(ord(p^)));
inc(cidx);
inc(p);
end;
writeln(t,');');
Writeln(T);
end;
FUNCTION SpecialItem(S : String):LONGINT;
{ This procedure finds the next comma, (or the end of the string)
but comma's within single or double quotes should be ignored.
Single quotes within double quotes and vice versa are also ignored.}
VAR DataItem : LONGINT;
CONST xFcl : CHARSET = [',',#39,'"'];
BEGIN
DataItem:=0;
REPEAT
DataItem:=NextCharPosSet(S,xFcl,DataItem+1); {Find first " ' or ,}
IF (DataItem<>0) AND ((S[DataItem]='"') OR (S[DataItem]=#39)) THEN { (double)Quote found?}
DataItem:=NextCharPos(S,S[DataItem],DataItem+1); { then find other one}
UNTIL (DataItem=0) OR (S[DataItem]=',');
IF DataItem=0 THEN {Last data field of this line?}
DataItem:=Length(S);
SpecialItem:=DataItem;
END;
{ Handles reading and processing of a textual file}
procedure DoFile;
var
Infile,
Outfile : text; {in and output textfiles}
line, DataItem, {line number, position in DATA line}
I1,I2, {4 temporary counters}
I3,I4 : longint;
s,S1 : string; {S is string after reading, S1 is temporary string or
current DATA-item being processed }
VarName : String; { Variable name of constant to be written}
PROCEDURE ParseError;
{Extremely simple errorhandler}
BEGIN
Writeln('Error in line : ',Line, ' Somewhere near :',#39,S1,#39);
Close(InfIle); Close(Outfile);
HALT;
END;
PROCEDURE FixDec;
{ Reads decimal value starting at S1[1].
Value in I3, number of digits found in I1}
BEGIN
I1:=1;
WHILE ((S1[I1]>#47) AND (S1[I1]<#58)) AND (I1<=Length(S1)) DO
INC(I1);
DEC(I1);
IF I1=0 THEN
ParseError;
I3:=0;
FOR I2:=1 TO I1 DO
I3:=(I3*10)+ ORD(S1[I2])-48;
{Calc no of bytes(1,2 or 4) required from no of digits found}
IF (I1<3) THEN
I2:=1
ELSE
IF (I1=3) AND (I3<256) THEN
I2:=1
ELSE
BEGIN
IF I1<5 THEN
I2:=2
ELSE
IF (I1=5) AND (i3<65536) THEN
I2:=2
ELSE
I2:=4;
END;
END;
PROCEDURE DoChar;
{ Reads a #xxx constant at S1[1], and puts it in msgtxt array.
Deletes #xxx constant from S1}
BEGIN
Delete(S1,1,1);
FixDec;
msgtxt[Msgsize]:=CHR(I3);
inc(msgsize);
Delete(S1,1,I1);
END;
PROCEDURE DoQuote;
{ Reads a quoted text-string ('xxx' or "xxx"). Quotechar is in S1[1]
(always ' or "), any char except the quotechar is allowed between two
quotechars.
Deletes quoted textstring incl quotes from S1}
VAR C : Char;
BEGIN
C:=S1[1];
Delete(S1,1,1);
I1:=Pos(C,S1); {Find other quote}
IF I1=0 THEN
ParseError; {Quotes have to be matched}
Dec(I1);
IF I1<>0 THEN
BEGIN
Move(S1[1],Msgtxt[Msgsize],I1);
INC(msgsize,I1);
END;
Delete(S1,1,I1+1);
LTrim(S1,' ');
END;
PROCEDURE FixHex(base2:LONGINT);
{ Reads a base 2,8 or 16 constant from S1.
Parameter = 2Log of base (1,3 or 4 corresponding to base 2,8 and 16)
Constant is processed, the number of digits estimated (1,2 or 4 bytes) and
the value is appended to msgtxt accordingly}
BEGIN
I3:=0;
I2:=1;
WHILE (S1[I2] IN ['0'..'9','A'..'F','a'..'f']) AND (I2<=Length(S1)) DO
BEGIN
IF (S1[I2]>#47) AND (S1[I2]<#58) THEN
I3:=(I3 SHL base2)+ ORD(S1[I2])-48
ELSE
IF (S1[I2]>#64) AND (S1[I2]<#71) THEN
I3:=(I3 SHL base2)+ ORD(S1[I2])-55
ELSE
IF (S1[I2]>#96) AND (S1[I2]<#103) THEN
I3:=(I3 SHL base2)+ ORD(S1[I2])-87
ELSE
ParseError;
INC(I2);
END;
DEC(I2);
CASE Base2 OF
4 : BEGIN
I4:=(I2 SHR 1);
IF ODD(I2) THEN
INC(I4);
IF I4=3 THEN I4:=4
END;
3 : I4:=(I2*3 DIV 8)+1;
1 : BEGIN
IF I2<9 THEN
I4:=1
ELSE
IF I2<17 THEN
I4:=2
ELSE
I4:=4;
END;
ELSE
BEGIN
Writeln(' severe internal error ');
ParseError;
END; {else}
END; {Case}
move(I3,msgtxt[Msgsize],i4);
inc(msgsize,i4);
END;
PROCEDURE DoTextual;
{ processes aggregates of textual data like 'xxx'+#39"2143124"+'1234'#123}
BEGIN
REPEAT
CASE S1[1] OF
'#' : DoChar;
'"',#39 : DoQuote; {Should I support octal codes here?}
ELSE
ParseError;
END;
LTrim(S1,' ');
IF (S1[1]='+') THEN
Delete(S1,1,1);
LTrim(S1,' ');
UNTIL Length(S1)=0;
END;
PROCEDURE FlushMsgTxt; {Flush MsgTxt array}
BEGIN
IF msgsize>0 THEN {In memory? Then flush}
BEGIN
IF ArrayByte THEN
WriteByteFile(outfile,Varname)
ELSE
WriteCharFile(outfile,varname);
msgsize:=0;
END;
END;
{Actual DoFile}
begin
Getmem(msgtxt,maxbufsize);
Writeln('processing file : ',inname);
{Read the message file}
assign(infile,inname);
{$I-}
reset(infile);
{$I+}
if ioresult<>0 then
begin
WriteLn('*** message file '+inname+' not found ***');
exit;
end;
{Create output file}
assign (outfile,outname);
rewrite(outfile);
msgsize:=0;
Line:=0;
while not eof(infile) do
begin
readln(infile,s); {Read a line}
INC(Line);
S1:=Copy(S,1,5);
Uppercase(S1);
IF S1='DATA ' THEN {DATA keyword?}
BEGIN
Delete(S,1,5);
REPEAT
DataItem:=SpecialItem(S); {Yes. Determine size of DATA field.}
IF DataItem<>0 THEN
BEGIN
I1:=DataItem;
IF DataItem=Length(S) THEN
INC(i1); {DataItem fix for last field}
S1:=Copy(S,1,I1-1); { copy field to S1}
Delete(S,1,I1); {Delete field from S}
LTrim(S1,' ');
RTrim(S1,' ');
LTrim(S,' ');
CASE S1[1] OF {Select field type}
#39,'"','#' : DoTextual; { handles textual aggregates
e.g. #124"142"#123'sdgf''ads'}
'$' : BEGIN {Handle $xxxx hex codes}
Delete(S1,1,1);
RTrim(S1,' ');
IF Length(S1)>0 THEN
FixHex(4)
ELSE
ParseError;
END;
'0'..'9' : BEGIN { handles 0x124,124124,124124H,234h,666o,353d,24b}
IF (Length(S1)>1) AND (S1[2]='x') THEN {C style 0xABCD hex}
BEGIN
Delete(S1,1,2);
FixHex(4);
END
ELSE {other types (HP notation suffix h,o,d and b (and upcase versions,
and no suffix) }
BEGIN
CASE S1[Length(S1)] OF
'H','h' : FixHex(4); {Hex}
'o','O' : FixHex(3); {octal}
'B','b' : BEGIN {Binary}
DEC(S1[0]); {avoid 'b' char being treated as
hex B }
FixHex(1);
END;
'0'..'9','d','D' : BEGIN {decimal versions}
FixDec; {Fixdec is safe for trailing chars}
{I1 =no of digits, I3=value, I2= no bytes needed}
move(I3,msgtxt[Msgsize],i2);
inc(msgsize,i2)
END
ELSE
ParseError; {otherwise wrong suffix}
END {Nested case}
END; { IF S1[2]='x'}
END; { '0'..'9'}
'%' : BEGIN {%101010 binary constants}
Delete(S1,1,1);
FixHex(1);
END;
'\' : BEGIN {\xxx octal constants}
Delete(S1,1,1);
FixHex(3);
END;
END; {Case}
END; {IF <>0}
UNTIL {(DataItem:=Length(S)) OR} (DataItem=0); {parse until String is empty}
END {S1='DATA'}
ELSE
BEGIN {Non DATA line}
IF (Length(S)<>0) AND NOT (S[1] IN ['#',';','%']) THEN
BEGIN
C:=S[1];
IF NOT XlatString(S) THEN {Expand \xxx octal constants}
BEGIN
Writeln('Some error with a \xxx constant or a stale (unescaped) backslash');
ParseError;
END;
IF C='!' THEN { New variable}
BEGIN
FlushMsgTxt;
I1:=1;
ArrayByte:=FALSE;
IF S[2]='$' THEN {Flag for ARRAY OF BYTE?}
BEGIN
INC(I1);
ArrayByte:=TRUE;
END;
Delete(S,1,I1);
VarName:=S;
END
ELSE
BEGIN {Normal line}
i1:=Length(S);
move(s[1],msgtxt[Msgsize],i1);
inc(msgsize,i1);
END;
END;
END;
end;
close(infile);
FlushMsgTxt; {Flush variable if msgtxt is occupied}
Close(Outfile);
end;
procedure DoBinary;
var
Infile : File;
Outfile : text;
i : longint;
begin
Writeln('processing file : ',inname);
{Read the message file}
assign(infile,inname);
{$I-}
reset(infile,1);
{$I+}
if ioresult<>0 then
begin
WriteLn('*** message file '+inname+' not found ***');
exit;
end;
assign (outfile,outname);
rewrite(outfile);
{ First parse the file and count bytes needed }
msgsize:=FileSize(InFile);
IF Msgsize>1048576 THEN
msgsize:=1048576;
Getmem(msgtxt,msgsize);
BlockRead(InFile,msgTxt[0],msgsize,i);
IF I<>msgsize THEN
BEGIN
Writeln('Error while reading file',inName);
HALT(1);
END;
IF ArrayByte THEN
WriteByteFile(outfile,BinconstName)
ELSE
WriteCharFile(outfile,BinconstName);
close(infile);
Close(Outfile);
end;
{*****************************************************************************
Main Program
*****************************************************************************}
procedure getpara;
var
ch : char;
para : string;
files,i : word;
procedure helpscreen;
begin
writeln('usage : data2inc [Options] <msgfile> [incfile] [constname]');
Writeln(' The constname parameter is only valid in combination');
writeln(' with -b, otherwise the constname must be specified in the inputfile');
Writeln;
writeln('<Options> can be :');
writeln(' -B File to read is binary.');
writeln(' -A array of byte output (default is array of char)');
writeln(' -V Show version');
writeln(' -? or -H This HelpScreen');
writeln;
Writeln(' See data2inc.exm for a demonstration source');
halt(1);
end;
begin
I_binary:=FALSE;
ArrayByte:=FALSE;
FIles:=0;
for i:=1to paramcount do
begin
para:=paramstr(i);
if (para[1]='-') then
begin
ch:=upcase(para[2]);
delete(para,1,2);
case ch of
'B' : I_Binary:=TRUE;
'A' : Arraybyte:=TRUE;
'V' : begin
Writeln('Data2Inc ',version,' (C) 1999 Peter Vreman and Marco van de Voort');
Writeln;
Halt;
end;
'?','H' : Helpscreen;
end;
end
else
begin
inc(Files);
if Files>3 then
HelpScreen;
case Files of
1 : InName:=Para;
2 : OutName:=Para;
3 : BinConstName:=Para;
end;
end;
END;
if (FIles<3) AND I_Binary then
HelpScreen;
IF Files<2 THEN
HelpScreen;
end;
begin
MaxBufSize:=100000;
GetPara;
IF I_Binary THEN
DoBinary
ELSE
DoFile;
end.
{
$Log$
Revision 1.1 1999-11-09 14:40:50 peter
* initial version
}