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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
18 *                                                                         *
19 ***************************************************************************
20
21  Author: Mattias Gaertner
22
23  Name:
24       lrstolfm - shows the lfm contents of a lrs file.
25
26  Synopsis:
27       lrstolfm resourcefilename [resourcename]
28
29  Description:
30       lrstolfm reads the given lrs file. If resource name is given as second
31       parameter this resource is searched, otherwise the first entry.
32}
33program lrstolfm;
34
35{$mode objfpc}{$H+}
36
37uses
38  Classes, SysUtils, LResources;
39
40procedure FindResourceInLRS(List: TStrings; var ResourceName: string; var Index: Integer; out ResType: String);
41const
42  Pattern = 'LazarusResources.Add(''';
43var
44  Line,
45  ResName: String;
46begin
47  while (Index < List.Count) do
48  begin
49    Line := List[Index];
50    if (Length(Line) > Length(Pattern)) and
51       (Pos(Pattern, Line) = 1) then
52    begin
53      Delete(Line, 1, Length(Pattern));
54      ResName := Copy(Line, 1, Pos(''',''', Line) - 1);
55      if (ResourceName <> '') and (ResName <> ResourceName) then
56        Continue;
57      ResourceName := ResName;
58      Delete(Line, 1, Length(ResName) + 3);
59      ResType := Copy(Line, 1, Pos(''',[', Line) - 1);
60      Exit;
61    end;
62    Inc(Index);
63  end;
64  Index := -1;
65end;
66
67function ExtractResource(LRS: TStrings; var Index: integer): TMemoryStream;
68var
69  p: Integer;
70  Line: string;
71  StartPos: LongInt;
72  CharID: Integer;
73  c: Char;
74begin
75  Result:=TMemoryStream.Create;
76  inc(Index);
77  while (Index < LRS.Count) do
78  begin
79    Line := LRS[Index];
80    if (Line<>'') and (Line[1]=']') then exit;// found the end of this resource
81    p := 1;
82    while (p <= length(Line)) do
83    begin
84      case Line[p] of
85      '''':
86        // string constant
87        begin
88          inc(p);
89          while p<=length(Line) do
90          begin
91            if Line[p]<>'''' then
92            begin
93              // read normal characters
94              StartPos:=p;
95              while (p<=length(Line)) and (Line[p]<>'''') do inc(p);
96              Result.Write(Line[StartPos],p-StartPos);
97            end else if (p<length(Line)) and (Line[p+1]='''') then begin
98              // read '
99              Result.Write(Line[p],1);
100              inc(p,2);
101            end else begin
102              // end of string constant found
103              inc(p);
104              break;
105            end;
106          end;
107        end;
108      '#':
109        // special character
110        begin
111          inc(p);
112          CharID:=0;
113          while (p<=length(Line)) and (Line[p] in ['0'..'9']) do begin
114            CharID:=CharID*10+ord(Line[p])-ord('0');
115            inc(p);
116          end;
117          c:=chr(CharID);
118          Result.Write(c,1);
119        end;
120      else
121        inc(p);
122      end;
123    end;
124    inc(Index);
125  end;
126end;
127
128var
129  LRSFilename, ResText,
130  ResourceName, ResourceType: String;
131  ResourceHeader: LongInt;
132  LRS: TStringList;
133  ObjResource, TextResource: TMemoryStream;
134  FileStream: TFileStream;
135begin
136  if (ParamCount < 1) or (ParamCount > 2) then
137  begin
138    WriteLn('Usage: ', ExtractFileName(ParamStr(0)), ' resourcefilename [resourcename]');
139    Exit;
140  end;
141  LRSFilename := ParamStr(1);
142  ResourceName := '';
143  if ParamCount >= 2 then
144    ResourceName := ParamStr(2);
145  LRS := TStringList.Create;
146  LRS.LoadFromFile(LRSFilename);
147  ResourceHeader := 0;
148
149  if ResourceName = '@' then
150  begin
151    while True do
152    begin
153      // find resource
154      ResourceName := '';
155      FindResourceInLRS(LRS, ResourceName, ResourceHeader, ResourceType);
156      if ResourceHeader < 0 then
157        break;
158      ObjResource := ExtractResource(LRS, ResourceHeader);
159      ObjResource.Position := 0;
160      FileStream := TFileStream.Create(ResourceName + '.' + ResourceType, fmCreate);
161      try
162        FileStream.CopyFrom(ObjResource, ObjResource.Size);
163      finally
164        FileStream.Free;
165      end;
166      ObjResource.Free;
167    end;
168  end
169  else
170  begin
171    // find resource
172    FindResourceInLRS(LRS, ResourceName, ResourceHeader, ResourceType);
173    if ResourceHeader < 0 then
174      raise Exception.Create('Resource not found: ' + ResourceName);
175
176    // convert lrs format to binary format
177    ObjResource := ExtractResource(LRS, ResourceHeader);
178    ObjResource.Position := 0;
179
180    // convert binary format to lfm format
181    TextResource := TMemoryStream.Create;
182    LRSObjectBinaryToText(ObjResource, TextResource);
183
184    // write to stdout
185    TextResource.Position := 0;
186    SetLength(ResText, TextResource.Size);
187    TextResource.Read(ResText[1], Length(ResText));
188    Write(ResText);
189
190    TextResource.Free;
191    ObjResource.Free;
192  end;
193  LRS.Free;
194end.
195
196