mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-13 09:29:10 +02:00
tools: initial check in of monitoring tool for snapshots, needs further clean up
git-svn-id: trunk@11003 -
This commit is contained in:
vincents
parent
029d4f6327
commit
be4e0c2b3c
11
.gitattributes
vendored
11
.gitattributes
vendored
@ -3030,6 +3030,17 @@ tools/lazres.lpi svneol=native#text/plain
|
|||||||
tools/lazres.pp svneol=native#text/pascal
|
tools/lazres.pp svneol=native#text/pascal
|
||||||
tools/lfm_to_lrs.sh svneol=native#text/plain
|
tools/lfm_to_lrs.sh svneol=native#text/plain
|
||||||
tools/runwait.sh -text svneol=native#application/x-sh
|
tools/runwait.sh -text svneol=native#application/x-sh
|
||||||
|
tools/snapshots/checksnapshots.lpi svneol=native#text/plain
|
||||||
|
tools/snapshots/checksnapshots.lpr svneol=native#text/plain
|
||||||
|
tools/snapshots/checksnapshotsgui.lpi svneol=native#text/plain
|
||||||
|
tools/snapshots/checksnapshotsgui.lpr svneol=native#text/plain
|
||||||
|
tools/snapshots/ftplister.pas svneol=native#text/plain
|
||||||
|
tools/snapshots/ftplistertest.pas svneol=native#text/plain
|
||||||
|
tools/snapshots/monitorcfg.pas svneol=native#text/plain
|
||||||
|
tools/snapshots/monitorconfig.xml svneol=native#text/plain
|
||||||
|
tools/snapshots/runchecksnapshots.bat svneol=native#text/plain
|
||||||
|
tools/snapshots/snapshotsuptodate.pas svneol=native#text/plain
|
||||||
|
tools/snapshots/testmonitorcfg.pas svneol=native#text/plain
|
||||||
tools/svn2revisioninc.lpi svneol=native#text/plain
|
tools/svn2revisioninc.lpi svneol=native#text/plain
|
||||||
tools/svn2revisioninc.pas svneol=native#text/plain
|
tools/svn2revisioninc.pas svneol=native#text/plain
|
||||||
tools/update_pkgfileslcl_inc.sh svneol=native#text/plain
|
tools/update_pkgfileslcl_inc.sh svneol=native#text/plain
|
||||||
|
|||||||
464
tools/snapshots/checksnapshots.lpi
Normal file
464
tools/snapshots/checksnapshots.lpi
Normal file
@ -0,0 +1,464 @@
|
|||||||
|
<?xml version="1.0"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<Version Value="5"/>
|
||||||
|
<General>
|
||||||
|
<MainUnit Value="0"/>
|
||||||
|
<IconPath Value="./"/>
|
||||||
|
<TargetFileExt Value=".exe"/>
|
||||||
|
<Title Value="Lazarus snapshots monitor"/>
|
||||||
|
<ActiveEditorIndexAtStart Value="6"/>
|
||||||
|
</General>
|
||||||
|
<VersionInfo>
|
||||||
|
<ProjectVersion Value=""/>
|
||||||
|
</VersionInfo>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
<IgnoreBinaries Value="False"/>
|
||||||
|
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||||
|
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<RunParams>
|
||||||
|
<local>
|
||||||
|
<FormatVersion Value="1"/>
|
||||||
|
<CommandLineParams Value="-a -p"/>
|
||||||
|
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||||
|
</local>
|
||||||
|
</RunParams>
|
||||||
|
<RequiredPackages Count="3">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="lnetbase"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<PackageName Value="FPCUnitConsoleRunner"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<PackageName Value="FCL"/>
|
||||||
|
</Item3>
|
||||||
|
</RequiredPackages>
|
||||||
|
<Units Count="31">
|
||||||
|
<Unit0>
|
||||||
|
<Filename Value="checksnapshots.lpr"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="checksnapshots"/>
|
||||||
|
<CursorPos X="57" Y="6"/>
|
||||||
|
<TopLine Value="1"/>
|
||||||
|
<EditorIndex Value="5"/>
|
||||||
|
<UsageCount Value="218"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit0>
|
||||||
|
<Unit1>
|
||||||
|
<Filename Value="snapshotsuptodate.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="SnapshotsUptodate"/>
|
||||||
|
<CursorPos X="72" Y="46"/>
|
||||||
|
<TopLine Value="29"/>
|
||||||
|
<EditorIndex Value="0"/>
|
||||||
|
<UsageCount Value="218"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit1>
|
||||||
|
<Unit2>
|
||||||
|
<Filename Value="..\..\components\fpcunit\console\consoletestrunner.pas"/>
|
||||||
|
<UnitName Value="consoletestrunner"/>
|
||||||
|
<CursorPos X="32" Y="30"/>
|
||||||
|
<TopLine Value="1"/>
|
||||||
|
<EditorIndex Value="4"/>
|
||||||
|
<UsageCount Value="109"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit2>
|
||||||
|
<Unit3>
|
||||||
|
<Filename Value="..\..\..\fpc\fpcprojects\lnet\tags\release_0_4_0\examples\console\lftp\lftpclient.pas"/>
|
||||||
|
<UnitName Value="lFTPClient"/>
|
||||||
|
<CursorPos X="25" Y="146"/>
|
||||||
|
<TopLine Value="12"/>
|
||||||
|
<UsageCount Value="75"/>
|
||||||
|
</Unit3>
|
||||||
|
<Unit4>
|
||||||
|
<Filename Value="..\..\..\fpc\fpcprojects\lnet\trunk\lib\lftp.pas"/>
|
||||||
|
<UnitName Value="lFTP"/>
|
||||||
|
<CursorPos X="3" Y="825"/>
|
||||||
|
<TopLine Value="823"/>
|
||||||
|
<UsageCount Value="66"/>
|
||||||
|
</Unit4>
|
||||||
|
<Unit5>
|
||||||
|
<Filename Value="..\..\..\fpc\fpcprojects\lnet\trunk\examples\visual\ftp\main.pas"/>
|
||||||
|
<UnitName Value="main"/>
|
||||||
|
<CursorPos X="19" Y="102"/>
|
||||||
|
<TopLine Value="322"/>
|
||||||
|
<UsageCount Value="36"/>
|
||||||
|
</Unit5>
|
||||||
|
<Unit6>
|
||||||
|
<Filename Value="..\testlpi.pas"/>
|
||||||
|
<UnitName Value="TestLpi"/>
|
||||||
|
<CursorPos X="1" Y="70"/>
|
||||||
|
<TopLine Value="66"/>
|
||||||
|
<UsageCount Value="24"/>
|
||||||
|
</Unit6>
|
||||||
|
<Unit7>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="ftplister"/>
|
||||||
|
<CursorPos X="1" Y="55"/>
|
||||||
|
<TopLine Value="25"/>
|
||||||
|
<EditorIndex Value="1"/>
|
||||||
|
<UsageCount Value="235"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit7>
|
||||||
|
<Unit8>
|
||||||
|
<Filename Value="ftplistertest.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="ftplistertest"/>
|
||||||
|
<CursorPos X="53" Y="68"/>
|
||||||
|
<TopLine Value="36"/>
|
||||||
|
<EditorIndex Value="6"/>
|
||||||
|
<UsageCount Value="232"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit8>
|
||||||
|
<Unit9>
|
||||||
|
<Filename Value="monitorconfig.xml"/>
|
||||||
|
<CursorPos X="16" Y="22"/>
|
||||||
|
<TopLine Value="12"/>
|
||||||
|
<UsageCount Value="113"/>
|
||||||
|
<SyntaxHighlighter Value="XML"/>
|
||||||
|
</Unit9>
|
||||||
|
<Unit10>
|
||||||
|
<Filename Value="..\..\..\fpc\fpcprojects\lnet\trunk\lib\lhttp.pas"/>
|
||||||
|
<UnitName Value="lhttp"/>
|
||||||
|
<CursorPos X="75" Y="10"/>
|
||||||
|
<TopLine Value="1"/>
|
||||||
|
<UsageCount Value="5"/>
|
||||||
|
</Unit10>
|
||||||
|
<Unit11>
|
||||||
|
<Filename Value="..\..\..\fpcbuild\2.0.4\fpcsrc\fcl\xml\xmlcfg.pp"/>
|
||||||
|
<UnitName Value="XMLCfg"/>
|
||||||
|
<CursorPos X="44" Y="136"/>
|
||||||
|
<TopLine Value="128"/>
|
||||||
|
<UsageCount Value="146"/>
|
||||||
|
</Unit11>
|
||||||
|
<Unit12>
|
||||||
|
<Filename Value="..\..\..\fpc\fpcprojects\lnet\trunk\lib\lftp.pp"/>
|
||||||
|
<UnitName Value="lFTP"/>
|
||||||
|
<CursorPos X="3" Y="38"/>
|
||||||
|
<TopLine Value="20"/>
|
||||||
|
<EditorIndex Value="2"/>
|
||||||
|
<UsageCount Value="126"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit12>
|
||||||
|
<Unit13>
|
||||||
|
<Filename Value="monitorcfg.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="MonitorCfg"/>
|
||||||
|
<CursorPos X="1" Y="175"/>
|
||||||
|
<TopLine Value="63"/>
|
||||||
|
<EditorIndex Value="3"/>
|
||||||
|
<UsageCount Value="230"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit13>
|
||||||
|
<Unit14>
|
||||||
|
<Filename Value="..\..\..\fpc\2.1\rtl\win32\classes.pp"/>
|
||||||
|
<UnitName Value="Classes"/>
|
||||||
|
<CursorPos X="13" Y="35"/>
|
||||||
|
<TopLine Value="14"/>
|
||||||
|
<UsageCount Value="113"/>
|
||||||
|
</Unit14>
|
||||||
|
<Unit15>
|
||||||
|
<Filename Value="..\..\..\fpc\2.1\rtl\objpas\classes\classesh.inc"/>
|
||||||
|
<CursorPos X="17" Y="483"/>
|
||||||
|
<TopLine Value="465"/>
|
||||||
|
<UsageCount Value="113"/>
|
||||||
|
</Unit15>
|
||||||
|
<Unit16>
|
||||||
|
<Filename Value="..\..\..\fpc\2.1\fcl\inc\contnrs.pp"/>
|
||||||
|
<UnitName Value="contnrs"/>
|
||||||
|
<CursorPos X="3" Y="491"/>
|
||||||
|
<TopLine Value="489"/>
|
||||||
|
<UsageCount Value="113"/>
|
||||||
|
</Unit16>
|
||||||
|
<Unit17>
|
||||||
|
<Filename Value="testmonitorcfg.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="TestMonitorCfg"/>
|
||||||
|
<CursorPos X="5" Y="48"/>
|
||||||
|
<TopLine Value="14"/>
|
||||||
|
<UsageCount Value="168"/>
|
||||||
|
</Unit17>
|
||||||
|
<Unit18>
|
||||||
|
<Filename Value="..\..\..\fpc\2.1\fcl\inc\custapp.pp"/>
|
||||||
|
<UnitName Value="CustApp"/>
|
||||||
|
<CursorPos X="90" Y="25"/>
|
||||||
|
<TopLine Value="8"/>
|
||||||
|
<UsageCount Value="82"/>
|
||||||
|
</Unit18>
|
||||||
|
<Unit19>
|
||||||
|
<Filename Value="..\..\lcl\dialogs.pp"/>
|
||||||
|
<UnitName Value="Dialogs"/>
|
||||||
|
<CursorPos X="17" Y="566"/>
|
||||||
|
<TopLine Value="493"/>
|
||||||
|
<UsageCount Value="79"/>
|
||||||
|
</Unit19>
|
||||||
|
<Unit20>
|
||||||
|
<Filename Value="..\..\..\fpc\2.1\compiler\x86\cgx86.pas"/>
|
||||||
|
<UnitName Value="cgx86"/>
|
||||||
|
<CursorPos X="49" Y="185"/>
|
||||||
|
<TopLine Value="183"/>
|
||||||
|
<UsageCount Value="65"/>
|
||||||
|
</Unit20>
|
||||||
|
<Unit21>
|
||||||
|
<Filename Value="..\..\lcl\interfaces\win32\win32wsmenus.pp"/>
|
||||||
|
<UnitName Value="Win32WSMenus"/>
|
||||||
|
<CursorPos X="7" Y="580"/>
|
||||||
|
<TopLine Value="27"/>
|
||||||
|
<UsageCount Value="8"/>
|
||||||
|
</Unit21>
|
||||||
|
<Unit22>
|
||||||
|
<Filename Value="..\..\..\..\projects\TAGraph\Component\TAGraph.pas"/>
|
||||||
|
<UnitName Value="tagraph"/>
|
||||||
|
<CursorPos X="1" Y="1"/>
|
||||||
|
<TopLine Value="33"/>
|
||||||
|
<UsageCount Value="10"/>
|
||||||
|
</Unit22>
|
||||||
|
<Unit23>
|
||||||
|
<Filename Value="..\..\lcl\graphics.pp"/>
|
||||||
|
<UnitName Value="Graphics"/>
|
||||||
|
<CursorPos X="15" Y="913"/>
|
||||||
|
<TopLine Value="895"/>
|
||||||
|
<UsageCount Value="10"/>
|
||||||
|
</Unit23>
|
||||||
|
<Unit24>
|
||||||
|
<Filename Value="..\..\lcl\interfaces\win32\win32listsl.inc"/>
|
||||||
|
<CursorPos X="21" Y="144"/>
|
||||||
|
<TopLine Value="104"/>
|
||||||
|
<UsageCount Value="10"/>
|
||||||
|
</Unit24>
|
||||||
|
<Unit25>
|
||||||
|
<Filename Value="..\..\..\fpc\2.1\rtl\objpas\classes\stringl.inc"/>
|
||||||
|
<CursorPos X="62" Y="574"/>
|
||||||
|
<TopLine Value="558"/>
|
||||||
|
<UsageCount Value="10"/>
|
||||||
|
</Unit25>
|
||||||
|
<Unit26>
|
||||||
|
<Filename Value="runchecksnapshots.bat"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<CursorPos X="67" Y="1"/>
|
||||||
|
<TopLine Value="1"/>
|
||||||
|
<UsageCount Value="27"/>
|
||||||
|
<SyntaxHighlighter Value="None"/>
|
||||||
|
</Unit26>
|
||||||
|
<Unit27>
|
||||||
|
<Filename Value="..\..\..\fpc\2.1\rtl\inc\wstringh.inc"/>
|
||||||
|
<CursorPos X="10" Y="84"/>
|
||||||
|
<TopLine Value="63"/>
|
||||||
|
<UsageCount Value="12"/>
|
||||||
|
</Unit27>
|
||||||
|
<Unit28>
|
||||||
|
<Filename Value="..\..\..\fpc\2.1\rtl\inc\wstrings.inc"/>
|
||||||
|
<CursorPos X="20" Y="1458"/>
|
||||||
|
<TopLine Value="1458"/>
|
||||||
|
<UsageCount Value="10"/>
|
||||||
|
</Unit28>
|
||||||
|
<Unit29>
|
||||||
|
<Filename Value="..\..\lcl\dbgrids.pas"/>
|
||||||
|
<UnitName Value="DBGrids"/>
|
||||||
|
<CursorPos X="15" Y="590"/>
|
||||||
|
<TopLine Value="586"/>
|
||||||
|
<UsageCount Value="12"/>
|
||||||
|
</Unit29>
|
||||||
|
<Unit30>
|
||||||
|
<Filename Value="..\..\lcl\include\defaultbitbtnimages.inc"/>
|
||||||
|
<CursorPos X="28" Y="513"/>
|
||||||
|
<TopLine Value="477"/>
|
||||||
|
<UsageCount Value="12"/>
|
||||||
|
</Unit30>
|
||||||
|
</Units>
|
||||||
|
<JumpHistory Count="29" HistoryIndex="28">
|
||||||
|
<Position1>
|
||||||
|
<Filename Value="snapshotsuptodate.pas"/>
|
||||||
|
<Caret Line="47" Column="1" TopLine="29"/>
|
||||||
|
</Position1>
|
||||||
|
<Position2>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="148" Column="1" TopLine="130"/>
|
||||||
|
</Position2>
|
||||||
|
<Position3>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="147" Column="1" TopLine="129"/>
|
||||||
|
</Position3>
|
||||||
|
<Position4>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="148" Column="1" TopLine="130"/>
|
||||||
|
</Position4>
|
||||||
|
<Position5>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="147" Column="1" TopLine="129"/>
|
||||||
|
</Position5>
|
||||||
|
<Position6>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="148" Column="1" TopLine="130"/>
|
||||||
|
</Position6>
|
||||||
|
<Position7>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="147" Column="1" TopLine="129"/>
|
||||||
|
</Position7>
|
||||||
|
<Position8>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="148" Column="1" TopLine="130"/>
|
||||||
|
</Position8>
|
||||||
|
<Position9>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="147" Column="1" TopLine="129"/>
|
||||||
|
</Position9>
|
||||||
|
<Position10>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="148" Column="1" TopLine="130"/>
|
||||||
|
</Position10>
|
||||||
|
<Position11>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="147" Column="1" TopLine="129"/>
|
||||||
|
</Position11>
|
||||||
|
<Position12>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="148" Column="1" TopLine="130"/>
|
||||||
|
</Position12>
|
||||||
|
<Position13>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="147" Column="1" TopLine="129"/>
|
||||||
|
</Position13>
|
||||||
|
<Position14>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="148" Column="1" TopLine="130"/>
|
||||||
|
</Position14>
|
||||||
|
<Position15>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="147" Column="1" TopLine="129"/>
|
||||||
|
</Position15>
|
||||||
|
<Position16>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="148" Column="1" TopLine="130"/>
|
||||||
|
</Position16>
|
||||||
|
<Position17>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="147" Column="1" TopLine="129"/>
|
||||||
|
</Position17>
|
||||||
|
<Position18>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="148" Column="1" TopLine="130"/>
|
||||||
|
</Position18>
|
||||||
|
<Position19>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="147" Column="1" TopLine="129"/>
|
||||||
|
</Position19>
|
||||||
|
<Position20>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="148" Column="1" TopLine="130"/>
|
||||||
|
</Position20>
|
||||||
|
<Position21>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="147" Column="1" TopLine="129"/>
|
||||||
|
</Position21>
|
||||||
|
<Position22>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="148" Column="1" TopLine="130"/>
|
||||||
|
</Position22>
|
||||||
|
<Position23>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="147" Column="1" TopLine="129"/>
|
||||||
|
</Position23>
|
||||||
|
<Position24>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="148" Column="1" TopLine="130"/>
|
||||||
|
</Position24>
|
||||||
|
<Position25>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="147" Column="1" TopLine="129"/>
|
||||||
|
</Position25>
|
||||||
|
<Position26>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="178" Column="1" TopLine="126"/>
|
||||||
|
</Position26>
|
||||||
|
<Position27>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="101" Column="35" TopLine="83"/>
|
||||||
|
</Position27>
|
||||||
|
<Position28>
|
||||||
|
<Filename Value="checksnapshots.lpr"/>
|
||||||
|
<Caret Line="6" Column="57" TopLine="1"/>
|
||||||
|
</Position28>
|
||||||
|
<Position29>
|
||||||
|
<Filename Value="ftplistertest.pas"/>
|
||||||
|
<Caret Line="16" Column="30" TopLine="15"/>
|
||||||
|
</Position29>
|
||||||
|
</JumpHistory>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="5"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<CodeGeneration>
|
||||||
|
<Generate Value="Faster"/>
|
||||||
|
</CodeGeneration>
|
||||||
|
<Linking>
|
||||||
|
<LinkSmart Value="True"/>
|
||||||
|
</Linking>
|
||||||
|
<Other>
|
||||||
|
<CompilerPath Value="$(CompPath)"/>
|
||||||
|
</Other>
|
||||||
|
</CompilerOptions>
|
||||||
|
<Debugging>
|
||||||
|
<BreakPoints Count="11">
|
||||||
|
<Item1>
|
||||||
|
<Source Value="..\..\..\source\lazarus\ide\main.pp"/>
|
||||||
|
<Line Value="5295"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<Source Value="..\..\..\source\fpc\2.1\rtl\objpas\classes\stringl.inc"/>
|
||||||
|
<Line Value="188"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<Source Value="..\..\..\source\lazarus\lcl\lresources.pp"/>
|
||||||
|
<Line Value="2114"/>
|
||||||
|
</Item3>
|
||||||
|
<Item4>
|
||||||
|
<Source Value="..\..\..\source\lazarus\lcl\lresources.pp"/>
|
||||||
|
<Line Value="2176"/>
|
||||||
|
</Item4>
|
||||||
|
<Item5>
|
||||||
|
<Source Value="..\..\..\source\lazarus\lcl\lresources.pp"/>
|
||||||
|
<Line Value="1075"/>
|
||||||
|
</Item5>
|
||||||
|
<Item6>
|
||||||
|
<Source Value="..\..\..\source\lazarus\lcl\lresources.pp"/>
|
||||||
|
<Line Value="1077"/>
|
||||||
|
</Item6>
|
||||||
|
<Item7>
|
||||||
|
<Source Value="..\..\..\source\lazarus\ide\main.pp"/>
|
||||||
|
<Line Value="9215"/>
|
||||||
|
</Item7>
|
||||||
|
<Item8>
|
||||||
|
<Source Value="..\..\..\source\lazarus\lcl\lresources.pp"/>
|
||||||
|
<Line Value="2530"/>
|
||||||
|
</Item8>
|
||||||
|
<Item9>
|
||||||
|
<Source Value="snapshotsuptodate.pas"/>
|
||||||
|
<Line Value="47"/>
|
||||||
|
</Item9>
|
||||||
|
<Item10>
|
||||||
|
<Source Value="..\..\..\fpc\fpcprojects\lnet\trunk\lib\lftp.pp"/>
|
||||||
|
<Line Value="904"/>
|
||||||
|
</Item10>
|
||||||
|
<Item11>
|
||||||
|
<Source Value="..\..\..\fpc\fpcprojects\lnet\trunk\lib\lftp.pp"/>
|
||||||
|
<Line Value="903"/>
|
||||||
|
</Item11>
|
||||||
|
</BreakPoints>
|
||||||
|
<Watches Count="1">
|
||||||
|
<Item1>
|
||||||
|
<Expression Value="name"/>
|
||||||
|
</Item1>
|
||||||
|
</Watches>
|
||||||
|
<Exceptions Count="1">
|
||||||
|
<Item1>
|
||||||
|
<Name Value="EAssertionFailedError"/>
|
||||||
|
</Item1>
|
||||||
|
</Exceptions>
|
||||||
|
</Debugging>
|
||||||
|
</CONFIG>
|
||||||
27
tools/snapshots/checksnapshots.lpr
Normal file
27
tools/snapshots/checksnapshots.lpr
Normal file
@ -0,0 +1,27 @@
|
|||||||
|
program checksnapshots;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, consoletestrunner,
|
||||||
|
SnapshotsUptodate, ftplistertest, TestMonitorCfg;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TLazTestRunner }
|
||||||
|
|
||||||
|
TMyTestRunner = class(TTestRunner)
|
||||||
|
protected
|
||||||
|
// override the protected methods of TTestRunner to customize its behavior
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Application: TMyTestRunner;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application := TMyTestRunner.Create(nil);
|
||||||
|
Application.Title:='Lazarus snapshots monitor';
|
||||||
|
Application.Initialize;
|
||||||
|
Application.Run;
|
||||||
|
Application.Free;
|
||||||
|
end.
|
||||||
231
tools/snapshots/checksnapshotsgui.lpi
Normal file
231
tools/snapshots/checksnapshotsgui.lpi
Normal file
@ -0,0 +1,231 @@
|
|||||||
|
<?xml version="1.0"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<Version Value="5"/>
|
||||||
|
<General>
|
||||||
|
<MainUnit Value="0"/>
|
||||||
|
<IconPath Value="./"/>
|
||||||
|
<TargetFileExt Value=".exe"/>
|
||||||
|
<ActiveEditorIndexAtStart Value="0"/>
|
||||||
|
</General>
|
||||||
|
<VersionInfo>
|
||||||
|
<ProjectVersion Value=""/>
|
||||||
|
<Language Value=""/>
|
||||||
|
<CharSet Value=""/>
|
||||||
|
</VersionInfo>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
<IgnoreBinaries Value="False"/>
|
||||||
|
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||||
|
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<RunParams>
|
||||||
|
<local>
|
||||||
|
<FormatVersion Value="1"/>
|
||||||
|
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||||
|
</local>
|
||||||
|
</RunParams>
|
||||||
|
<RequiredPackages Count="4">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="lnetbase"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<PackageName Value="FPCUnitTestRunner"/>
|
||||||
|
</Item3>
|
||||||
|
<Item4>
|
||||||
|
<PackageName Value="FCL"/>
|
||||||
|
</Item4>
|
||||||
|
</RequiredPackages>
|
||||||
|
<Units Count="14">
|
||||||
|
<Unit0>
|
||||||
|
<Filename Value="checksnapshotsgui.lpr"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="checksnapshotsgui"/>
|
||||||
|
<CursorPos X="21" Y="14"/>
|
||||||
|
<TopLine Value="1"/>
|
||||||
|
<EditorIndex Value="0"/>
|
||||||
|
<UsageCount Value="127"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit0>
|
||||||
|
<Unit1>
|
||||||
|
<Filename Value="..\..\components\fpcunit\guitestrunner.pas"/>
|
||||||
|
<UnitName Value="GuiTestRunner"/>
|
||||||
|
<CursorPos X="3" Y="38"/>
|
||||||
|
<TopLine Value="20"/>
|
||||||
|
<EditorIndex Value="6"/>
|
||||||
|
<UsageCount Value="63"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit1>
|
||||||
|
<Unit2>
|
||||||
|
<Filename Value="..\..\..\fpc\2.1\compiler\systems\i_linux.pas"/>
|
||||||
|
<UnitName Value="i_linux"/>
|
||||||
|
<CursorPos X="44" Y="477"/>
|
||||||
|
<TopLine Value="527"/>
|
||||||
|
<EditorIndex Value="7"/>
|
||||||
|
<UsageCount Value="63"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit2>
|
||||||
|
<Unit3>
|
||||||
|
<Filename Value="..\..\ide\buildlazdialog.pas"/>
|
||||||
|
<UnitName Value="BuildLazDialog"/>
|
||||||
|
<CursorPos X="44" Y="496"/>
|
||||||
|
<TopLine Value="478"/>
|
||||||
|
<EditorIndex Value="8"/>
|
||||||
|
<UsageCount Value="63"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit3>
|
||||||
|
<Unit4>
|
||||||
|
<Filename Value="monitorcfg.pas"/>
|
||||||
|
<UnitName Value="MonitorCfg"/>
|
||||||
|
<CursorPos X="1" Y="131"/>
|
||||||
|
<TopLine Value="107"/>
|
||||||
|
<EditorIndex Value="9"/>
|
||||||
|
<UsageCount Value="63"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit4>
|
||||||
|
<Unit5>
|
||||||
|
<Filename Value="testmonitorcfg.pas"/>
|
||||||
|
<UnitName Value="TestMonitorCfg"/>
|
||||||
|
<CursorPos X="32" Y="32"/>
|
||||||
|
<TopLine Value="8"/>
|
||||||
|
<EditorIndex Value="12"/>
|
||||||
|
<UsageCount Value="63"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit5>
|
||||||
|
<Unit6>
|
||||||
|
<Filename Value="monitorconfig.xml"/>
|
||||||
|
<CursorPos X="82" Y="16"/>
|
||||||
|
<TopLine Value="1"/>
|
||||||
|
<EditorIndex Value="10"/>
|
||||||
|
<UsageCount Value="63"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
<SyntaxHighlighter Value="XML"/>
|
||||||
|
</Unit6>
|
||||||
|
<Unit7>
|
||||||
|
<Filename Value="..\..\lcl\include\customform.inc"/>
|
||||||
|
<CursorPos X="8" Y="1064"/>
|
||||||
|
<TopLine Value="1044"/>
|
||||||
|
<EditorIndex Value="11"/>
|
||||||
|
<UsageCount Value="63"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit7>
|
||||||
|
<Unit8>
|
||||||
|
<Filename Value="..\..\lcl\lresources.pp"/>
|
||||||
|
<UnitName Value="LResources"/>
|
||||||
|
<CursorPos X="1" Y="2607"/>
|
||||||
|
<TopLine Value="2589"/>
|
||||||
|
<EditorIndex Value="13"/>
|
||||||
|
<UsageCount Value="23"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit8>
|
||||||
|
<Unit9>
|
||||||
|
<Filename Value="checksnapshots.lpr"/>
|
||||||
|
<UnitName Value="checksnapshots"/>
|
||||||
|
<CursorPos X="1" Y="8"/>
|
||||||
|
<TopLine Value="1"/>
|
||||||
|
<EditorIndex Value="4"/>
|
||||||
|
<UsageCount Value="23"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit9>
|
||||||
|
<Unit10>
|
||||||
|
<Filename Value="snapshotsuptodate.pas"/>
|
||||||
|
<UnitName Value="SnapshotsUptodate"/>
|
||||||
|
<CursorPos X="47" Y="8"/>
|
||||||
|
<TopLine Value="5"/>
|
||||||
|
<EditorIndex Value="1"/>
|
||||||
|
<UsageCount Value="23"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit10>
|
||||||
|
<Unit11>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<UnitName Value="ftplister"/>
|
||||||
|
<CursorPos X="28" Y="91"/>
|
||||||
|
<TopLine Value="63"/>
|
||||||
|
<EditorIndex Value="2"/>
|
||||||
|
<UsageCount Value="23"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit11>
|
||||||
|
<Unit12>
|
||||||
|
<Filename Value="..\..\..\fpc\2.1\rtl\objpas\sysutils\dati.inc"/>
|
||||||
|
<CursorPos X="1" Y="489"/>
|
||||||
|
<TopLine Value="471"/>
|
||||||
|
<EditorIndex Value="3"/>
|
||||||
|
<UsageCount Value="23"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit12>
|
||||||
|
<Unit13>
|
||||||
|
<Filename Value="ftplistertest.pas"/>
|
||||||
|
<UnitName Value="ftplistertest"/>
|
||||||
|
<CursorPos X="25" Y="60"/>
|
||||||
|
<TopLine Value="45"/>
|
||||||
|
<EditorIndex Value="5"/>
|
||||||
|
<UsageCount Value="15"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit13>
|
||||||
|
</Units>
|
||||||
|
<JumpHistory Count="9" HistoryIndex="8">
|
||||||
|
<Position1>
|
||||||
|
<Filename Value="checksnapshots.lpr"/>
|
||||||
|
<Caret Line="7" Column="28" TopLine="1"/>
|
||||||
|
</Position1>
|
||||||
|
<Position2>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="145" Column="1" TopLine="130"/>
|
||||||
|
</Position2>
|
||||||
|
<Position3>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="25" Column="32" TopLine="6"/>
|
||||||
|
</Position3>
|
||||||
|
<Position4>
|
||||||
|
<Filename Value="checksnapshotsgui.lpr"/>
|
||||||
|
<Caret Line="8" Column="1" TopLine="1"/>
|
||||||
|
</Position4>
|
||||||
|
<Position5>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="59" Column="16" TopLine="61"/>
|
||||||
|
</Position5>
|
||||||
|
<Position6>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="85" Column="10" TopLine="67"/>
|
||||||
|
</Position6>
|
||||||
|
<Position7>
|
||||||
|
<Filename Value="ftplister.pas"/>
|
||||||
|
<Caret Line="91" Column="16" TopLine="73"/>
|
||||||
|
</Position7>
|
||||||
|
<Position8>
|
||||||
|
<Filename Value="checksnapshotsgui.lpr"/>
|
||||||
|
<Caret Line="8" Column="1" TopLine="1"/>
|
||||||
|
</Position8>
|
||||||
|
<Position9>
|
||||||
|
<Filename Value="checksnapshotsgui.lpr"/>
|
||||||
|
<Caret Line="7" Column="28" TopLine="1"/>
|
||||||
|
</Position9>
|
||||||
|
</JumpHistory>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="5"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<CodeGeneration>
|
||||||
|
<Generate Value="Faster"/>
|
||||||
|
</CodeGeneration>
|
||||||
|
<Other>
|
||||||
|
<CompilerPath Value="$(CompPath)"/>
|
||||||
|
</Other>
|
||||||
|
</CompilerOptions>
|
||||||
|
<Debugging>
|
||||||
|
<Watches Count="1">
|
||||||
|
<Item1>
|
||||||
|
<Expression Value="name"/>
|
||||||
|
</Item1>
|
||||||
|
</Watches>
|
||||||
|
<Exceptions Count="1">
|
||||||
|
<Item1>
|
||||||
|
<Name Value="EAssertionFailedError"/>
|
||||||
|
</Item1>
|
||||||
|
</Exceptions>
|
||||||
|
</Debugging>
|
||||||
|
</CONFIG>
|
||||||
14
tools/snapshots/checksnapshotsgui.lpr
Normal file
14
tools/snapshots/checksnapshotsgui.lpr
Normal file
@ -0,0 +1,14 @@
|
|||||||
|
program checksnapshotsgui;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
Interfaces, Forms, GuiTestRunner,
|
||||||
|
SnapshotsUptodate, ftplistertest, TestMonitorCfg;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application.Initialize;
|
||||||
|
Application.CreateForm(TGuiTestRunner, TestRunner);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
|
|
||||||
188
tools/snapshots/ftplister.pas
Normal file
188
tools/snapshots/ftplister.pas
Normal file
@ -0,0 +1,188 @@
|
|||||||
|
unit ftplister;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
classes, sysutils,
|
||||||
|
lnet, lftp;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TFTPLister }
|
||||||
|
|
||||||
|
TFTPLister = class
|
||||||
|
private
|
||||||
|
FFtp: TLFTPClient;
|
||||||
|
FInternalStatus: TLFTPStatus;
|
||||||
|
FDirList: string;
|
||||||
|
procedure FtpError(const msg: string; aSocket: TLSocket);
|
||||||
|
procedure FtpConnect(Sender: TLSocket);
|
||||||
|
procedure FtpControl(Sender: TLSocket);
|
||||||
|
procedure FtpReceive(Sender: TLSocket);
|
||||||
|
procedure FtpSuccess(Sender: TLSocket; const aStatus: TLFTPStatus);
|
||||||
|
procedure FtpFailure(Sender: TLSocket; const aStatus: TLFTPStatus);
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
function GetList(const server, dir: string): TStrings;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TFtpFile }
|
||||||
|
|
||||||
|
TFtpFile = class
|
||||||
|
private
|
||||||
|
FFileDate: TDateTime;
|
||||||
|
FFileName: string;
|
||||||
|
public
|
||||||
|
constructor Create(AListLine: string);
|
||||||
|
property FileName : string read FFileName;
|
||||||
|
property FileDate : TDateTime read FFileDate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
const
|
||||||
|
MonthNames : array[1..12] of string[3] =
|
||||||
|
('JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN',
|
||||||
|
'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC');
|
||||||
|
|
||||||
|
constructor TFtpFile.Create(AListLine: string);
|
||||||
|
{ example line
|
||||||
|
lrwxrwxrwx 1 0 0 7 Jun 07 19:12 fpc -> pub/fpc
|
||||||
|
-rw-r--r-- 1 1003 100 52533164 Jul 07 2006 lazarus-arm-wince-20060707.7z
|
||||||
|
}
|
||||||
|
var
|
||||||
|
datestr: string;
|
||||||
|
month:integer;
|
||||||
|
year: string;
|
||||||
|
timestr: string;
|
||||||
|
|
||||||
|
procedure ParseMonth(Name: string);
|
||||||
|
begin
|
||||||
|
Name := uppercase(Name);
|
||||||
|
//writeln('Month: ', Name);
|
||||||
|
month := 1;
|
||||||
|
while (Name<>MonthNames[month]) and (month<high(MonthNames)) do
|
||||||
|
inc(month);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetCurrentYear: string;
|
||||||
|
var
|
||||||
|
d,m,y: word;
|
||||||
|
begin
|
||||||
|
DecodeDate(Now, y, m, d);
|
||||||
|
Result := IntToStr(y);
|
||||||
|
end;
|
||||||
|
begin
|
||||||
|
FFileName := copy(AListLine, 57, length(AListLine)-56);
|
||||||
|
//writeln(FFileName);
|
||||||
|
ParseMonth(copy(AListLine, 44, 3));
|
||||||
|
TimeStr := copy(AListLine, 51, 5);
|
||||||
|
if pos(':', timestr)=0 then begin
|
||||||
|
Year := Trim(timestr);
|
||||||
|
timestr := '';
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Year := GetCurrentYear;
|
||||||
|
datestr := copy(AListLine, 48, 2) + '-' + IntToStr(month) + '-'+ Year +
|
||||||
|
' ' + timestr;
|
||||||
|
ShortDateFormat := 'dd-mm-yyyy';
|
||||||
|
FFileDate := StrToDateTime(datestr);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TFPTLister }
|
||||||
|
|
||||||
|
procedure TFTPLister.FtpReceive(Sender: TLSocket);
|
||||||
|
var
|
||||||
|
s: string;
|
||||||
|
begin
|
||||||
|
Write('D:');
|
||||||
|
s := FFtp.GetDataMessage;
|
||||||
|
if FInternalStatus = fsCWD then
|
||||||
|
FDirList := FDirList + s;
|
||||||
|
Writeln(s);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFTPLister.FtpSuccess(Sender: TLSocket; const aStatus: TLFTPStatus);
|
||||||
|
begin
|
||||||
|
FInternalStatus := aStatus;
|
||||||
|
Writeln('Success on status: ' + FTPStatusToStr(aStatus));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFTPLister.FtpFailure(Sender: TLSocket; const aStatus: TLFTPStatus);
|
||||||
|
begin
|
||||||
|
Writeln('Failure on status: ' + FTPStatusToStr(aStatus));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFTPLister.FtpError(const msg: string; aSocket: TLSocket);
|
||||||
|
begin
|
||||||
|
Writeln('Error: ', msg);
|
||||||
|
RunError(99);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFTPLister.FtpConnect(Sender: TLSocket);
|
||||||
|
begin
|
||||||
|
writeln('Connected');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFTPLister.FtpControl(Sender: TLSocket);
|
||||||
|
var
|
||||||
|
s: string;
|
||||||
|
begin
|
||||||
|
if FFtp.GetMessage(s) > 0 then
|
||||||
|
writeln('C: ', s);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TFTPLister.Create;
|
||||||
|
begin
|
||||||
|
FInternalStatus := fsNone;
|
||||||
|
|
||||||
|
FFtp := TLFTPClient.Create(nil);
|
||||||
|
|
||||||
|
FFtp.StatusSet := [fsAuth, fsType, fsCon, fsCWD, fsList]; // let's watch for these only, these will call OnSuccess or OnFailure
|
||||||
|
FFtp.PipeLine := False; // this means CLIENT pipeline emulation
|
||||||
|
FFtp.Timeout := 100;
|
||||||
|
FFtp.OnConnect := @FtpConnect;
|
||||||
|
FFtp.OnError := @FtpError;
|
||||||
|
FFtp.OnReceive := @FtpReceive;
|
||||||
|
FFtp.OnControl := @FtpControl;
|
||||||
|
FFtp.OnSuccess := @FtpSuccess; // reports when "watched" status succesfuly finishes
|
||||||
|
FFtp.OnFailure := @FtpFailure; // --||-- fails
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TFTPLister.Destroy;
|
||||||
|
begin
|
||||||
|
FFtp.Free;
|
||||||
|
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFTPLister.GetList(const server, dir: string): TStrings;
|
||||||
|
begin
|
||||||
|
Result := TStringList.Create;
|
||||||
|
FFtp.Connect(server);
|
||||||
|
|
||||||
|
repeat
|
||||||
|
FFtp.CallAction;
|
||||||
|
until FFtp.Connected;
|
||||||
|
|
||||||
|
{ until here it's same }
|
||||||
|
|
||||||
|
{ Let's send all the commands at once (beware shitty servers, set pipeline to false for them) }
|
||||||
|
FFtp.Authenticate('anonymous', '');
|
||||||
|
FFtp.Binary:=True;
|
||||||
|
FFtp.ChangeDirectory(dir);
|
||||||
|
FFtp.List();
|
||||||
|
|
||||||
|
repeat
|
||||||
|
FFtp.CallAction;
|
||||||
|
until FInternalStatus = fsList; // we increate the status per successful operation
|
||||||
|
|
||||||
|
Result.Text := FDirList;
|
||||||
|
FFtp.Disconnect;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
81
tools/snapshots/ftplistertest.pas
Normal file
81
tools/snapshots/ftplistertest.pas
Normal file
@ -0,0 +1,81 @@
|
|||||||
|
unit ftplistertest;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, ftplister,
|
||||||
|
fpcunit, testregistry;
|
||||||
|
|
||||||
|
{ TFtpListerTestcase }
|
||||||
|
type
|
||||||
|
TFtpListerTestcase= class(TTestCase)
|
||||||
|
private
|
||||||
|
function GetFiles: TStrings;
|
||||||
|
property Files : TStrings read GetFiles;
|
||||||
|
published
|
||||||
|
procedure TestHookUp;
|
||||||
|
procedure TestFtpFile;
|
||||||
|
procedure TestOldFtpFile;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
var
|
||||||
|
FileList: TStrings;
|
||||||
|
|
||||||
|
function TFtpListerTestcase.GetFiles: TStrings;
|
||||||
|
var
|
||||||
|
FtpLister : TFTPLister;
|
||||||
|
begin
|
||||||
|
if FileList=nil then begin
|
||||||
|
FTPLister := TFTPLister.Create;
|
||||||
|
FileList := FTPLister.GetList('ftp.hu.freepascal.org', '/pub/lazarus');
|
||||||
|
FTPLister.Free;
|
||||||
|
end;
|
||||||
|
Result := FileList;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFtpListerTestcase.TestHookUp;
|
||||||
|
begin
|
||||||
|
AssertTrue('No files retrieved', Files.Count>0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFtpListerTestcase.TestFtpFile;
|
||||||
|
var
|
||||||
|
FtpFile : TFtpFile;
|
||||||
|
const
|
||||||
|
FtpLine = '-rw-r--r-- 1 1003 100 43560307 Oct 22 14:34 Lazarus-0.9.19-fpc-2.0.4-20061022-win32.exe';
|
||||||
|
begin
|
||||||
|
FtpFile := TFtpFile.Create(FtpLine);
|
||||||
|
try
|
||||||
|
AssertEquals('Wrong file name:', 'Lazarus-0.9.19-fpc-2.0.4-20061022-win32.exe', FtpFile.FileName);
|
||||||
|
AssertEquals('Wrong file date', '22-10-2006 14:34', DateTimeToStr(FtpFile.FileDate));
|
||||||
|
finally
|
||||||
|
FtpFile.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFtpListerTestcase.TestOldFtpFile;
|
||||||
|
var
|
||||||
|
FtpFile : TFtpFile;
|
||||||
|
const
|
||||||
|
FtpLine = '-rw-r--r-- 1 1003 100 52533164 Jul 07 2006 lazarus-arm-wince-20060707.7z';
|
||||||
|
begin
|
||||||
|
FtpFile := TFtpFile.Create(FtpLine);
|
||||||
|
try
|
||||||
|
AssertEquals('Wrong file date', '07-07-2006', DateTimeToStr(FtpFile.FileDate));
|
||||||
|
finally
|
||||||
|
FtpFile.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
RegisterTest(TFtpListerTestcase);
|
||||||
|
|
||||||
|
finalization
|
||||||
|
FileList.Free;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
192
tools/snapshots/monitorcfg.pas
Normal file
192
tools/snapshots/monitorcfg.pas
Normal file
@ -0,0 +1,192 @@
|
|||||||
|
unit MonitorCfg;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
contnrs, dom, xmlread;
|
||||||
|
|
||||||
|
type
|
||||||
|
TServerType = (stFtp, stHttp);
|
||||||
|
|
||||||
|
TServer = class;
|
||||||
|
TFile = class;
|
||||||
|
|
||||||
|
{ TMonitorConfig }
|
||||||
|
|
||||||
|
TMonitorConfig = class
|
||||||
|
private
|
||||||
|
FFileName: string;
|
||||||
|
FServers: TFPObjectList;
|
||||||
|
function GetServer(index: integer): TServer;
|
||||||
|
function GetServerCount: integer;
|
||||||
|
procedure AddServer(const ServerNode: TDOMNode);
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure Load(const AFileName: string);
|
||||||
|
procedure AddServer(AServer: TServer);
|
||||||
|
property FileName: string read FFileName write FFileName;
|
||||||
|
property Servers[index: integer] : TServer read GetServer;
|
||||||
|
property ServerCount: integer read GetServerCount;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TServer }
|
||||||
|
|
||||||
|
TServer = class
|
||||||
|
private
|
||||||
|
FFiles: TFPObjectList;
|
||||||
|
FDescription: string;
|
||||||
|
FServerType: TServerType;
|
||||||
|
function GetFile(index: integer): TFile;
|
||||||
|
function GetFileCount: integer;
|
||||||
|
procedure AddFile(const ServerNode: TDOMNode);
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure AddFile(AFile: TFile);
|
||||||
|
property Description : string read FDescription write FDescription;
|
||||||
|
property ServerType : TServerType read FServerType write FServerType;
|
||||||
|
property Files[index: integer] : TFile read GetFile;
|
||||||
|
property FileCount: integer read GetFileCount;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TFile }
|
||||||
|
|
||||||
|
TFile = class
|
||||||
|
private
|
||||||
|
FDescription: string;
|
||||||
|
FMask: string;
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
property Mask: string read FMask write FMask;
|
||||||
|
property Description: string read FDescription write FDescription;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TServer }
|
||||||
|
|
||||||
|
function TServer.GetFile(index: integer): TFile;
|
||||||
|
begin
|
||||||
|
Result := TFile(FFiles[index]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TServer.GetFileCount: integer;
|
||||||
|
begin
|
||||||
|
Result := FFiles.Count;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TServer.AddFile(const ServerNode: TDOMNode);
|
||||||
|
var
|
||||||
|
NewFile: TFile;
|
||||||
|
Attribute: TDOMNode;
|
||||||
|
begin
|
||||||
|
NewFile := TFile.Create;
|
||||||
|
Attribute := ServerNode.Attributes.GetNamedItem('Description');
|
||||||
|
if assigned(Attribute) then
|
||||||
|
NewFile.Description := Attribute.NodeValue;
|
||||||
|
Attribute := ServerNode.Attributes.GetNamedItem('Mask');
|
||||||
|
if assigned(Attribute) then
|
||||||
|
NewFile.Mask := Attribute.NodeValue;
|
||||||
|
AddFile(NewFile);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TServer.Create;
|
||||||
|
begin
|
||||||
|
FFiles := TFPObjectList.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TServer.Destroy;
|
||||||
|
begin
|
||||||
|
FFiles.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TServer.AddFile(AFile: TFile);
|
||||||
|
begin
|
||||||
|
FFiles.Add(AFile);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TFile }
|
||||||
|
|
||||||
|
constructor TFile.Create;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TMonitorConfig }
|
||||||
|
|
||||||
|
function TMonitorConfig.GetServer(index: integer): TServer;
|
||||||
|
begin
|
||||||
|
Result := TServer(FServers[index]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMonitorConfig.GetServerCount: integer;
|
||||||
|
begin
|
||||||
|
Result := FServers.Count;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMonitorConfig.AddServer(const ServerNode: TDOMNode);
|
||||||
|
var
|
||||||
|
Server: TServer;
|
||||||
|
Attribute: TDOMNode;
|
||||||
|
Node: TDomNode;
|
||||||
|
begin
|
||||||
|
Server := TServer.Create;
|
||||||
|
Attribute := ServerNode.Attributes.GetNamedItem('Name');
|
||||||
|
if assigned(Attribute) then
|
||||||
|
Server.Description := Attribute.NodeValue;
|
||||||
|
Attribute := ServerNode.Attributes.GetNamedItem('Type');
|
||||||
|
if assigned(Attribute) then
|
||||||
|
if Attribute.NodeValue='ftp' then
|
||||||
|
Server.ServerType := stFtp
|
||||||
|
else if Attribute.NodeValue='http' then
|
||||||
|
Server.ServerType := stHttp;
|
||||||
|
Node := ServerNode.FirstChild;
|
||||||
|
while Node<>nil do begin
|
||||||
|
if Node.NodeName='File' then
|
||||||
|
Server.AddFile(Node);
|
||||||
|
Node := Node.NextSibling;
|
||||||
|
end;
|
||||||
|
AddServer(Server);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TMonitorConfig.Create;
|
||||||
|
begin
|
||||||
|
FServers := TFPObjectList.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TMonitorConfig.Destroy;
|
||||||
|
begin
|
||||||
|
FServers.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMonitorConfig.Load(const AFileName: string);
|
||||||
|
var
|
||||||
|
XmlDoc: TXMLDocument;
|
||||||
|
Node: TDomNode;
|
||||||
|
begin
|
||||||
|
FFileName := AFileName;
|
||||||
|
XmlDoc := nil;
|
||||||
|
try
|
||||||
|
ReadXMLFile(XmlDoc, FileName);
|
||||||
|
Node := XmlDoc.DocumentElement.FirstChild;
|
||||||
|
while Node<>nil do begin
|
||||||
|
if Node.NodeName='Server' then
|
||||||
|
AddServer(Node);
|
||||||
|
Node := Node.NextSibling;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
XmlDoc.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMonitorConfig.AddServer(AServer: TServer);
|
||||||
|
begin
|
||||||
|
FServers.Add(AServer);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
77
tools/snapshots/monitorconfig.xml
Normal file
77
tools/snapshots/monitorconfig.xml
Normal file
@ -0,0 +1,77 @@
|
|||||||
|
<?xml version="1.0" ?>
|
||||||
|
<CONFIG LazVersion="0.9.21">
|
||||||
|
<Server Type="ftp" Name="Snapshot on scenergy">
|
||||||
|
<File
|
||||||
|
Mask="lazarus-0.9.21-*-src.zip"
|
||||||
|
Description="Lazarus source zip"
|
||||||
|
/>
|
||||||
|
<File
|
||||||
|
Mask="lazarus-0.9.21-*-src.tar.bz2"
|
||||||
|
Description="Lazarus source bzip2"
|
||||||
|
/>
|
||||||
|
<File
|
||||||
|
Mask="Lazarus-0.9.21-fpc-2.0.4-*-win32.exe"
|
||||||
|
Description="Lazarus win32 fpc 2.0.4"
|
||||||
|
/>
|
||||||
|
<File
|
||||||
|
Mask="Lazarus-0.9.21-fpc-2.1.1-*-win32.exe"
|
||||||
|
Description="Lazarus win32 fpc 2.1.1"
|
||||||
|
/>
|
||||||
|
<File
|
||||||
|
Mask="Lazarus-0.9.21-fpc-2.1.1-*-win64.exe"
|
||||||
|
Description="Lazarus win64 fpc 2.1.1"
|
||||||
|
/>
|
||||||
|
<File
|
||||||
|
Mask="fpc-2.0.4-*-powerpc-macosx.dmg"
|
||||||
|
Description="fpc 2.0.4 Mac OS X powerpc"
|
||||||
|
/>
|
||||||
|
<File
|
||||||
|
Mask="fpcsrc-2.0.4-*-powerpc-macosx.dmg"
|
||||||
|
Description="fpc source 2.0.4 Mac OS X powerpc"
|
||||||
|
/>
|
||||||
|
<File
|
||||||
|
Mask="lazarus-0.9.21-*-powerpc-macosx.dmg"
|
||||||
|
Description="lazarus Mac OS X powerpc"
|
||||||
|
/>
|
||||||
|
<File
|
||||||
|
Mask="fpc-2.1.1-*-i386-macosx.dmg"
|
||||||
|
Description="fpc 2.1.1 Mac OS X i386"
|
||||||
|
/>
|
||||||
|
<File
|
||||||
|
Mask="fpcsrc-2.1.1-*-i386-macosx.dmg"
|
||||||
|
Description="fpc source 2.1.1 Mac OS X i386"
|
||||||
|
/>
|
||||||
|
<File
|
||||||
|
Mask="lazarus-0.9.21-*-i386-macosx.dmg"
|
||||||
|
Description="lazarus Mac OS X i386"
|
||||||
|
/>
|
||||||
|
<File
|
||||||
|
Mask="fpc-2.0.4-*.src.rpm"
|
||||||
|
Description="fpc 2.0.4 source rpm"
|
||||||
|
/>
|
||||||
|
<File
|
||||||
|
Mask="fpc-2.0.4-*.i386.rpm"
|
||||||
|
Description="fpc 2.0.4 i386 rpm"
|
||||||
|
/>
|
||||||
|
<File
|
||||||
|
Mask="fpc-src-2.0.4-*.i386.rpm"
|
||||||
|
Description="fpc source 2.0.4 i386 rpm"
|
||||||
|
/>
|
||||||
|
<File
|
||||||
|
Mask="lazarus-*.i386.rpm"
|
||||||
|
Description="lazarus i386 rpm"
|
||||||
|
/>
|
||||||
|
<File
|
||||||
|
Mask="fpc-2.0.4-*.x86_64.rpm"
|
||||||
|
Description="fpc 2.0.4 x86_64 rpm"
|
||||||
|
/>
|
||||||
|
<File
|
||||||
|
Mask="fpc-src-2.0.4-*.x86_64.rpm"
|
||||||
|
Description="fpc source 2.0.4 x86_64 rpm"
|
||||||
|
/>
|
||||||
|
<File
|
||||||
|
Mask="lazarus-*.x86_64.rpm"
|
||||||
|
Description="lazarus x86_64 rpm"
|
||||||
|
/>
|
||||||
|
</Server>
|
||||||
|
</CONFIG>
|
||||||
1
tools/snapshots/runchecksnapshots.bat
Normal file
1
tools/snapshots/runchecksnapshots.bat
Normal file
@ -0,0 +1 @@
|
|||||||
|
checksnapshots.exe -all -p --file=monitor.xml --stylesheet=fpcunit.xsl --format=xml
|
||||||
165
tools/snapshots/snapshotsuptodate.pas
Normal file
165
tools/snapshots/snapshotsuptodate.pas
Normal file
@ -0,0 +1,165 @@
|
|||||||
|
unit SnapshotsUptodate;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, fpcunit, testregistry, ftplister;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TFtpMonitorTestcase }
|
||||||
|
|
||||||
|
TFtpMonitorTestcase= class(TTestCase)
|
||||||
|
private
|
||||||
|
FFileMask: string;
|
||||||
|
FName: string;
|
||||||
|
FMatchingFiles: TStrings;
|
||||||
|
function GetFiles: TStrings;
|
||||||
|
function GetMatchingFiles: TStrings;
|
||||||
|
property Files : TStrings read GetFiles;
|
||||||
|
property MatchingFiles: TStrings read GetMatchingFiles;
|
||||||
|
public
|
||||||
|
class function FileMaskSuite(const AName, AFileMask: string): TTestSuite;
|
||||||
|
constructor Create(const AName, AFileMask, ATestName: string);
|
||||||
|
destructor Destroy; override;
|
||||||
|
published
|
||||||
|
procedure TestHookUp;
|
||||||
|
procedure NumberOfFiles;
|
||||||
|
procedure IsUptodateTest;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
monitorcfg;
|
||||||
|
|
||||||
|
var
|
||||||
|
FileList: TStrings;
|
||||||
|
|
||||||
|
function TFtpMonitorTestcase.GetFiles: TStrings;
|
||||||
|
var
|
||||||
|
FtpLister : TFTPLister;
|
||||||
|
begin
|
||||||
|
if FileList=nil then begin
|
||||||
|
FTPLister := TFTPLister.Create;
|
||||||
|
FileList := FTPLister.GetList('ftp.hu.freepascal.org', '/pub/lazarus');
|
||||||
|
FTPLister.Free;
|
||||||
|
end;
|
||||||
|
Result := FileList;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFtpMonitorTestcase.GetMatchingFiles: TStrings;
|
||||||
|
var
|
||||||
|
i: integer;
|
||||||
|
starpos: integer;
|
||||||
|
FirstPart, LastPart: string;
|
||||||
|
FtpFile : TFtpFile;
|
||||||
|
begin
|
||||||
|
if not assigned(FMatchingFiles) then begin
|
||||||
|
starpos := pos('*', FFileMask);
|
||||||
|
if starpos=0 then
|
||||||
|
Fail('Invalid Filemask: '+ FFileMask);
|
||||||
|
FirstPart := Copy(FFileMask, 1, starpos-1);
|
||||||
|
LastPart := Copy(FFileMask, starpos + 1, Length(FFileMask)-starpos);
|
||||||
|
FMatchingFiles := TStringList.Create;
|
||||||
|
for i := 0 to Files.Count-1 do begin
|
||||||
|
FtpFile := TFtpFile.Create(Files[i]);
|
||||||
|
if (copy(FtpFile.FileName, 1, starpos-1)=FirstPart)
|
||||||
|
and (copy(FtpFile.FileName, Length(FtpFile.FileName)-Length(LastPart)+1, Length(LastPart))=LastPart) then
|
||||||
|
FMatchingFiles.AddObject(FtpFile.FileName, FtpFile)
|
||||||
|
else
|
||||||
|
FtpFile.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Result := FMatchingFiles;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class function TFtpMonitorTestcase.FileMaskSuite(const AName, AFileMask: string
|
||||||
|
): TTestSuite;
|
||||||
|
begin
|
||||||
|
Result := TTestSuite.Create(AName);
|
||||||
|
Result.AddTest(Create(AName, AFileMask, 'NumberOfFiles'));
|
||||||
|
Result.AddTest(Create(AName, AFileMask, 'IsUptodateTest'));
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TFtpMonitorTestcase.Create(const AName, AFileMask, ATestName: string);
|
||||||
|
begin
|
||||||
|
inherited CreateWithName(ATestName);
|
||||||
|
FName := AName;
|
||||||
|
FFileMask := AFileMask;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TFtpMonitorTestcase.Destroy;
|
||||||
|
var
|
||||||
|
i: integer;
|
||||||
|
begin
|
||||||
|
if assigned(FMatchingFiles) then begin
|
||||||
|
for i := 0 to FMatchingFiles.Count-1 do
|
||||||
|
FMatchingFiles.Objects[i].Free;
|
||||||
|
FMatchingFiles.Free;
|
||||||
|
end;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFtpMonitorTestcase.TestHookUp;
|
||||||
|
begin
|
||||||
|
AssertTrue('No files retrieved', Files.Count>0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFtpMonitorTestcase.NumberOfFiles;
|
||||||
|
begin
|
||||||
|
AssertEquals('Wrong number of file matches for '+ FName, 1, MatchingFiles.Count);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFtpMonitorTestcase.IsUptodateTest;
|
||||||
|
var
|
||||||
|
FtpFile: TFtpFile;
|
||||||
|
begin
|
||||||
|
AssertTrue(MatchingFiles.Count>0);
|
||||||
|
FtpFile := TFtpFile(MatchingFiles.Objects[0]);
|
||||||
|
AssertTrue(
|
||||||
|
FtpFile.FileName +' is too old: ' + DateTimeToStr(FtpFile.FileDate),
|
||||||
|
(Now - FtpFile.FileDate) < 1.0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure InitFromXml;
|
||||||
|
var
|
||||||
|
MonitorConfig: TMonitorConfig;
|
||||||
|
ServerIdx: integer;
|
||||||
|
|
||||||
|
function CreateFileTestSuite(AFile: TFile) : TTestSuite;
|
||||||
|
begin
|
||||||
|
with AFile do
|
||||||
|
Result := TFtpMonitorTestcase.FileMaskSuite(Description, Mask);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CreateFtpServerTestSuite(Server: TServer): TTestSuite;
|
||||||
|
var
|
||||||
|
FileIdx: integer;
|
||||||
|
begin
|
||||||
|
Result := TTestSuite.Create(Server.Description);
|
||||||
|
for FileIdx := 0 to Server.FileCount-1 do
|
||||||
|
Result.AddTest(CreateFileTestSuite(Server.Files[FileIdx]));
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
MonitorConfig := TMonitorConfig.Create;
|
||||||
|
try
|
||||||
|
MonitorConfig.Load(ExtractFilePath(ParamStr(0)) + 'monitorconfig.xml');
|
||||||
|
for ServerIdx := 0 to MonitorConfig.ServerCount-1 do
|
||||||
|
GetTestRegistry.AddTest(
|
||||||
|
CreateFtpServerTestSuite(MonitorConfig.Servers[ServerIdx]));
|
||||||
|
finally
|
||||||
|
MonitorConfig.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
FileList := nil;
|
||||||
|
InitFromXml;
|
||||||
|
finalization
|
||||||
|
FreeAndNil(FileList);
|
||||||
|
end.
|
||||||
|
|
||||||
50
tools/snapshots/testmonitorcfg.pas
Normal file
50
tools/snapshots/testmonitorcfg.pas
Normal file
@ -0,0 +1,50 @@
|
|||||||
|
unit TestMonitorCfg;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, fpcunit, testregistry, monitorcfg;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
TTestMonitorCfg= class(TTestCase)
|
||||||
|
private
|
||||||
|
FMonitorCfg: TMonitorConfig;
|
||||||
|
protected
|
||||||
|
procedure SetUp; override;
|
||||||
|
procedure TearDown; override;
|
||||||
|
published
|
||||||
|
procedure Test;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure TTestMonitorCfg.Test;
|
||||||
|
var
|
||||||
|
Server : TServer;
|
||||||
|
begin
|
||||||
|
FMonitorCfg.Load('monitorconfig.xml');
|
||||||
|
AssertEquals('Wrong number of servers', 1, FMonitorCfg.ServerCount);
|
||||||
|
Server := FMonitorCfg.Servers[0];
|
||||||
|
AssertEquals(ord(stFtp), ord(Server.ServerType));
|
||||||
|
AssertEquals('Snapshot on scenergy', Server.Description);
|
||||||
|
AssertEquals('Wrong number of files', 7, Server.FileCount);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestMonitorCfg.SetUp;
|
||||||
|
begin
|
||||||
|
FMonitorCfg := TMonitorConfig.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestMonitorCfg.TearDown;
|
||||||
|
begin
|
||||||
|
FMonitorCfg.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
|
||||||
|
//RegisterTest(TTestMonitorCfg);
|
||||||
|
end.
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user