1 unit MonitorCfg;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 sysutils, strutils, contnrs, dom, xmlread;
9
10 type
11 TServerType = (stFtp, stHttp);
12
13 TServer = class;
14 TFile = class;
15
16 TReplaceStringEvent = function (const value: string):string of object;
17
18 { TMonitorConfig }
19
20 TMonitorConfig = class
21 private
22 FFileName: string;
23 FFPCDevelVersion: string;
24 FFPCFixesVersion: string;
25 FFPCReleaseVersion: string;
26 FLazVersion: string;
27 FServers: TFPObjectList;
GetServernull28 function GetServer(index: integer): TServer;
GetServerCountnull29 function GetServerCount: integer;
30 procedure AddServer(const ServerNode: TDOMNode);
31 procedure ReadVersions(const VersionNode: TDOMNode);
ServerReplaceStringnull32 function ServerReplaceString(const value: string): string;
33 public
34 constructor Create;
35 destructor Destroy; override;
36 procedure Load(const AFileName: string);
37 procedure AddServer(AServer: TServer);
38 property FileName: string read FFileName write FFileName;
39 property LazVersion: string read FLazVersion;
40 property FPCReleaseVersion: string read FFPCReleaseVersion;
41 property FPCFixesVersion: string read FFPCFixesVersion;
42 property FPCDevelVersion: string read FFPCDevelVersion;
43 property Servers[index: integer] : TServer read GetServer;
44 property ServerCount: integer read GetServerCount;
45 end;
46
47 { TServer }
48
49 TServer = class
50 private
51 FFiles: TFPObjectList;
52 FDescription: string;
53 FOnReplaceString: TReplaceStringEvent;
54 FServerType: TServerType;
GetFilenull55 function GetFile(index: integer): TFile;
GetFileCountnull56 function GetFileCount: integer;
57 procedure AddFile(const ServerNode: TDOMNode);
58 public
59 constructor Create;
60 destructor Destroy; override;
61 procedure AddFile(AFile: TFile);
62 property Description : string read FDescription write FDescription;
63 property ServerType : TServerType read FServerType write FServerType;
64 property Files[index: integer] : TFile read GetFile;
65 property FileCount: integer read GetFileCount;
66 property OnReplaceString: TReplaceStringEvent read FOnReplaceString write FOnReplaceString;
67 end;
68
69 { TFile }
70
71 TFile = class
72 private
73 FDescription: string;
74 FMask: string;
75 FUpdated: boolean;
76 public
77 constructor Create;
78 property Mask: string read FMask write FMask;
79 property Description: string read FDescription write FDescription;
80 property Updated: boolean read FUpdated write FUpdated;
81 end;
82
83 implementation
84
GetAttributeValuenull85 function GetAttributeValue(const ANode: TDomNode; const AName: string): string;
86 var
87 Attribute: TDOMNode;
88 begin
89 Attribute := ANode.Attributes.GetNamedItem(AName);
90 if assigned(Attribute) then
91 Result := Attribute.NodeValue;
92 end;
93
94 { TServer }
95
TServer.GetFilenull96 function TServer.GetFile(index: integer): TFile;
97 begin
98 Result := TFile(FFiles[index]);
99 end;
100
GetFileCountnull101 function TServer.GetFileCount: integer;
102 begin
103 Result := FFiles.Count;
104 end;
105
106 procedure TServer.AddFile(const ServerNode: TDOMNode);
107 var
108 NewFile: TFile;
109 begin
110 NewFile := TFile.Create;
111 NewFile.Description := OnReplaceString(GetAttributeValue(ServerNode, 'Description'));
112 NewFile.Mask := OnReplaceString(GetAttributeValue(ServerNode, 'Mask'));
113 NewFile.Updated := StrToBoolDef(GetAttributeValue(ServerNode, 'Updated'), true);
114 AddFile(NewFile);
115 end;
116
117 constructor TServer.Create;
118 begin
119 FFiles := TFPObjectList.Create;
120 end;
121
122 destructor TServer.Destroy;
123 begin
124 FFiles.Free;
125 inherited Destroy;
126 end;
127
128 procedure TServer.AddFile(AFile: TFile);
129 begin
130 FFiles.Add(AFile);
131 end;
132
133 { TFile }
134
135 constructor TFile.Create;
136 begin
137 end;
138
139 { TMonitorConfig }
140
GetServernull141 function TMonitorConfig.GetServer(index: integer): TServer;
142 begin
143 Result := TServer(FServers[index]);
144 end;
145
TMonitorConfig.GetServerCountnull146 function TMonitorConfig.GetServerCount: integer;
147 begin
148 Result := FServers.Count;
149 end;
150
151 procedure TMonitorConfig.AddServer(const ServerNode: TDOMNode);
152 var
153 Server: TServer;
154 Attribute: TDOMNode;
155 Node: TDomNode;
156 begin
157 Server := TServer.Create;
158 Server.OnReplaceString := @ServerReplaceString;
159 Attribute := ServerNode.Attributes.GetNamedItem('Name');
160 if assigned(Attribute) then
161 Server.Description := Attribute.NodeValue;
162 Attribute := ServerNode.Attributes.GetNamedItem('Type');
163 if assigned(Attribute) then
164 if Attribute.NodeValue='ftp' then
165 Server.ServerType := stFtp
166 else if Attribute.NodeValue='http' then
167 Server.ServerType := stHttp;
168 Node := ServerNode.FirstChild;
169 while Node<>nil do begin
170 if Node.NodeName='File' then
171 Server.AddFile(Node);
172 Node := Node.NextSibling;
173 end;
174 AddServer(Server);
175 end;
176
177 procedure TMonitorConfig.ReadVersions(const VersionNode: TDOMNode);
178 begin
179 FLazVersion := GetAttributeValue(VersionNode, 'Lazarus');
180 FFPCReleaseVersion := GetAttributeValue(VersionNode, 'FPC_Release');
181 FFPCFixesVersion := GetAttributeValue(VersionNode, 'FPC_Fixes');
182 FFPCDevelVersion := GetAttributeValue(VersionNode, 'FPC_Devel');
183 end;
184
TMonitorConfig.ServerReplaceStringnull185 function TMonitorConfig.ServerReplaceString(const value: string): string;
186 begin
187 Result := AnsiReplaceStr(Value, '$LAZVER', LazVersion);
188 Result := AnsiReplaceStr(Result, '$FPCRELEASEVER', FPCReleaseVersion);
189 Result := AnsiReplaceStr(Result, '$FPCFIXESVER', FPCFixesVersion);
190 Result := AnsiReplaceStr(Result, '$FPCDEVELVER', FPCDevelVersion);
191 end;
192
193 constructor TMonitorConfig.Create;
194 begin
195 FServers := TFPObjectList.Create;
196 end;
197
198 destructor TMonitorConfig.Destroy;
199 begin
200 FServers.Free;
201 inherited Destroy;
202 end;
203
204 procedure TMonitorConfig.Load(const AFileName: string);
205 var
206 XmlDoc: TXMLDocument;
207 Node: TDomNode;
208 begin
209 FFileName := AFileName;
210 XmlDoc := nil;
211 try
212 ReadXMLFile(XmlDoc, FileName);
213 Node := XmlDoc.DocumentElement.FirstChild;
214 while Node<>nil do begin
215 if Node.NodeName='Server' then
216 AddServer(Node)
217 else if Node.NodeName='Version' then
218 ReadVersions(Node);
219 Node := Node.NextSibling;
220 end;
221 finally
222 XmlDoc.Free;
223 end;
224 end;
225
226 procedure TMonitorConfig.AddServer(AServer: TServer);
227 begin
228 FServers.Add(AServer);
229 end;
230
231 end.
232
233