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