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

laz_xmlcfg: test old and new version

Browse Source 
git-svn-id: trunk@31614 -
This commit is contained in:
mattias 2011-07-09 08:23:14 +00:00
parent 17d837884e
commit 5452f9d706
4 changed files with 224 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -415,6 +415,8 @@ components/codetools/docs/codetoolmanager.xml svneol=native#text/plain
components/codetools/docs/fileprocs.xml svneol=native#text/plain
components/codetools/eventcodetool.pas svneol=native#text/pascal
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.lpr svneol=native#text/plain
components/codetools/examples/addeventmethod.lpi svneol=native#text/plain

77
components/codetools/examples/TestNewXMLCfg.lpi Normal file
View 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
View 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.

3
components/codetools/laz2_xmlcfg.pas
View File

@ -12,9 +12,8 @@
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
**********************************************************************
{
TXMLConfig enables applications to use XML files for storing their
configuration data
}