mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-12-03 14:47:21 +01:00
laz_xmlcfg: test old and new version
git-svn-id: trunk@31614 -
This commit is contained in:
parent
17d837884e
commit
5452f9d706
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -415,6 +415,8 @@ components/codetools/docs/codetoolmanager.xml svneol=native#text/plain
|
|||||||
components/codetools/docs/fileprocs.xml svneol=native#text/plain
|
components/codetools/docs/fileprocs.xml svneol=native#text/plain
|
||||||
components/codetools/eventcodetool.pas svneol=native#text/pascal
|
components/codetools/eventcodetool.pas svneol=native#text/pascal
|
||||||
components/codetools/examples/README.txt svneol=native#text/plain
|
components/codetools/examples/README.txt svneol=native#text/plain
|
||||||
|
components/codetools/examples/TestNewXMLCfg.lpi svneol=native#text/plain
|
||||||
|
components/codetools/examples/TestNewXMLCfg.lpr svneol=native#text/plain
|
||||||
components/codetools/examples/addclass.lpi svneol=native#text/plain
|
components/codetools/examples/addclass.lpi svneol=native#text/plain
|
||||||
components/codetools/examples/addclass.lpr svneol=native#text/plain
|
components/codetools/examples/addclass.lpr svneol=native#text/plain
|
||||||
components/codetools/examples/addeventmethod.lpi svneol=native#text/plain
|
components/codetools/examples/addeventmethod.lpi svneol=native#text/plain
|
||||||
|
|||||||
77
components/codetools/examples/TestNewXMLCfg.lpi
Normal file
77
components/codetools/examples/TestNewXMLCfg.lpi
Normal file
@ -0,0 +1,77 @@
|
|||||||
|
<?xml version="1.0"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<Version Value="9"/>
|
||||||
|
<General>
|
||||||
|
<Flags>
|
||||||
|
<MainUnitHasCreateFormStatements Value="False"/>
|
||||||
|
</Flags>
|
||||||
|
<SessionStorage Value="InIDEConfig"/>
|
||||||
|
<MainUnit Value="0"/>
|
||||||
|
<Title Value="TestNewXMLCfg"/>
|
||||||
|
<UseAppBundle Value="False"/>
|
||||||
|
<ResourceType Value="res"/>
|
||||||
|
</General>
|
||||||
|
<i18n>
|
||||||
|
<EnableI18N LFM="False"/>
|
||||||
|
</i18n>
|
||||||
|
<VersionInfo>
|
||||||
|
<StringTable ProductVersion=""/>
|
||||||
|
</VersionInfo>
|
||||||
|
<BuildModes Count="1">
|
||||||
|
<Item1 Name="Default" Default="True"/>
|
||||||
|
</BuildModes>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||||
|
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<RunParams>
|
||||||
|
<local>
|
||||||
|
<FormatVersion Value="1"/>
|
||||||
|
<LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||||
|
</local>
|
||||||
|
</RunParams>
|
||||||
|
<RequiredPackages Count="1">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="CodeTools"/>
|
||||||
|
</Item1>
|
||||||
|
</RequiredPackages>
|
||||||
|
<Units Count="1">
|
||||||
|
<Unit0>
|
||||||
|
<Filename Value="TestNewXMLCfg.lpr"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="TestNewXMLCfg"/>
|
||||||
|
</Unit0>
|
||||||
|
</Units>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="10"/>
|
||||||
|
<Target>
|
||||||
|
<Filename Value="TestNewXMLCfg"/>
|
||||||
|
</Target>
|
||||||
|
<SearchPaths>
|
||||||
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
|
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||||
|
</SearchPaths>
|
||||||
|
<Other>
|
||||||
|
<CompilerMessages>
|
||||||
|
<UseMsgFile Value="True"/>
|
||||||
|
</CompilerMessages>
|
||||||
|
<CompilerPath Value="$(CompPath)"/>
|
||||||
|
</Other>
|
||||||
|
</CompilerOptions>
|
||||||
|
<Debugging>
|
||||||
|
<Exceptions Count="3">
|
||||||
|
<Item1>
|
||||||
|
<Name Value="EAbort"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<Name Value="ECodetoolError"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<Name Value="EFOpenError"/>
|
||||||
|
</Item3>
|
||||||
|
</Exceptions>
|
||||||
|
</Debugging>
|
||||||
|
</CONFIG>
|
||||||
144
components/codetools/examples/TestNewXMLCfg.lpr
Normal file
144
components/codetools/examples/TestNewXMLCfg.lpr
Normal file
@ -0,0 +1,144 @@
|
|||||||
|
program TestNewXMLCfg;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||||
|
cthreads,
|
||||||
|
{$ENDIF}{$ENDIF}
|
||||||
|
Classes, SysUtils, CustApp, FileProcs, Laz_XMLCfg, Laz2_XMLCfg;
|
||||||
|
|
||||||
|
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:=8 to 13 do begin
|
||||||
|
CheckValue('Item'+IntToStr(i)+'/Value',chr(i));
|
||||||
|
end;
|
||||||
|
CheckValue('AUmlaut/Value','Ä');
|
||||||
|
if WriteTo then
|
||||||
|
if UseOld then
|
||||||
|
x1.Flush
|
||||||
|
else
|
||||||
|
x2.Flush;
|
||||||
|
if UseOld then
|
||||||
|
x1.Free
|
||||||
|
else
|
||||||
|
x2.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Filename: String;
|
||||||
|
begin
|
||||||
|
|
||||||
|
// write with old
|
||||||
|
Filename:='test1.xml';
|
||||||
|
Test(Filename,true,true);
|
||||||
|
Test(Filename,true,false); // read old with old
|
||||||
|
Test(Filename,false,false); // read old with new
|
||||||
|
|
||||||
|
// write with new
|
||||||
|
Filename:='test2.xml';
|
||||||
|
Test(Filename,false,true);
|
||||||
|
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.
|
||||||
|
|
||||||
@ -12,9 +12,8 @@
|
|||||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||||
|
|
||||||
**********************************************************************}
|
**********************************************************************
|
||||||
|
|
||||||
{
|
|
||||||
TXMLConfig enables applications to use XML files for storing their
|
TXMLConfig enables applications to use XML files for storing their
|
||||||
configuration data
|
configuration data
|
||||||
}
|
}
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user