1program bin2obj;
2{
3    This file is part of the Free Pascal run time library.
4    Copyright (c) 1999-2000 by Michael Van Canneyt, member of the
5    Free Pascal development team
6
7    Binary file to include file converter.
8
9    See the file COPYING.FPC, included in this distribution,
10    for details about the copyright.
11
12    This program is distributed in the hope that it will be useful,
13    but WITHOUT ANY WARRANTY; without even the implied warranty of
14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
15
16 **********************************************************************}
17
18{$mode objfpc}
19
20uses classes,getopts, iostream,zstream,idea,sysutils,dos;
21
22var
23  ConstName,
24  OutFileName,
25  UnitName : String;
26  WriteAsciiData,
27  CompressData,
28  EnCodeData,
29  CompileUnit,
30  WriteHex : Boolean;
31  Cryptkey : IDEAcryptKey;
32  InStream,
33  MemStream,
34  CryptStream,
35  CompStream : TStream;
36
37Procedure Usage;
38
39begin
40  Writeln ('Usage: bin2obj [options] -c constname [infile] ');
41  Writeln ('Where options is a combination of : ');
42  Writeln ('   -a        write asciii data instead of bytes');
43  Writeln ('   -x        write numerical values as hexadecimal numbers');
44  Writeln ('   -z        compress data.');
45  Writeln ('   -e key    encrypt data with key (must have 8 characters)');
46  Writeln ('   -o        output filename');
47  Writeln ('   -u [name] make a unit instead of an include file (unit name is outfile)');
48  Writeln ('   -U [name] same as -u, and compile the unit. (requires outfile)');
49  Halt(1);
50end;
51
52Procedure ProcessCommandLine;
53
54Var C : Char;
55    I : longint;
56    NeedUnitName : Boolean;
57
58begin
59  OptErr:=False;
60  ConstName:='';
61  CompressData:=False;
62  EncodeData:=False;
63  CompileUnit:=False;
64  UnitName:='';
65  NeedUnitName:=False;
66  WriteAsciiData:=False;
67  WriteHex:=False;
68  Repeat
69    c:=GetOpt('ac:e:o:zhu::U::x');
70    Case C of
71      'a' : WriteAsciiData:=True;
72      'c' : ConstName:=OptArg;
73      'h','?' : usage;
74      'z' : CompressData := True;
75      'x' : WriteHex := True;
76      'e' : begin
77            EncodeData:=True;
78            If Length(OptArg)<8 then
79              Usage;
80            For I:=0 to 7 do
81              CryptKey[i]:=Ord(OptArg[I+1]);
82            end;
83      'o' : OutFileName:=optArg;
84      'u','U':
85            begin
86            UnitName:=OptArg;
87            If Length(UnitName)=0 then
88              NeedUnitName:=True;
89            If C='U' then
90              CompileUnit:=True;
91            end;
92    end;
93  until C=EndOfOptions;
94  if ConstName='' then
95    usage;
96  If NeedUnitName then
97    If Length (OutFileName)=0 then
98      begin
99      Writeln ('Error : cannot determine unitname from filename');
100      Usage;
101      end
102    else
103      UnitName:=ExtractFileName(OutFileName);
104  if CompileUnit and (Length(OutFileName)=0) then
105    usage;
106end;
107
108Function SetupInput : TStream;
109
110begin
111  if OptInd=ParamCount then
112    InStream:=TFileStream.Create(Paramstr(Optind),fmOpenRead)
113  else
114    InStream:=TIOStream(iosInput);
115  Result:=InStream;
116end;
117
118Function SetupOutput : TStream;
119
120Var Key : ideaKey;
121
122begin
123  MemStream:=TMemoryStream.Create;
124  Result:=MemStream;
125  If ComPressData then
126    begin
127    CompStream:=TCompressionStream.Create(cldefault,Result);
128    Result:=CompStream;
129    end;
130  if EncodeData Then
131    begin
132    EnKeyIdea(CryptKey,Key);
133    CryptStream:=TIDEAEncryptStream.Create(Key,Result);
134    Result:=CryptStream;
135    end;
136end;
137
138Procedure CopyStreams (Ins,Outs : TStream);
139
140Const BufSize = 1024;
141
142Var Buffer : Array[1..BufSize] of byte;
143    Count : longint;
144
145begin
146  repeat
147     Count:=Ins.Read(Buffer,SizeOf(Buffer));
148      If Count>0 then
149       Outs.Write(Buffer,Count);
150  until Count<SizeOf(Buffer);
151  {
152    freeing these streams will flush their buffers.
153    Order is important !!!
154  }
155  CryptStream.Free;
156  CompStream.Free;
157  // Now Out stream has all data.
158end;
159
160Procedure WriteMemStream;
161
162Var OutStream : TStream;
163
164  Procedure WriteStr(Const St : String);
165
166  begin
167    OutStream.Write(St[1],Length(St));
168  end;
169
170  Procedure WriteStrLn(Const St : String);
171
172  Const
173  {$ifdef unix}
174     Eoln : String = #10;
175  {$else}
176     Eoln : String = #13#10;
177  {$endif}
178
179  begin
180    OutStream.Write(St[1],Length(St));
181    OutStream.Write(Eoln[1],Length(Eoln));
182  end;
183
184Const Prefix = '     ';
185      MaxLineLength = 72;
186
187Var I,Count  : longint;
188    b    : byte;
189    Line,ToAdd : String;
190
191begin
192  If Length(OutFileName)=0 Then
193    OutStream:=TIOStream.Create(iosOutput)
194  else
195    OutStream:=TFileStream.Create(OutFileName,fmCreate);
196  If UnitName<>'' then
197    begin
198    WriteStrLn(Format('Unit %s;',[UnitName]));
199    WriteStrLn('');
200    WriteStrLn('Interface');
201    WriteStrLn('');
202    end;
203  WriteStrLn('');
204  WriteStrLn('Const');
205  MemStream.Seek(0,soFromBeginning);
206  Count:=MemStream.Size;
207  If WriteAsciidata then
208    WriteStrLn(Format('  %s : Array[0..%d] of char = (',[ConstName,Count-1]))
209  else
210    WriteStrLn(Format('  %s : Array[0..%d] of byte = (',[ConstName,Count-1]));
211  Line:=Prefix;
212  For I:=1 to Count do
213    begin
214    MemStream.Read(B,1);
215    If Not WriteAsciiData then
216       begin
217         if WriteHex then
218           ToAdd:=Format('$%2.2x',[b])
219         else
220           ToAdd:=Format('%3d',[b]);
221       end
222    else
223      If (B in [32..127]) and not (B in [10,13,39]) then
224        ToAdd:=''''+Chr(b)+''''
225      else
226//        ToAdd:=Format('''%s''',[Chr(b)]);
227        begin
228          if WriteHex then
229            ToAdd:=Format('#$%x',[B])
230          else
231            ToAdd:=Format('#%d',[B]);
232        end;
233    If I<Count then
234      ToAdd:=ToAdd+',';
235    Line:=Line+ToAdd;
236    If Length(Line)>=MaxLineLength Then
237      begin
238      WriteStrLn(Line);
239      Line:=PreFix;
240      end;
241    end;
242  WriteStrln(Line+');');
243  If Length(UnitName)<>0 then
244    begin
245    WriteStrLn('');
246    WriteStrLn('Implementation');
247    WriteStrln('');
248    WriteStrLn('end.')
249    end;
250  MemStream.Free;
251end;
252
253Procedure CompileTheUNit;
254
255begin
256  Exec('ppc386',' -Un '+UnitName);
257end;
258
259begin
260  ProcessCommandline;
261  CopyStreams(SetupInput,SetupOutPut);
262  WriteMemStream;
263  If CompileUNit then
264    CompileTheUnit;
265end.
266