paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-08 20:38:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Modified patch from Laurent Jacques

Browse Source 
git-svn-id: trunk@11594 -
This commit is contained in:
marc 2007-07-22 15:58:44 +00:00
parent e480c8112a
commit 426359fa52
1 changed files with 95 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

166
tools/lazres.pp
View File

@ -80,89 +80,113 @@ begin
end;
var
ResourceFilename,BinFilename,BinExt,ResourceName,ResourceType:String;
ResourceFilename,FullResourceFilename,BinFilename,BinExt,ResourceName,ResourceType:String;
a:integer;
ResFileStream,BinFileStream:TFileStream;
ResMemStream,BinMemStream:TMemoryStream;
FileList:TStringList;
S: String;
begin
if ParamCount<2 then begin
writeln('Usage: ',ExtractFileName(ParamStr(0))
,' resourcefilename filename1 [filename2 ... filenameN]');
writeln(' ',ExtractFileName(ParamStr(0))
,' resourcefilename @filelist');
exit;
end;
// check that all resources exists and are not the destination file
for a:=2 to ParamCount do begin
if not FileExists(ParamStr(a)) then begin
writeln('ERROR: file not found: ',ParamStr(a));
exit;
end;
if ExpandFileName(ParamStr(a))=ExpandFileName(ParamStr(1)) then begin
writeln('ERROR: resourcefilename = file',a);
exit;
end;
end;
ResourceFilename:=ParamStr(1);
FileList:=TStringList.Create;
try
ResFileStream:=TFileStream.Create(ResourceFilename,fmCreate);
except
writeln('ERROR: unable to create file '''+ResourceFilename+'''');
halt(1);
end;
ResMemStream:=TMemoryStream.Create;
try
for a:=2 to ParamCount do begin
BinFilename:=ParamStr(a);
write(BinFilename);
try
BinFileStream:=TFileStream.Create(BinFilename,fmOpenRead);
BinMemStream:=TMemoryStream.Create;
try
BinMemStream.CopyFrom(BinFileStream,BinFileStream.Size);
BinMemStream.Position:=0;
BinExt:=uppercase(ExtractFileExt(BinFilename));
if (BinExt='.LFM') or (BinExt='.DFM') or (BinExt='.XFM') then begin
ResourceType:='FORMDATA';
ConvertFormToText(BinMemStream);
ResourceName:=FindLFMClassName(BinMemStream);
if ResourceName='' then begin
writeln(' ERROR: no resourcename');
halt(2);
end;
write(' ResourceName='''+ResourceName
+''' Type='''+ResourceType+'''');
LFMtoLRSstream(BinMemStream,ResMemStream);
end else begin
ResourceType:=copy(BinExt,2,length(BinExt)-1);
ResourceName:=ExtractFileName(BinFilename);
ResourceName:=copy(ResourceName,1
,length(ResourceName)-length(BinExt));
if ResourceName='' then begin
writeln(' ERROR: no resourcename');
halt(2);
end;
write(
' ResourceName='''+ResourceName+''' Type='''+ResourceType+'''');
BinaryToLazarusResourceCode(BinMemStream,ResMemStream
,ResourceName,ResourceType);
end;
finally
BinFileStream.Free;
BinMemStream.Free;
end;
except
writeln(' ERROR: unable to read file '''+BinFilename+'''');
halt(3);
if ParamStr(2)[1] = '@' then
begin
S := ParamStr(2);
Delete(S, 1, 1);
if not FileExists(S) then
begin
writeln('ERROR: file list not found: ', S);
exit;
end;
FileList.LoadFromFile(S);
end
else for a:=2 to ParamCount do FileList.Add(ParamStr(a));
ResourceFilename := ParamStr(1);
FullResourceFilename := ExpandFileName(ResourceFilename);
// check that all resources exists and are not the destination file
for a:=0 to FileList.Count-1 do begin
S := FileList[a];
if not FileExists(S)
then begin
writeln('ERROR: file not found: ', S);
exit;
end;
if ExpandFileName(S) = FullResourceFilename
then begin
writeln('ERROR: resourcefilename = file', a);
exit;
end;
writeln('');
end;
ResMemStream.Position:=0;
ResFileStream.CopyFrom(ResMemStream,ResMemStream.Size);
finally
ResMemStream.Free;
ResFileStream.Free;
try
ResFileStream:=TFileStream.Create(ResourceFilename,fmCreate);
except
writeln('ERROR: unable to create file ''', ResourceFilename, '''');
halt(1);
end;
ResMemStream:=TMemoryStream.Create;
try
for a:=0 to FileList.Count-1 do begin
BinFilename:=FileList[a];
write(BinFilename);
try
BinFileStream:=TFileStream.Create(BinFilename,fmOpenRead);
BinMemStream:=TMemoryStream.Create;
try
BinMemStream.CopyFrom(BinFileStream,BinFileStream.Size);
BinMemStream.Position:=0;
BinExt:=uppercase(ExtractFileExt(BinFilename));
if (BinExt='.LFM') or (BinExt='.DFM') or (BinExt='.XFM')
then begin
ResourceType:='FORMDATA';
ConvertFormToText(BinMemStream);
ResourceName:=FindLFMClassName(BinMemStream);
if ResourceName='' then begin
writeln(' ERROR: no resourcename');
halt(2);
end;
write(' ResourceName=''', ResourceName, ''' Type=''', ResourceType, '''');
LFMtoLRSstream(BinMemStream,ResMemStream);
end
else begin
ResourceType:=copy(BinExt,2,length(BinExt)-1);
ResourceName:=ExtractFileName(BinFilename);
ResourceName:=copy(ResourceName,1
,length(ResourceName)-length(BinExt));
if ResourceName='' then begin
writeln(' ERROR: no resourcename');
halt(2);
end;
write(' ResourceName=''', ResourceName, ''' Type=''', ResourceType+'''');
BinaryToLazarusResourceCode(BinMemStream,ResMemStream
,ResourceName,ResourceType);
end;
finally
BinFileStream.Free;
BinMemStream.Free;
end;
except
writeln(' ERROR: unable to read file ''', BinFilename, '''');
halt(3);
end;
writeln('');
end;
ResMemStream.Position:=0;
ResFileStream.CopyFrom(ResMemStream,ResMemStream.Size);
finally
ResMemStream.Free;
ResFileStream.Free;
end;
finally
FileList.Free;
end;
end.