123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891 |
- {
- Copyright (c) 1999-2000 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 : [email protected]
- 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 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='1.00';
- maxbufsize = 1024*1024; { 1 mb buffer }
- type
- TOutputMode=(OutByte,OutChar,OutString);
- {*****************************************************************************
- Simple service routines. These are copied from EPasStr.
- *****************************************************************************}
- 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;
- {*****************************************************************************
- Parsing helpers
- *****************************************************************************}
- 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 }
- OutputMode : TOutputMode; { Output mode (char,byte,string) }
- I_Binary : BOOLEAN; { TRUE is binary input, FALSE textual }
- MsgTxt : pchar; { Temporary storage of data }
- msgsize : longint; { Bytes used in MsgTxt }
- C : CHAR;
- {*****************************************************************************
- WriteCharFile
- *****************************************************************************}
- {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;
- {*****************************************************************************
- WriteByteFile
- *****************************************************************************}
- {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;
- {*****************************************************************************
- WriteStringFile
- *****************************************************************************}
- procedure WriteStringFile(var t:text;constname:string);
- const
- maxslen=240; { to overcome aligning problems }
- function l0(l:longint):string;
- var
- s : string[16];
- begin
- str(l,s);
- while (length(s)<5) do
- s:='0'+s;
- l0:=s;
- end;
- var
- slen,
- len,i : longint;
- p : pchar;
- start,
- quote : boolean;
- begin
- Writeln('Writing constant: ',constname,' to file '#39,outname,#39);
- {Open textfile}
- writeln(t,'{$ifdef Delphi}');
- writeln(t,'const '+constname+' : array[0..',(msgsize-1) div maxslen,'] of string[',maxslen,']=(');
- writeln(t,'{$else Delphi}');
- writeln(t,'const '+constname+' : array[0..',(msgsize-1) div maxslen,',1..',maxslen,'] of char=(');
- write(t,'{$endif Delphi}');
- {Parse buffer in msgbuf and create indexs}
- p:=msgtxt;
- slen:=0;
- len:=0;
- quote:=false;
- start:=true;
- for i:=1 to msgsize do
- begin
- if slen>=maxslen then
- begin
- if quote then
- begin
- write(t,'''');
- quote:=false;
- end;
- write(t,',');
- slen:=0;
- inc(len);
- end;
- if (len>70) or (start) then
- begin
- if quote then
- begin
- write(t,'''');
- quote:=false;
- end;
- if slen>0 then
- writeln(t,'+')
- else
- writeln(t);
- len:=0;
- start:=false;
- end;
- if (len=0) then
- write(t,' ');
- if (ord(p^)>=32) and (p^<>#39) then
- begin
- if not quote then
- begin
- write(t,'''');
- quote:=true;
- inc(len);
- end;
- write(t,p^);
- inc(len);
- end
- else
- begin
- if quote then
- begin
- write(t,'''');
- inc(len);
- quote:=false;
- end;
- write(t,'#'+chr(ord(p^) div 100+48)+chr((ord(p^) mod 100) div 10+48)+chr(ord(p^) mod 10+48));
- inc(len,3);
- end;
- { start a new line when a #0 or #10 is found }
- if p^ in [#0,#10] then
- start:=true;
- inc(slen);
- inc(p);
- end;
- if quote then
- write(t,'''');
- writeln(t,'');
- writeln(t,');');
- end;
- {*****************************************************************************
- Parser
- *****************************************************************************}
- 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}
- var I1,I2,i3 : longint;
- 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
- case outputmode of
- OutByte :
- WriteByteFile(outfile,Varname);
- OutChar :
- WriteCharFile(outfile,varname);
- OutString :
- WriteStringFile(outfile,varname);
- end;
- 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('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;
- OutputMode:=OutChar;
- IF S[2]='$' THEN {Flag for ARRAY OF BYTE?}
- BEGIN
- INC(I1);
- OutputMode:=OutByte;
- 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;
- {*****************************************************************************
- Binary File
- *****************************************************************************}
- procedure DoBinary;
- var
- Infile : File;
- Outfile : text;
- i : longint;
- begin
- Writeln('processing file : ',inname);
- { Read the file }
- assign(infile,inname);
- {$I-}
- reset(infile,1);
- {$I+}
- if ioresult<>0 then
- begin
- WriteLn('file '+inname+' not found');
- exit;
- end;
- { First parse the file and count bytes needed }
- msgsize:=FileSize(InFile);
- Getmem(msgtxt,msgsize);
- BlockRead(InFile,msgTxt[0],msgsize,i);
- close(infile);
- IF I<>msgsize THEN
- BEGIN
- Writeln('Error while reading file',inName);
- HALT(1);
- END;
- { Output }
- assign (outfile,outname);
- rewrite(outfile);
- case outputmode of
- OutByte :
- WriteByteFile(outfile,BinconstName);
- OutChar :
- WriteCharFile(outfile,BinconstName);
- OutString :
- WriteStringFile(outfile,BinconstName);
- end;
- 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(' -S array of string output');
- 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;
- OutputMode:=OutChar;
- 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' : OutputMode:=OutByte;
- 'S' : OutputMode:=OutString;
- '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
- GetPara;
- IF I_Binary THEN
- DoBinary
- ELSE
- DoFile;
- end.
|