mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-17 02:59:13 +02:00
+ -s for string writing
* some small cleanups
This commit is contained in:
peter
parent
8049831c3f
commit
cebc42c1e4
@ -28,14 +28,6 @@
|
|||||||
An arbitrary binary file can get converted to constants. In this mode
|
An arbitrary binary file can get converted to constants. In this mode
|
||||||
only one constant per include file is possible.
|
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,
|
This program is distributed in the hope that it will be useful,
|
||||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||||
@ -47,11 +39,15 @@ uses strings;
|
|||||||
CONST
|
CONST
|
||||||
version='0.99.13';
|
version='0.99.13';
|
||||||
|
|
||||||
{ ************
|
maxbufsize = 1024*1024; { 1 mb buffer }
|
||||||
|
|
||||||
Simple service routines. These are copied from EPasStr.
|
type
|
||||||
The program doesn't use EPasStr, because I want it to function
|
TOutputMode=(OutByte,OutChar,OutString);
|
||||||
BEFORE EPasStr is compiled, and distributable without XTDFPC.}
|
|
||||||
|
|
||||||
|
{*****************************************************************************
|
||||||
|
Simple service routines. These are copied from EPasStr.
|
||||||
|
*****************************************************************************}
|
||||||
|
|
||||||
TYPE CHARSET=SET OF CHAR;
|
TYPE CHARSET=SET OF CHAR;
|
||||||
|
|
||||||
@ -145,7 +141,9 @@ BEGIN
|
|||||||
END;
|
END;
|
||||||
|
|
||||||
|
|
||||||
{---- End EPasStr routines ----}
|
{*****************************************************************************
|
||||||
|
Parsing helpers
|
||||||
|
*****************************************************************************}
|
||||||
|
|
||||||
FUNCTION XlatString(Var S : String):BOOLEAN;
|
FUNCTION XlatString(Var S : String):BOOLEAN;
|
||||||
{replaces \xxx in string S with #x, and \\ with \ (escaped)
|
{replaces \xxx in string S with #x, and \\ with \ (escaped)
|
||||||
@ -222,18 +220,20 @@ END;
|
|||||||
{Global equates}
|
{Global equates}
|
||||||
|
|
||||||
VAR
|
VAR
|
||||||
Inname, {Name of input file}
|
Inname, { Name of input file }
|
||||||
OutName, {Name of output (.inc) file}
|
OutName, { Name of output (.inc) file }
|
||||||
BinConstName: string; {(-b only) commandline name of constant}
|
BinConstName : string; { (-b only) commandline name of constant }
|
||||||
ArrayByte, {TRUE when output of ARRAY OF BYTE is desired
|
OutputMode : TOutputMode; { Output mode (char,byte,string) }
|
||||||
ARRAY OF CHAR otherwise}
|
I_Binary : BOOLEAN; { TRUE is binary input, FALSE textual }
|
||||||
I_Binary : BOOLEAN; {TRUE is binary input, FALSE textual}
|
MsgTxt : pchar; { Temporary storage of data }
|
||||||
MsgTxt : pchar; {Temporary storage of data}
|
msgsize : longint; { Bytes used in MsgTxt }
|
||||||
msgsize : longint; {Bytes used in MsgTxt}
|
C : CHAR;
|
||||||
maxbufsize : LONGINT; {Bytes allocated for MsgTxt}
|
|
||||||
C : CHAR;
|
|
||||||
|
|
||||||
|
|
||||||
|
{*****************************************************************************
|
||||||
|
WriteCharFile
|
||||||
|
*****************************************************************************}
|
||||||
|
|
||||||
{Dump the contents of MsgTxt (msgsize bytes) to file T (which has been opened),
|
{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}
|
using CONSTNAME as the name of the ARRAY OF CHAR constant}
|
||||||
procedure WriteCharFile(var t:text;constname:string);
|
procedure WriteCharFile(var t:text;constname:string);
|
||||||
@ -280,6 +280,11 @@ begin
|
|||||||
Writeln(T);
|
Writeln(T);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{*****************************************************************************
|
||||||
|
WriteByteFile
|
||||||
|
*****************************************************************************}
|
||||||
|
|
||||||
{Dump the contents of MsgTxt (msgsize bytes) to file T (which has been opened),
|
{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}
|
using CONSTNAME as the name of the ARRAY OF BYTE constant}
|
||||||
procedure WriteByteFile(var t:text;constname:string);
|
procedure WriteByteFile(var t:text;constname:string);
|
||||||
@ -302,7 +307,6 @@ procedure WriteByteFile(var t:text;constname:string);
|
|||||||
var
|
var
|
||||||
cidx,i : longint;
|
cidx,i : longint;
|
||||||
p : pchar;
|
p : pchar;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Writeln('Writing constant: ',constname,' to file '#39,outname,#39);
|
Writeln('Writing constant: ',constname,' to file '#39,outname,#39);
|
||||||
{Open textfile}
|
{Open textfile}
|
||||||
@ -333,6 +337,113 @@ begin
|
|||||||
Writeln(T);
|
Writeln(T);
|
||||||
end;
|
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 div maxslen,'] of string[',maxslen,']=(');
|
||||||
|
writeln(t,'{$else Delphi}');
|
||||||
|
writeln(t,'const '+constname+' : array[0..',msgsize 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;
|
FUNCTION SpecialItem(S : String):LONGINT;
|
||||||
{ This procedure finds the next comma, (or the end of the string)
|
{ This procedure finds the next comma, (or the end of the string)
|
||||||
but comma's within single or double quotes should be ignored.
|
but comma's within single or double quotes should be ignored.
|
||||||
@ -355,6 +466,7 @@ BEGIN
|
|||||||
SpecialItem:=DataItem;
|
SpecialItem:=DataItem;
|
||||||
END;
|
END;
|
||||||
|
|
||||||
|
|
||||||
{ Handles reading and processing of a textual file}
|
{ Handles reading and processing of a textual file}
|
||||||
procedure DoFile;
|
procedure DoFile;
|
||||||
var
|
var
|
||||||
@ -367,165 +479,162 @@ var
|
|||||||
current DATA-item being processed }
|
current DATA-item being processed }
|
||||||
VarName : String; { Variable name of constant to be written}
|
VarName : String; { Variable name of constant to be written}
|
||||||
|
|
||||||
PROCEDURE ParseError;
|
PROCEDURE ParseError;
|
||||||
{Extremely simple errorhandler}
|
{Extremely simple errorhandler}
|
||||||
|
BEGIN
|
||||||
|
Writeln('Error in line : ',Line, ' Somewhere near :',#39,S1,#39);
|
||||||
|
Close(InfIle); Close(Outfile);
|
||||||
|
HALT;
|
||||||
|
END;
|
||||||
|
|
||||||
BEGIN
|
PROCEDURE FixDec;
|
||||||
Writeln('Error in line : ',Line, ' Somewhere near :',#39,S1,#39);
|
{ Reads decimal value starting at S1[1].
|
||||||
Close(InfIle); Close(Outfile);
|
Value in I3, number of digits found in I1}
|
||||||
HALT;
|
BEGIN
|
||||||
END;
|
I1:=1;
|
||||||
|
WHILE ((S1[I1]>#47) AND (S1[I1]<#58)) AND (I1<=Length(S1)) DO
|
||||||
PROCEDURE FixDec;
|
INC(I1);
|
||||||
{ Reads decimal value starting at S1[1].
|
DEC(I1);
|
||||||
Value in I3, number of digits found in I1}
|
IF I1=0 THEN
|
||||||
|
ParseError;
|
||||||
BEGIN
|
I3:=0;
|
||||||
I1:=1;
|
FOR I2:=1 TO I1 DO
|
||||||
WHILE ((S1[I1]>#47) AND (S1[I1]<#58)) AND (I1<=Length(S1)) DO
|
I3:=(I3*10)+ ORD(S1[I2])-48;
|
||||||
INC(I1);
|
{Calc no of bytes(1,2 or 4) required from no of digits found}
|
||||||
DEC(I1);
|
IF (I1<3) THEN
|
||||||
IF I1=0 THEN
|
I2:=1
|
||||||
ParseError;
|
ELSE
|
||||||
I3:=0;
|
IF (I1=3) AND (I3<256) THEN
|
||||||
FOR I2:=1 TO I1 DO
|
I2:=1
|
||||||
I3:=(I3*10)+ ORD(S1[I2])-48;
|
ELSE
|
||||||
|
BEGIN
|
||||||
{Calc no of bytes(1,2 or 4) required from no of digits found}
|
IF I1<5 THEN
|
||||||
|
|
||||||
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
|
I2:=2
|
||||||
ELSE
|
ELSE
|
||||||
I2:=4;
|
IF (I1=5) AND (i3<65536) THEN
|
||||||
END;
|
I2:=2
|
||||||
END;
|
ELSE
|
||||||
|
I2:=4;
|
||||||
PROCEDURE DoChar;
|
END;
|
||||||
{ 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;
|
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;
|
PROCEDURE DoChar;
|
||||||
{ processes aggregates of textual data like 'xxx'+#39"2143124"+'1234'#123}
|
{ Reads a #xxx constant at S1[1], and puts it in msgtxt array.
|
||||||
|
Deletes #xxx constant from S1}
|
||||||
BEGIN
|
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);
|
Delete(S1,1,1);
|
||||||
LTrim(S1,' ');
|
FixDec;
|
||||||
UNTIL Length(S1)=0;
|
msgtxt[Msgsize]:=CHR(I3);
|
||||||
END;
|
inc(msgsize);
|
||||||
|
Delete(S1,1,I1);
|
||||||
PROCEDURE FlushMsgTxt; {Flush MsgTxt array}
|
END;
|
||||||
BEGIN
|
|
||||||
IF msgsize>0 THEN {In memory? Then flush}
|
PROCEDURE DoQuote;
|
||||||
BEGIN
|
{ Reads a quoted text-string ('xxx' or "xxx"). Quotechar is in S1[1]
|
||||||
IF ArrayByte THEN
|
(always ' or "), any char except the quotechar is allowed between two
|
||||||
WriteByteFile(outfile,Varname)
|
quotechars.
|
||||||
ELSE
|
Deletes quoted textstring incl quotes from S1}
|
||||||
WriteCharFile(outfile,varname);
|
VAR
|
||||||
msgsize:=0;
|
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;
|
END;
|
||||||
END;
|
|
||||||
|
|
||||||
{Actual DoFile}
|
{Actual DoFile}
|
||||||
begin
|
begin
|
||||||
@ -538,12 +647,10 @@ begin
|
|||||||
{$I+}
|
{$I+}
|
||||||
if ioresult<>0 then
|
if ioresult<>0 then
|
||||||
begin
|
begin
|
||||||
WriteLn('*** message file '+inname+' not found ***');
|
WriteLn('file '+inname+' not found');
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{Create output file}
|
{Create output file}
|
||||||
|
|
||||||
assign (outfile,outname);
|
assign (outfile,outname);
|
||||||
rewrite(outfile);
|
rewrite(outfile);
|
||||||
msgsize:=0;
|
msgsize:=0;
|
||||||
@ -572,7 +679,6 @@ begin
|
|||||||
CASE S1[1] OF {Select field type}
|
CASE S1[1] OF {Select field type}
|
||||||
#39,'"','#' : DoTextual; { handles textual aggregates
|
#39,'"','#' : DoTextual; { handles textual aggregates
|
||||||
e.g. #124"142"#123'sdgf''ads'}
|
e.g. #124"142"#123'sdgf''ads'}
|
||||||
|
|
||||||
'$' : BEGIN {Handle $xxxx hex codes}
|
'$' : BEGIN {Handle $xxxx hex codes}
|
||||||
Delete(S1,1,1);
|
Delete(S1,1,1);
|
||||||
RTrim(S1,' ');
|
RTrim(S1,' ');
|
||||||
@ -635,11 +741,11 @@ begin
|
|||||||
BEGIN
|
BEGIN
|
||||||
FlushMsgTxt;
|
FlushMsgTxt;
|
||||||
I1:=1;
|
I1:=1;
|
||||||
ArrayByte:=FALSE;
|
OutputMode:=OutChar;
|
||||||
IF S[2]='$' THEN {Flag for ARRAY OF BYTE?}
|
IF S[2]='$' THEN {Flag for ARRAY OF BYTE?}
|
||||||
BEGIN
|
BEGIN
|
||||||
INC(I1);
|
INC(I1);
|
||||||
ArrayByte:=TRUE;
|
OutputMode:=OutByte;
|
||||||
END;
|
END;
|
||||||
Delete(S,1,I1);
|
Delete(S,1,I1);
|
||||||
VarName:=S;
|
VarName:=S;
|
||||||
@ -659,6 +765,10 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{*****************************************************************************
|
||||||
|
Binary File
|
||||||
|
*****************************************************************************}
|
||||||
|
|
||||||
procedure DoBinary;
|
procedure DoBinary;
|
||||||
var
|
var
|
||||||
Infile : File;
|
Infile : File;
|
||||||
@ -666,34 +776,37 @@ var
|
|||||||
i : longint;
|
i : longint;
|
||||||
begin
|
begin
|
||||||
Writeln('processing file : ',inname);
|
Writeln('processing file : ',inname);
|
||||||
{Read the message file}
|
{ Read the file }
|
||||||
assign(infile,inname);
|
assign(infile,inname);
|
||||||
{$I-}
|
{$I-}
|
||||||
reset(infile,1);
|
reset(infile,1);
|
||||||
{$I+}
|
{$I+}
|
||||||
if ioresult<>0 then
|
if ioresult<>0 then
|
||||||
begin
|
begin
|
||||||
WriteLn('*** message file '+inname+' not found ***');
|
WriteLn('file '+inname+' not found');
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
assign (outfile,outname);
|
|
||||||
rewrite(outfile);
|
|
||||||
{ First parse the file and count bytes needed }
|
{ First parse the file and count bytes needed }
|
||||||
msgsize:=FileSize(InFile);
|
msgsize:=FileSize(InFile);
|
||||||
IF Msgsize>1048576 THEN
|
|
||||||
msgsize:=1048576;
|
|
||||||
Getmem(msgtxt,msgsize);
|
Getmem(msgtxt,msgsize);
|
||||||
BlockRead(InFile,msgTxt[0],msgsize,i);
|
BlockRead(InFile,msgTxt[0],msgsize,i);
|
||||||
|
close(infile);
|
||||||
IF I<>msgsize THEN
|
IF I<>msgsize THEN
|
||||||
BEGIN
|
BEGIN
|
||||||
Writeln('Error while reading file',inName);
|
Writeln('Error while reading file',inName);
|
||||||
HALT(1);
|
HALT(1);
|
||||||
END;
|
END;
|
||||||
IF ArrayByte THEN
|
{ Output }
|
||||||
WriteByteFile(outfile,BinconstName)
|
assign (outfile,outname);
|
||||||
ELSE
|
rewrite(outfile);
|
||||||
WriteCharFile(outfile,BinconstName);
|
case outputmode of
|
||||||
close(infile);
|
OutByte :
|
||||||
|
WriteByteFile(outfile,BinconstName);
|
||||||
|
OutChar :
|
||||||
|
WriteCharFile(outfile,BinconstName);
|
||||||
|
OutString :
|
||||||
|
WriteStringFile(outfile,BinconstName);
|
||||||
|
end;
|
||||||
Close(Outfile);
|
Close(Outfile);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -717,6 +830,7 @@ var
|
|||||||
writeln('<Options> can be :');
|
writeln('<Options> can be :');
|
||||||
writeln(' -B File to read is binary.');
|
writeln(' -B File to read is binary.');
|
||||||
writeln(' -A array of byte output (default is array of char)');
|
writeln(' -A array of byte output (default is array of char)');
|
||||||
|
writeln(' -S array of string output');
|
||||||
writeln(' -V Show version');
|
writeln(' -V Show version');
|
||||||
writeln(' -? or -H This HelpScreen');
|
writeln(' -? or -H This HelpScreen');
|
||||||
writeln;
|
writeln;
|
||||||
@ -727,7 +841,7 @@ var
|
|||||||
|
|
||||||
begin
|
begin
|
||||||
I_binary:=FALSE;
|
I_binary:=FALSE;
|
||||||
ArrayByte:=FALSE;
|
OutputMode:=OutChar;
|
||||||
FIles:=0;
|
FIles:=0;
|
||||||
for i:=1to paramcount do
|
for i:=1to paramcount do
|
||||||
begin
|
begin
|
||||||
@ -738,7 +852,8 @@ begin
|
|||||||
delete(para,1,2);
|
delete(para,1,2);
|
||||||
case ch of
|
case ch of
|
||||||
'B' : I_Binary:=TRUE;
|
'B' : I_Binary:=TRUE;
|
||||||
'A' : Arraybyte:=TRUE;
|
'A' : OutputMode:=OutByte;
|
||||||
|
'S' : OutputMode:=OutString;
|
||||||
'V' : begin
|
'V' : begin
|
||||||
Writeln('Data2Inc ',version,' (C) 1999 Peter Vreman and Marco van de Voort');
|
Writeln('Data2Inc ',version,' (C) 1999 Peter Vreman and Marco van de Voort');
|
||||||
Writeln;
|
Writeln;
|
||||||
@ -767,17 +882,19 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
MaxBufSize:=100000;
|
GetPara;
|
||||||
GetPara;
|
IF I_Binary THEN
|
||||||
|
DoBinary
|
||||||
IF I_Binary THEN
|
ELSE
|
||||||
DoBinary
|
DoFile;
|
||||||
ELSE
|
|
||||||
DoFile;
|
|
||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.1 1999-11-09 14:40:50 peter
|
Revision 1.2 1999-11-23 09:42:18 peter
|
||||||
|
+ -s for string writing
|
||||||
|
* some small cleanups
|
||||||
|
|
||||||
|
Revision 1.1 1999/11/09 14:40:50 peter
|
||||||
* initial version
|
* initial version
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user