1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
program TestNewXMLCfg;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, CustApp, FileProcs, Laz_XMLCfg, Laz2_XMLCfg, LazFileUtils;
type
{ TMyApplication }
TMyApplication = class(TCustomApplication)
protected
procedure DoRun; override;
procedure Test1;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure WriteHelp; virtual;
end;
{ TMyApplication }
procedure TMyApplication.DoRun;
var
ErrorMsg: String;
begin
// quick check parameters
ErrorMsg:=CheckOptions('h','help');
if ErrorMsg<>'' then begin
ShowException(Exception.Create(ErrorMsg));
Terminate;
Exit;
end;
// parse parameters
if HasOption('h','help') then begin
WriteHelp;
Terminate;
Exit;
end;
Test1;
// stop program loop
Terminate;
end;
procedure TMyApplication.Test1;
procedure Test(Filename: string; UseOld: boolean; WriteTo: boolean);
var
x1: Laz_XMLCfg.TXMLConfig;
x2: Laz2_XMLCfg.TXMLConfig;
i: Integer;
procedure CheckValue(Path, Value: string);
var
NewValue: String;
begin
if WriteTo then
if UseOld then
x1.SetValue(Path,Value)
else
x2.SetValue(Path,Value);
if UseOld then
NewValue:=x1.GetValue(Path,'')
else
NewValue:=x2.GetValue(Path,'');
if Value<>NewValue then begin
debugln(['TMyApplication.Test1 failed UseOld=',UseOld,' WriteTo=',WriteTo]);
debugln(['OldValue="',dbgstr(Value),'"']);
debugln(['NewValue="',dbgstr(NewValue),'"']);
end;
end;
begin
if WriteTo then
DeleteFileUTF8(Filename);
if UseOld then
x1:=Laz_XMLCfg.TXMLConfig.Create(Filename)
else
x2:=Laz2_XMLCfg.TXMLConfig.Create(Filename);
for i:=1 to 130 do begin
CheckValue('Item'+IntToStr(i)+'/Value',chr(i));
end;
CheckValue('AUmlaut/Value','Ä');
CheckValue('LineBreak/Value','First#10Second#13#10Third');
if WriteTo then
if UseOld then
x1.Flush
else
x2.Flush;
if UseOld then
x1.Free
else
x2.Free;
end;
var
Filename: String;
begin
Filename:='test1.xml';
Test(Filename,true,true); // write with old
Test(Filename,true,false); // read old with old
Test(Filename,false,false); // read old with new
Filename:='test2.xml';
Test(Filename,false,true); // write with new
Test(Filename,false,false); // read new with new
Test(Filename,true,false); // read new with old
end;
constructor TMyApplication.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
StopOnException:=True;
end;
destructor TMyApplication.Destroy;
begin
inherited Destroy;
end;
procedure TMyApplication.WriteHelp;
begin
{ add your help code here }
writeln('Usage: ',ExeName,' -h');
end;
var
Application: TMyApplication;
begin
Application:=TMyApplication.Create(nil);
Application.Run;
Application.Free;
end.
|
