1{ 2 *************************************************************************** 3 * * 4 * This source is free software; you can redistribute it and/or modify * 5 * it under the terms of the GNU General Public License as published by * 6 * the Free Software Foundation; either version 2 of the License, or * 7 * (at your option) any later version. * 8 * * 9 * This code is distributed in the hope that it will be useful, but * 10 * WITHOUT ANY WARRANTY; without even the implied warranty of * 11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * 12 * General Public License for more details. * 13 * * 14 * A copy of the GNU General Public License is available on the World * 15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also * 16 * obtain it by writing to the Free Software Foundation, * 17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * 18 * * 19 *************************************************************************** 20 21 Author: Mattias Gaertner 22 23 Name: 24 lazres - creates an lazarus resource file from files 25 26 Synopsis: 27 lazres resourcefilename filename1 [filename2 ... filenameN] 28 lazres resourcefilename @filelist 29 30 Description: 31 lazres creates a lazarus resource file from files. 32 33} 34program LazRes; 35 36{$mode objfpc}{$H+} 37 38{$IF FPC_FULLVERSION>=30301} 39{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined} 40{$ENDIF} 41 42uses 43 Classes, SysUtils, LazLogger, LResources, resource, reswriter, 44 bitmapresource, groupresource, groupiconresource, groupcursorresource, 45 LazFileUtils, LazUTF8; 46 47type 48 TOutputFileType = (ftLrs, ftRc, ftRes); 49 50procedure ConvertFormToText(Stream: TMemoryStream); 51var 52 TextStream: TMemoryStream; 53begin 54 try 55 try 56 TextStream := TMemoryStream.Create; 57 FormDataToText(Stream, TextStream); 58 TextStream.Position := 0; 59 Stream.Clear; 60 Stream.CopyFrom(TextStream, TextStream.Size); 61 Stream.Position := 0; 62 except 63 on E: Exception do 64 begin 65 debugln('ERROR: unable to convert Delphi form to text: '+E.Message); 66 end; 67 end; 68 finally 69 TextStream.Free; 70 end; 71end; 72 73// lrs generation 74 75procedure OutputLRSFile(BinFilename, ResourceName: String; ResMemStream: TMemoryStream); 76var 77 BinExt,ResourceType: String; 78 BinFileStream: TFileStream; 79 BinMemStream: TMemoryStream; 80begin 81 dbgout(BinFilename); 82 try 83 BinFileStream:=TFileStream.Create(BinFilename,fmOpenRead); 84 BinMemStream:=TMemoryStream.Create; 85 try 86 BinMemStream.CopyFrom(BinFileStream,BinFileStream.Size); 87 BinMemStream.Position:=0; 88 BinExt:=uppercase(ExtractFileExt(BinFilename)); 89 if (BinExt='.LFM') or (BinExt='.DFM') or (BinExt='.XFM') 90 then begin 91 ResourceType:='FORMDATA'; 92 ConvertFormToText(BinMemStream); 93 ResourceName:=FindLFMClassName(BinMemStream); 94 if ResourceName='' then begin 95 debugln(' ERROR: no resourcename'); 96 halt(2); 97 end; 98 dbgout(' ResourceName=''', ResourceName, ''' Type=''', ResourceType, ''''); 99 LFMtoLRSstream(BinMemStream,ResMemStream); 100 end 101 else begin 102 ResourceType := trim(copy(BinExt,2,length(BinExt)-1)); 103 if ResourceName='' then begin 104 ResourceName := ExtractFileName(BinFilename); 105 ResourceName := trim(copy(ResourceName,1 106 ,length(ResourceName)-length(BinExt))); 107 end; 108 if ResourceName='' then begin 109 debugln(' ERROR: no resourcename'); 110 halt(2); 111 end; 112 dbgout(' ResourceName=''', ResourceName, ''' Type=''', ResourceType+''''); 113 BinaryToLazarusResourceCode(BinMemStream,ResMemStream 114 ,ResourceName,ResourceType); 115 end; 116 finally 117 BinFileStream.Free; 118 BinMemStream.Free; 119 end; 120 except 121 debugln(' ERROR: unable to read file ''', BinFilename, ''''); 122 halt(3); 123 end; 124 debugln(''); 125end; 126 127// rc generation 128 129procedure OutputRCFile(FileName, ResourceName: String; ResMemStream: TMemoryStream); 130 131 procedure WriteResource(ResourceType: String); 132 var 133 S: String; 134 begin 135 S := Format('%s %s "%s"'#$D#$A, [ResourceName, ResourceType, FileName]); 136 ResMemStream.Write(PChar(@S[1])^, Length(S)); 137 end; 138 139var 140 FileExt: String; 141begin 142 FileExt := UpperCase(ExtractFileExt(FileName)); 143 if ResourceName = '' then 144 begin 145 ResourceName := ExtractFileName(FileName); 146 ResourceName := Trim(Copy(ResourceName, 1, Length(ResourceName) - Length(FileExt))); 147 end; 148 case FileExt of 149 '.BMP': WriteResource('BITMAP'); 150 '.CUR': WriteResource('CURSOR'); 151 '.ICO': WriteResource('ICON'); 152 else 153 WriteResource('RCDATA'); 154 end; 155end; 156 157// Res generation 158type 159 TGroupResourceClass = class of TGroupResource; 160 161procedure AddResource(FileName, ResourceName: String; Resources: TResources); 162var 163 FileExt: String; 164 165 function GetResourceStream: TMemoryStream; 166 var 167 FS: TFileStream; 168 begin 169 FS := TFileStream.Create(FileName, fmOpenRead); 170 Result := TMemoryStream.Create; 171 try 172 Result.CopyFrom(FS, FS.Size); 173 Result.Position:=0; 174 if (FileExt = '.LFM') or (FileExt = '.DFM') or (FileExt = '.XFM') or (FileExt = '.FMX') then 175 begin 176 ConvertFormToText(Result); 177 ResourceName := FindLFMClassName(Result); 178 if ResourceName = '' then 179 begin 180 debugln(' ERROR: no resourcename'); 181 halt(2); 182 end; 183 end 184 finally 185 FS.Free; 186 end; 187 end; 188 189 procedure AddBitmapResource; 190 var 191 Desc: TResourceDesc; 192 Res: TBitmapResource; 193 ResStream: TStream; 194 begin 195 Desc := TResourceDesc.Create(ResourceName); 196 Res := TBitmapResource.Create(nil, Desc); 197 Desc.Free; 198 ResStream := GetResourceStream; 199 try 200 if Assigned(ResStream) then 201 Res.BitmapData.CopyFrom(ResStream, ResStream.Size) 202 else 203 Res.BitmapData.Size:=0; 204 finally 205 ResStream.Free; 206 end; 207 Resources.Add(Res); 208 dbgout(' ResourceName=''', ResourceName, ''' Type=RT_BITMAP'); 209 end; 210 211 procedure AddGroupResource(GroupResourceClass: TGroupResourceClass); 212 var 213 Desc: TResourceDesc; 214 Res: TGroupResource; 215 ResStream: TStream; 216 begin 217 Desc := TResourceDesc.Create(ResourceName); 218 Res := GroupResourceClass.Create(nil, Desc); 219 Desc.Free; 220 ResStream := GetResourceStream; 221 try 222 if Assigned(ResStream) then 223 Res.ItemData.CopyFrom(ResStream, ResStream.Size) 224 else 225 Res.ItemData.Size:=0; 226 finally 227 ResStream.Free; 228 end; 229 Resources.Add(Res); 230 if Res._Type.ID = RT_GROUP_ICON then 231 dbgout(' ResourceName=''', ResourceName, ''' Type=RT_GROUP_ICON') 232 else 233 dbgout(' ResourceName=''', ResourceName, ''' Type=RT_GROUP_CURSOR'); 234 end; 235 236 procedure AddRCDataResource; 237 var 238 TypeDesc, NameDesc: TResourceDesc; 239 Res: TGenericResource; 240 ResStream: TStream; 241 begin 242 TypeDesc := TResourceDesc.Create(RT_RCDATA); 243 NameDesc := TResourceDesc.Create(ResourceName); 244 Res := TGenericResource.Create(TypeDesc, NameDesc); 245 TypeDesc.Free; 246 NameDesc.Free; 247 ResStream := GetResourceStream; 248 try 249 if Assigned(ResStream) then 250 Res.RawData.CopyFrom(ResStream, ResStream.Size) 251 else 252 Res.RawData.Size:=0; 253 finally 254 ResStream.Free; 255 end; 256 Resources.Add(Res); 257 dbgout(' ResourceName=''', ResourceName, ''' Type=RT_RCDATA'); 258 end; 259 260begin 261 dbgout(FileName); 262 FileExt := UpperCase(ExtractFileExt(FileName)); 263 if ResourceName = '' then 264 begin 265 ResourceName := ExtractFileName(FileName); 266 ResourceName := Trim(Copy(ResourceName, 1, Length(ResourceName) - Length(FileExt))); 267 end; 268 case FileExt of 269 '.BMP': AddBitmapResource; 270 '.CUR': AddGroupResource(TGroupCursorResource); 271 '.ICO': AddGroupResource(TGroupIconResource); 272 else 273 AddRCDataResource; 274 end; 275 debugln(''); 276end; 277 278procedure OutputResFile(FileList: TStringList; ResMemStream: TMemoryStream); 279var 280 Writer: TResResourceWriter; 281 Resources: TResources; 282 I: Integer; 283begin 284 Resources := TResources.Create; 285 Writer := TResResourceWriter.Create; 286 try 287 for I := 0 to FileList.Count - 1 do 288 AddResource(FileList.Names[I], Trim(FileList.ValueFromIndex[I]), Resources); 289 Resources.WriteToStream(ResMemStream, Writer); 290 finally 291 Writer.Free; 292 Resources.Free;; 293 end; 294end; 295 296var 297 a: Integer; 298 ResourceFilename,FullResourceFilename:String; 299 ResFileStream:TFileStream; 300 ResMemStream:TMemoryStream; 301 FileList:TStringList; 302 S: String; 303 OutputFileType: TOutputFileType; 304begin 305 if ParamCount<2 then begin 306 debugln('Usage: ',ExtractFileName(ParamStrUTF8(0)) 307 ,' resourcefilename filename1[=resname1] [filename2[=resname2] ... filenameN=resname[N]]'); 308 debugln(' ',ExtractFileName(ParamStrUTF8(0)) 309 ,' resourcefilename @filelist'); 310 exit; 311 end; 312 FileList:=TStringList.Create; 313 try 314 if ParamStrUTF8(2)[1] = '@' then 315 begin 316 S := ParamStrUTF8(2); 317 Delete(S, 1, 1); 318 S := ExpandFileNameUTF8(S); 319 if not FileExistsUTF8(S) then 320 begin 321 debugln('ERROR: file list not found: ',S); 322 exit; 323 end; 324 FileList.LoadFromFile(S); 325 for a:=FileList.Count-1 downto 0 do 326 if FileList[a]='' then 327 FileList.Delete(a); 328 end 329 else for a:=2 to ParamCount do FileList.Add(ParamStrUTF8(a)); 330 // cleanup lines 331 for a:=fileList.Count-1 downto 0 do begin 332 s := Trim(filelist[a]); 333 if (s='') or (s[1]='#') then begin 334 filelist.Delete(a); 335 continue; 336 end; 337 filelist[a] := s; 338 if filelist.Names[a]='' then 339 filelist[a] := filelist[a] + '='; 340 end; 341 ResourceFilename := ParamStrUTF8(1); 342 FullResourceFilename := ExpandFileNameUTF8(ResourceFilename); 343 // check that all resources exists and are not the destination file 344 for a:=0 to FileList.Count-1 do begin 345 S := FileList.Names[a]; 346 if not FileExistsUTF8(S) 347 then begin 348 debugln('ERROR: file not found: ', S); 349 exit; 350 end; 351 if ExpandFileNameUTF8(S) = FullResourceFilename 352 then begin 353 debugln(['ERROR: resourcefilename = file', a]); 354 exit; 355 end; 356 end; 357 358 try 359 ResFileStream:=TFileStream.Create(ResourceFilename,fmCreate); 360 except 361 debugln('ERROR: unable to create file ''', ResourceFilename, ''''); 362 halt(1); 363 end; 364 case LowerCase(ExtractFileExt(ResourceFilename)) of 365 '.rc': OutputFileType := ftRc; 366 '.res': OutputFileType := ftRes; 367 else 368 OutputFileType := ftLrs; 369 end; 370 ResMemStream := TMemoryStream.Create; 371 try 372 if OutputFileType in [ftRc, ftLrs] then 373 begin 374 for a := 0 to FileList.Count - 1 do 375 begin 376 if OutputFileType = ftRc then 377 OutputRCFile(FileList.Names[a], trim(FileList.ValueFromIndex[a]), ResMemStream) 378 else 379 OutputLRSFile(FileList.Names[a], trim(FileList.ValueFromIndex[a]), ResMemStream); 380 end; 381 end 382 else 383 OutputResFile(FileList, ResMemStream); 384 ResMemStream.Position := 0; 385 ResFileStream.CopyFrom(ResMemStream, ResMemStream.Size); 386 finally 387 ResMemStream.Free; 388 ResFileStream.Free; 389 end; 390 finally 391 FileList.Free; 392 end; 393end. 394 395