* initial version

utils/data2inc.exm

@@ -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.
+
+

utils/data2inc.pp

@@ -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 : [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 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
+
+}