Oni2/VisualSwapcodes/Unit1.pas

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, VirtualTrees, StrUtils, ExtCtrls;

type
  TForm1 = class(TForm)
    vst: TVirtualStringTree;
    list: TListBox;
    Splitter1: TSplitter;
    procedure FormCreate(Sender: TObject);
    procedure listClick(Sender: TObject);
    procedure vstGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
  private
  public
  end;

  TSwapList = class;

  TSwapItem = class
    name: String;
    size: Integer;
    parent: TSwapList;
  end;

  TSwapList = class(TSwapItem)
    childs: array of TSwapItem;
    count: Integer;
    constructor Create;
    function AddElem(name: String; size: Integer): Integer;
    function AddArray(name: String; count: Integer): Integer;
    function CloseArray: TSwapList;
    function Child(index: Integer): TSwapItem;
  end;

  TType = record
    name: String;
    SwapList: TSwapList;
  end;

  TTypes = array of TType;

  PNodeData = ^TNodeData;
  TNodeData = record
    TypeName:  String;
    Address:   Integer;
    Size:      Integer;
  end;

var
  Form1: TForm1;
  Types: TTypes;
  descfile: Text;

implementation

{$R *.dfm}

function AddVSTEntry(AVST: TCustomVirtualStringTree; ANode: PVirtualNode;
  ARecord: TNodeData): PVirtualNode;
var
  Data: PNodeData;
begin
  Result := AVST.AddChild(ANode);
  Data   := AVST.GetNodeData(Result);
  AVST.ValidateNode(Result, False);
  Data^ := ARecord;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  state: Integer;
  line, datas: String;
  i: Integer;
  current_list: TSwapList;
begin
  VST.NodeDataSize := SizeOf(TNodeData);

  state := 0;
  current_list := nil;
  AssignFile(descfile, ExtractFilePath(Application.ExeName)+'\templates.txt.gz');
  Reset(descfile);
  while not EoF(descfile) do
  begin
    ReadLn(descfile, line);
    if state = 0 then
    begin
      if Pos('gSwapCodes_', line) = 1 then
      begin
        SetLength(Types, Length(Types) + 1);
        Types[High(Types)].name := MidStr(line, Pos('_', line)+1, 4);
        Types[High(Types)].SwapList := TSwapList.Create;
        Types[High(Types)].SwapList.parent := nil;
        current_list := Types[High(Types)].SwapList;
        state := 1;
        datas := MidStr(line, Pos('db ', line) + 3, PosEx(' ', line, Pos('db ', line) + 3) - Pos('db ', line) - 3 );
        if datas = 'SWAPC_8BYTE' then
          current_list.AddElem('SWAPC_8BYTE', 8)
        else if datas = 'SWAPC_4BYTE' then
          current_list.AddElem('SWAPC_4BYTE', 4)
        else if datas = 'SWAPC_2BYTE' then
          current_list.AddElem('SWAPC_2BYTE', 2)
        else if datas = 'SWAPC_1BYTE' then
          current_list.AddElem('SWAPC_1BYTE', 1)
        else if datas = 'SWAPC_FIXARR_S' then
        begin
          ReadLn(descfile, line);
          if Pos('h', line) > 0 then
            datas := MidStr(line, Pos('db ', line) + 3, Pos('h', line) - (Pos('db ', line) + 3) )
          else
            datas := MidStr(line, Pos('db ', line) + 3, Length(Line) - (Pos('db ', line) + 3) );
          i := current_list.AddArray('SWAPC_FIXARR_S', StrToInt('$'+datas));
          current_list := TSwapList(current_list.Child(i));
        end else if datas = 'SWAPC_VARARR_S' then
        begin
          ReadLn(descfile, line);
          i := current_list.AddArray('SWAPC_VARARR_S', 0);
          current_list := TSwapList(current_list.Child(i));
        end else if datas = 'SWAPC_TMPL_PTR' then
        begin
          ReadLn(descfile, line);
          datas := MidStr(line, Pos('dd ', line) + 4, 4);
          current_list.AddElem('SWAPC_TMPL_PTR: ' + datas, 4);
        end;
      end;
      if Pos('gTemplate_', line) = 1 then
      begin
        datas := MidStr(line, Pos('_', line)+1, 4);
        for i := 0 to High(Types) do
          if Types[i].name = datas then
            Break;
        if i < Length(Types) then
        begin
          if Pos('"', line) = 0 then
            ReadLn(descfile, line);
          datas := MidStr(line, Pos('"', line) + 1, PosEx('"', line, Pos('"', line) + 1) - (Pos('"', line) + 1) );
          Types[i].name := Types[i].name + ' - ' + datas;
        end;
      end;
    end else begin
      if PosEx(' ', line, Pos(' d', line) + 4) > 0 then
        datas := MidStr(line, Pos(' d', line) + 4, PosEx(' ', line, Pos(' d', line) + 4) - (Pos(' d', line) + 4) )
      else
        datas := MidStr(line, Pos(' d', line) + 4, Length(line) - Pos(' d', line) );
      if datas = 'SWAPC_8BYTE' then
        current_list.AddElem('SWAPC_8BYTE', 8)
      else if datas = 'SWAPC_4BYTE' then
        current_list.AddElem('SWAPC_4BYTE', 4)
      else if datas = 'SWAPC_2BYTE' then
        current_list.AddElem('SWAPC_2BYTE', 2)
      else if datas = 'SWAPC_1BYTE' then
        current_list.AddElem('SWAPC_1BYTE', 1)
      else if datas = 'SWAPC_FIXARR_S' then
      begin
        ReadLn(descfile, line);
        if Pos('h', line) > 0 then
          datas := MidStr(line, Pos('db ', line) + 3, Pos('h', line) - (Pos('db ', line) + 3) )
        else
          datas := MidStr(line, Pos('db ', line) + 3, Length(Line) - (Pos('db ', line) + 2) );
        i := current_list.AddArray('SWAPC_FIXARR_S', StrToInt('$'+datas));
        current_list := TSwapList(current_list.Child(i));
        Inc(State);
      end else if datas = 'SWAPC_FIXARR_E' then
      begin
        Dec(State);
        current_list := current_list.CloseArray;
      end else if datas = 'SWAPC_VARARR_S' then
      begin
        ReadLn(descfile, line);
        i := current_list.AddArray('SWAPC_VARARR_S', 0);
        current_list := TSwapList(current_list.Child(i));
      end else if datas = 'SWAPC_VARARR_E' then
      begin
        Dec(State);
        current_list := current_list.CloseArray;
      end else if datas = 'SWAPC_TMPL_PTR' then
      begin
        ReadLn(descfile, line);
        datas := MidStr(line, Pos('dd ', line) + 4, 4);
        current_list.AddElem('SWAPC_TMPL_PTR: ' + datas, 4);
      end;
    end;
  end;
  CloseFile(descfile);

  list.Items.Clear;
  for i := 0 to High(Types) do
    list.Items.Add(Types[i].name);
end;


{ TSwapList }

function TSwapList.AddArray(name: String; count: Integer): Integer;
begin
  SetLength(childs, Length(childs) + 1);
  Result := High(childs);
  childs[Result] := TSwapList.Create;
  childs[Result].name := name;
  childs[Result].size := 0;
  childs[Result].parent := Self;
  TSwapList(childs[Result]).count := count;
end;

function TSwapList.AddElem(name: String; size: Integer): Integer;
begin
  SetLength(childs, Length(childs) + 1);
  Result := High(childs);
  childs[Result] := TSwapItem.Create;
  childs[Result].name := name;
  childs[Result].size := size;
  childs[Result].parent := Self;
  Self.size := Self.size + size;
end;

function TSwapList.Child(index: Integer): TSwapItem;
begin
  Result := childs[index];
end;

function TSwapList.CloseArray: TSwapList;
begin
  Self.size := Self.size * Self.count;
  Result := Self.parent;
end;

constructor TSwapList.Create;
begin
  SetLength(childs, 0);
  count := -1;
end;

procedure TForm1.listClick(Sender: TObject);
var
  i:    LongWord;
  Data:    TNodeData;
  node:    PVirtualNode;
  name:    String;
  address: Integer;

  procedure AddChilds(parent: PVirtualNode; SwapList: TSwapList);
  var
    i: Integer;
  begin
    if Length(SwapList.childs) > 0 then
    begin
      for i := 0 to High(SwapList.childs) do
      begin
        data.TypeName := SwapList.Child(i).name;
        data.Size := SwapList.Child(i).size;
        data.Address := address;
        if parent = nil then
          address := address + data.Size;
        node := AddVSTEntry(VST, parent, data);
        if SwapList.Child(i) is TSwapList then
          AddChilds(node, TSwapList(SwapList.Child(i)));
      end;
    end;
  end;

begin
  VST.Clear;
  VST.BeginUpdate;

  address := 0;

  name := list.Items.Strings[list.ItemIndex];
  for i := 0 to High(Types) do
    if Types[i].name = name then
      Break;

  if i < Length(Types) then
  begin
    AddChilds(nil, Types[i].SwapList);
  end;

  VST.EndUpdate;
end;

procedure TForm1.vstGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
var
  data: PNodeData;
begin
  data := vst.GetNodeData(node);
  if TextType = ttNormal then
  begin
    case Column of
      0: CellText := data.TypeName;
      1: CellText := '0x' + IntToHex(data.Address, 8);
      2: CellText := IntToStr(data.Size);
    end;
  end;
end;

end.
Revision:	98
Committed:	Tue Feb 20 16:23:27 2007 UTC (18 years, 7 months ago) by alloc
Content type:	text/x-pascal
File size:	8857 byte(s)
Log Message:
#	Content
1	unit Unit1;
2	interface
3	uses
4	Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
5	Dialogs, StdCtrls, VirtualTrees, StrUtils, ExtCtrls;
6
7	type
8	TForm1 = class(TForm)
9	vst: TVirtualStringTree;
10	list: TListBox;
11	Splitter1: TSplitter;
12	procedure FormCreate(Sender: TObject);
13	procedure listClick(Sender: TObject);
14	procedure vstGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
15	Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
16	private
17	public
18	end;
19
20	TSwapList = class;
21
22	TSwapItem = class
23	name: String;
24	size: Integer;
25	parent: TSwapList;
26	end;
27
28	TSwapList = class(TSwapItem)
29	childs: array of TSwapItem;
30	count: Integer;
31	constructor Create;
32	function AddElem(name: String; size: Integer): Integer;
33	function AddArray(name: String; count: Integer): Integer;
34	function CloseArray: TSwapList;
35	function Child(index: Integer): TSwapItem;
36	end;
37
38	TType = record
39	name: String;
40	SwapList: TSwapList;
41	end;
42
43	TTypes = array of TType;
44
45	PNodeData = ^TNodeData;
46	TNodeData = record
47	TypeName: String;
48	Address: Integer;
49	Size: Integer;
50	end;
51
52	var
53	Form1: TForm1;
54	Types: TTypes;
55	descfile: Text;
56
57	implementation
58
59	{$R *.dfm}
60
61	function AddVSTEntry(AVST: TCustomVirtualStringTree; ANode: PVirtualNode;
62	ARecord: TNodeData): PVirtualNode;
63	var
64	Data: PNodeData;
65	begin
66	Result := AVST.AddChild(ANode);
67	Data := AVST.GetNodeData(Result);
68	AVST.ValidateNode(Result, False);
69	Data^ := ARecord;
70	end;
71
72	procedure TForm1.FormCreate(Sender: TObject);
73	var
74	state: Integer;
75	line, datas: String;
76	i: Integer;
77	current_list: TSwapList;
78	begin
79	VST.NodeDataSize := SizeOf(TNodeData);
80
81	state := 0;
82	current_list := nil;
83	AssignFile(descfile, ExtractFilePath(Application.ExeName)+'\templates.txt.gz');
84	Reset(descfile);
85	while not EoF(descfile) do
86	begin
87	ReadLn(descfile, line);
88	if state = 0 then
89	begin
90	if Pos('gSwapCodes_', line) = 1 then
91	begin
92	SetLength(Types, Length(Types) + 1);
93	Types[High(Types)].name := MidStr(line, Pos('_', line)+1, 4);
94	Types[High(Types)].SwapList := TSwapList.Create;
95	Types[High(Types)].SwapList.parent := nil;
96	current_list := Types[High(Types)].SwapList;
97	state := 1;
98	datas := MidStr(line, Pos('db ', line) + 3, PosEx(' ', line, Pos('db ', line) + 3) - Pos('db ', line) - 3 );
99	if datas = 'SWAPC_8BYTE' then
100	current_list.AddElem('SWAPC_8BYTE', 8)
101	else if datas = 'SWAPC_4BYTE' then
102	current_list.AddElem('SWAPC_4BYTE', 4)
103	else if datas = 'SWAPC_2BYTE' then
104	current_list.AddElem('SWAPC_2BYTE', 2)
105	else if datas = 'SWAPC_1BYTE' then
106	current_list.AddElem('SWAPC_1BYTE', 1)
107	else if datas = 'SWAPC_FIXARR_S' then
108	begin
109	ReadLn(descfile, line);
110	if Pos('h', line) > 0 then
111	datas := MidStr(line, Pos('db ', line) + 3, Pos('h', line) - (Pos('db ', line) + 3) )
112	else
113	datas := MidStr(line, Pos('db ', line) + 3, Length(Line) - (Pos('db ', line) + 3) );
114	i := current_list.AddArray('SWAPC_FIXARR_S', StrToInt('$'+datas));
115	current_list := TSwapList(current_list.Child(i));
116	end else if datas = 'SWAPC_VARARR_S' then
117	begin
118	ReadLn(descfile, line);
119	i := current_list.AddArray('SWAPC_VARARR_S', 0);
120	current_list := TSwapList(current_list.Child(i));
121	end else if datas = 'SWAPC_TMPL_PTR' then
122	begin
123	ReadLn(descfile, line);
124	datas := MidStr(line, Pos('dd ', line) + 4, 4);
125	current_list.AddElem('SWAPC_TMPL_PTR: ' + datas, 4);
126	end;
127	end;
128	if Pos('gTemplate_', line) = 1 then
129	begin
130	datas := MidStr(line, Pos('_', line)+1, 4);
131	for i := 0 to High(Types) do
132	if Types[i].name = datas then
133	Break;
134	if i < Length(Types) then
135	begin
136	if Pos('"', line) = 0 then
137	ReadLn(descfile, line);
138	datas := MidStr(line, Pos('"', line) + 1, PosEx('"', line, Pos('"', line) + 1) - (Pos('"', line) + 1) );
139	Types[i].name := Types[i].name + ' - ' + datas;
140	end;
141	end;
142	end else begin
143	if PosEx(' ', line, Pos(' d', line) + 4) > 0 then
144	datas := MidStr(line, Pos(' d', line) + 4, PosEx(' ', line, Pos(' d', line) + 4) - (Pos(' d', line) + 4) )
145	else
146	datas := MidStr(line, Pos(' d', line) + 4, Length(line) - Pos(' d', line) );
147	if datas = 'SWAPC_8BYTE' then
148	current_list.AddElem('SWAPC_8BYTE', 8)
149	else if datas = 'SWAPC_4BYTE' then
150	current_list.AddElem('SWAPC_4BYTE', 4)
151	else if datas = 'SWAPC_2BYTE' then
152	current_list.AddElem('SWAPC_2BYTE', 2)
153	else if datas = 'SWAPC_1BYTE' then
154	current_list.AddElem('SWAPC_1BYTE', 1)
155	else if datas = 'SWAPC_FIXARR_S' then
156	begin
157	ReadLn(descfile, line);
158	if Pos('h', line) > 0 then
159	datas := MidStr(line, Pos('db ', line) + 3, Pos('h', line) - (Pos('db ', line) + 3) )
160	else
161	datas := MidStr(line, Pos('db ', line) + 3, Length(Line) - (Pos('db ', line) + 2) );
162	i := current_list.AddArray('SWAPC_FIXARR_S', StrToInt('$'+datas));
163	current_list := TSwapList(current_list.Child(i));
164	Inc(State);
165	end else if datas = 'SWAPC_FIXARR_E' then
166	begin
167	Dec(State);
168	current_list := current_list.CloseArray;
169	end else if datas = 'SWAPC_VARARR_S' then
170	begin
171	ReadLn(descfile, line);
172	i := current_list.AddArray('SWAPC_VARARR_S', 0);
173	current_list := TSwapList(current_list.Child(i));
174	end else if datas = 'SWAPC_VARARR_E' then
175	begin
176	Dec(State);
177	current_list := current_list.CloseArray;
178	end else if datas = 'SWAPC_TMPL_PTR' then
179	begin
180	ReadLn(descfile, line);
181	datas := MidStr(line, Pos('dd ', line) + 4, 4);
182	current_list.AddElem('SWAPC_TMPL_PTR: ' + datas, 4);
183	end;
184	end;
185	end;
186	CloseFile(descfile);
187
188	list.Items.Clear;
189	for i := 0 to High(Types) do
190	list.Items.Add(Types[i].name);
191	end;
192
193
194	{ TSwapList }
195
196	function TSwapList.AddArray(name: String; count: Integer): Integer;
197	begin
198	SetLength(childs, Length(childs) + 1);
199	Result := High(childs);
200	childs[Result] := TSwapList.Create;
201	childs[Result].name := name;
202	childs[Result].size := 0;
203	childs[Result].parent := Self;
204	TSwapList(childs[Result]).count := count;
205	end;
206
207	function TSwapList.AddElem(name: String; size: Integer): Integer;
208	begin
209	SetLength(childs, Length(childs) + 1);
210	Result := High(childs);
211	childs[Result] := TSwapItem.Create;
212	childs[Result].name := name;
213	childs[Result].size := size;
214	childs[Result].parent := Self;
215	Self.size := Self.size + size;
216	end;
217
218	function TSwapList.Child(index: Integer): TSwapItem;
219	begin
220	Result := childs[index];
221	end;
222
223	function TSwapList.CloseArray: TSwapList;
224	begin
225	Self.size := Self.size * Self.count;
226	Result := Self.parent;
227	end;
228
229	constructor TSwapList.Create;
230	begin
231	SetLength(childs, 0);
232	count := -1;
233	end;
234
235	procedure TForm1.listClick(Sender: TObject);
236	var
237	i: LongWord;
238	Data: TNodeData;
239	node: PVirtualNode;
240	name: String;
241	address: Integer;
242
243	procedure AddChilds(parent: PVirtualNode; SwapList: TSwapList);
244	var
245	i: Integer;
246	begin
247	if Length(SwapList.childs) > 0 then
248	begin
249	for i := 0 to High(SwapList.childs) do
250	begin
251	data.TypeName := SwapList.Child(i).name;
252	data.Size := SwapList.Child(i).size;
253	data.Address := address;
254	if parent = nil then
255	address := address + data.Size;
256	node := AddVSTEntry(VST, parent, data);
257	if SwapList.Child(i) is TSwapList then
258	AddChilds(node, TSwapList(SwapList.Child(i)));
259	end;
260	end;
261	end;
262
263	begin
264	VST.Clear;
265	VST.BeginUpdate;
266
267	address := 0;
268
269	name := list.Items.Strings[list.ItemIndex];
270	for i := 0 to High(Types) do
271	if Types[i].name = name then
272	Break;
273
274	if i < Length(Types) then
275	begin
276	AddChilds(nil, Types[i].SwapList);
277	end;
278
279	VST.EndUpdate;
280	end;
281
282	procedure TForm1.vstGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
283	Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
284	var
285	data: PNodeData;
286	begin
287	data := vst.GetNodeData(node);
288	if TextType = ttNormal then
289	begin
290	case Column of
291	0: CellText := data.TypeName;
292	1: CellText := '0x' + IntToHex(data.Address, 8);
293	2: CellText := IntToStr(data.Size);
294	end;
295	end;
296	end;
297
298	end.