IdIPAddrMon.pas 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448
  1. {
  2. $Project$
  3. $Workfile$
  4. $Revision$
  5. $DateUTC$
  6. $Id$
  7. This file is part of the Indy (Internet Direct) project, and is offered
  8. under the dual-licensing agreement described on the Indy website.
  9. (http://www.indyproject.org/)
  10. Copyright:
  11. (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
  12. }
  13. {
  14. $Log$
  15. }
  16. {
  17. Rev 1.7 10/26/2004 10:20:04 PM JPMugaas
  18. Updated refs.
  19. Rev 1.6 2004.02.03 5:45:14 PM czhower
  20. Name changes
  21. Rev 1.5 1/31/2004 1:18:40 PM JPMugaas
  22. Illiminated Todo; item so it should work in DotNET.
  23. Rev 1.4 1/21/2004 3:11:04 PM JPMugaas
  24. InitComponent
  25. Rev 1.3 10/19/2003 4:51:34 PM DSiders
  26. Added localization comments.
  27. Rev 1.2 2003.10.12 3:53:12 PM czhower
  28. compile todos
  29. Rev 1.1 3/5/2003 11:41:14 PM BGooijen
  30. Added IdCoreGlobal to the uses, this file was needed for the call to
  31. Sleep(...)
  32. Rev 1.0 12/28/2002 3:04:52 PM DSiders
  33. Initial revision.
  34. }
  35. unit IdIPAddrMon;
  36. {
  37. TIdIPAddrMon
  38. Monitors adapters known to the IP protocol stack for changes in any
  39. of the IP addresses. Similar to TIdIPWatch, but monitors all IP
  40. addresses/adapters.
  41. Does not keep a permanent IP address history list. But does trigger
  42. a TIdIPAddrMonEvent event to signal the adapter number, old IP, and
  43. new IP for the change in status.
  44. OnStatusChanged is used to capture changed IP addresses, and/or
  45. to sync with GUI display controls. If you do not assign a procedure
  46. for the event handler, this component essentially does nothing except
  47. eat small amounts of CPU time.
  48. The thread instance is created and freed when the value in Active is
  49. changed.
  50. TIdIPAddrMonEvent
  51. An procedure use to handle notifications from the component. Includes
  52. parameters that represent the adapter number, previous IP or '<unknown>',
  53. and the current IP or '<unknown>'.
  54. TIdIPAddrMonThread
  55. Timer thread for the IP address monitor component. Based on
  56. TIdIPWatchThread.
  57. Sleeps in increments of .5 seconds until the Interval has elapsed, and
  58. fires the timer event. Sleep is called in increments to allow checking
  59. for Terminated when a long Interval has been specified.
  60. Original Author:
  61. Don Siders, Integral Systems, Fri 27 Dec 2002
  62. Donated to the Internet Direct (Indy) Project for use under the
  63. terms of the Indy Dual License.
  64. }
  65. interface
  66. {$i IdCompilerDefines.inc}
  67. uses
  68. Classes,
  69. IdGlobal,
  70. IdComponent,
  71. IdThread;
  72. const
  73. IdIPAddrMonInterval = 500;
  74. type
  75. TIdIPAddrMonEvent = procedure(ASender: TObject; AAdapter: Integer; AOldIP, ANewIP: string) of object;
  76. TIdIPAddrMonThread = class(TIdThread)
  77. protected
  78. FInterval: UInt32;
  79. FOnTimerEvent: TNotifyEvent;
  80. procedure Run; override;
  81. procedure DoTimerEvent;
  82. end;
  83. TIdIPAddrMon = class(TIdComponent)
  84. private
  85. FActive: Boolean;
  86. FBusy: Boolean;
  87. FInterval: UInt32;
  88. FAdapterCount: Integer;
  89. FThread: TIdIPAddrMonThread;
  90. // TODO: replace these with TIdStackLocalAddressList
  91. FIPAddresses: TStrings;
  92. FPreviousIPAddresses: TStrings;
  93. FOnStatusChanged: TIdIPAddrMonEvent;
  94. procedure SetActive(Value: Boolean);
  95. procedure SetInterval(Value: UInt32);
  96. procedure GetAdapterAddresses;
  97. procedure DoStatusChanged;
  98. protected
  99. procedure Loaded; override;
  100. public
  101. constructor Create(AOwner: TComponent); override;
  102. destructor Destroy; override;
  103. procedure CheckAdapters(Sender: TObject);
  104. procedure ForceCheck;
  105. property AdapterCount: Integer read FAdapterCount;
  106. property Busy: Boolean read FBusy;
  107. property IPAddresses: TStrings read FIPAddresses;
  108. property Thread: TIdIPAddrMonThread read FThread;
  109. published
  110. property Active: Boolean read FActive write SetActive;
  111. property Interval: UInt32 read FInterval write SetInterval default IdIPAddrMonInterval;
  112. property OnStatusChanged: TIdIPAddrMonEvent read FOnStatusChanged write FOnStatusChanged;
  113. end;
  114. implementation
  115. uses
  116. {$IFDEF USE_VCL_POSIX}
  117. Posix.SysSelect,
  118. Posix.SysTime,
  119. {$ENDIF}
  120. IdStack,
  121. SysUtils;
  122. constructor TIdIPAddrMon.Create(AOwner: TComponent);
  123. begin
  124. inherited Create(AOwner);
  125. FInterval := IdIPAddrMonInterval;
  126. FActive := False;
  127. FBusy := False;
  128. FAdapterCount := 0;
  129. // TODO: replace these with TIdStackLocalAddressList
  130. FIPAddresses := TStringList.Create;
  131. FPreviousIPAddresses := TStringList.Create;
  132. // FThread created when component becomes Active
  133. end;
  134. destructor TIdIPAddrMon.Destroy;
  135. begin
  136. Active := False;
  137. FBusy := False;
  138. FIPAddresses.Free;
  139. FPreviousIPAddresses.Free;
  140. // FThread freed on Terminate
  141. inherited Destroy;
  142. end;
  143. procedure TIdIPAddrMon.Loaded;
  144. begin
  145. inherited Loaded;
  146. // Active = True must not be performed before all other props are loaded
  147. if Active then begin
  148. FActive := False;
  149. Active := True;
  150. end;
  151. end;
  152. procedure TIdIPAddrMon.CheckAdapters(Sender: TObject);
  153. begin
  154. // previous check could still be running...
  155. if FBusy then begin
  156. Exit;
  157. end;
  158. FBusy := True;
  159. try
  160. try
  161. GetAdapterAddresses;
  162. if IsDesignTime then begin
  163. Exit;
  164. end;
  165. // TODO: replace with TIdStackLocalAddressList
  166. {
  167. LChanged := FPreviousIPAddresses.Count <> FIPAddresses.Count;
  168. if not LChanged then
  169. begin
  170. for I := 0 to FIPAddresses.Count-1 do begin
  171. LChanged := FPreviousIPAddresses[I].IPAddress.Count <> FIPAddresses[I].IPAddress;
  172. if LChanged then begin
  173. Break;
  174. end;
  175. end;
  176. end;
  177. if LChanged then begin
  178. // something changed at runtime
  179. DoStatusChanged;
  180. end;
  181. }
  182. if (FPreviousIPAddresses.Count <> FIPAddresses.Count) or
  183. (FPreviousIPAddresses.Text <> FIPAddresses.Text) then
  184. begin
  185. // something changed at runtime
  186. DoStatusChanged;
  187. end;
  188. except
  189. // eat any exception
  190. end;
  191. finally
  192. FBusy := False;
  193. end;
  194. end;
  195. procedure TIdIPAddrMon.DoStatusChanged;
  196. var
  197. iOldCount: Integer;
  198. iNewCount: Integer;
  199. iAdapter: Integer;
  200. sOldIP: string;
  201. sNewIP: string;
  202. begin
  203. if not Assigned(FOnStatusChanged) then
  204. begin
  205. Exit;
  206. end;
  207. // figure out the change... new, removed, or altered IP for adapter(s)
  208. iOldCount := FPreviousIPAddresses.Count;
  209. iNewCount := FIPAddresses.Count;
  210. // find the new adapter IP address
  211. if iOldCount < iNewCount then
  212. begin
  213. sOldIP := '<unknown>'; {do not localize}
  214. for iAdapter := 0 to iNewCount - 1 do
  215. begin
  216. // TODO: replace with TIdStackLocalAddressList
  217. {
  218. sNewIP := FIPAddresses[iAdapter].IPAddress;
  219. if FPreviousIPAddresses.IndexOfIP(sNewIP, FIPAddresses[iAdapter].IPVersion) = -1 then
  220. begin
  221. FOnStatusChanged(Self, iAdapter, sOldIP, sNewIP);
  222. end;
  223. }
  224. sNewIP := FIPAddresses[iAdapter];
  225. if FPreviousIPAddresses.IndexOf(sNewIP) = -1 then
  226. begin
  227. FOnStatusChanged(Self, iAdapter, sOldIP, sNewIP);
  228. end;
  229. end;
  230. end
  231. // find the missing adapter IP address
  232. else if iOldCount > iNewCount then
  233. begin
  234. sNewIP := '<unknown>'; {do not localize}
  235. for iAdapter := 0 to iOldCount - 1 do
  236. begin
  237. // TODO: replace with TIdStackLocalAddressList
  238. {
  239. sOldIP := FPreviousIPAddresses[iAdapter].IPAddress;
  240. if FIPAddresses.IndexOfIP(sOldIP, FPreviousIPAddresses[iAdapter].IPVersion) = -1 then
  241. begin
  242. FOnStatusChanged(Self, iAdapter, sOldIP, sNewIP);
  243. end;
  244. }
  245. sOldIP := FPreviousIPAddresses[iAdapter];
  246. if FIPAddresses.IndexOf(sOldIP) = -1 then
  247. begin
  248. FOnStatusChanged(Self, iAdapter, sOldIP, sNewIP);
  249. end;
  250. end;
  251. end
  252. // find the altered adapter IP address
  253. else
  254. begin
  255. for iAdapter := 0 to AdapterCount - 1 do
  256. begin
  257. // TODO: replace with TIdStackLocalAddressList
  258. {
  259. sOldIP := FPreviousIPAddresses[iAdapter].IPAddress;
  260. sNewIP := FIPAddresses[iAdapter].IPAddress;
  261. if (FPreviousIPAddresses[iAdapter].IPVersion <> FIPAddresses[iAdapter].IPVersion) or
  262. (sOldIP <> sNewIP) then
  263. begin
  264. FOnStatusChanged(Self, iAdapter, sOldIP, sNewIP);
  265. end;
  266. }
  267. sOldIP := FPreviousIPAddresses[iAdapter];
  268. sNewIP := FIPAddresses[iAdapter];
  269. if sOldIP <> sNewIP then
  270. begin
  271. FOnStatusChanged(Self, iAdapter, sOldIP, sNewIP);
  272. end;
  273. end;
  274. end;
  275. end;
  276. procedure TIdIPAddrMon.ForceCheck;
  277. begin
  278. CheckAdapters(nil);
  279. end;
  280. procedure TIdIPAddrMon.SetActive(Value: Boolean);
  281. begin
  282. if Value <> FActive then
  283. begin
  284. if Value then
  285. begin
  286. // get initial addresses at start-up and allow display in IDE
  287. GetAdapterAddresses;
  288. end;
  289. if (not IsDesignTime) and (not IsLoading) then
  290. begin
  291. if Value then
  292. begin
  293. FThread := TIdIPAddrMonThread.Create(True);
  294. FThread.FOnTimerEvent := CheckAdapters;
  295. FThread.FInterval := Self.Interval;
  296. FThread.Start;
  297. end
  298. else if FThread <> nil then begin
  299. FThread.TerminateAndWaitFor;
  300. FreeAndNil(FThread);
  301. end;
  302. end;
  303. FActive := Value;
  304. end;
  305. end;
  306. procedure TIdIPAddrMon.SetInterval(Value: UInt32);
  307. begin
  308. FInterval := Value;
  309. if Assigned(FThread) then begin
  310. FThread.FInterval := FInterval;
  311. end;
  312. end;
  313. procedure TIdIPAddrMonThread.Run;
  314. var
  315. lInterval: Integer;
  316. begin
  317. lInterval := FInterval;
  318. while lInterval > 0 do
  319. begin
  320. // force a check for terminated every .5 sec
  321. if lInterval > 500 then
  322. begin
  323. IndySleep(500);
  324. lInterval := lInterval - 500;
  325. end else
  326. begin
  327. IndySleep(lInterval);
  328. LInterval := 0;
  329. end;
  330. if Terminated then
  331. begin
  332. Exit;
  333. end;
  334. end;
  335. // interval has elapsed... fire the thread timer event
  336. Synchronize(DoTimerEvent);
  337. end;
  338. procedure TIdIPAddrMonThread.DoTimerEvent;
  339. begin
  340. if Assigned(FOnTimerEvent) then begin
  341. FOnTimerEvent(Self);
  342. end;
  343. end;
  344. procedure TIdIPAddrMon.GetAdapterAddresses;
  345. var
  346. LAddresses: TIdStackLocalAddressList;
  347. I: Integer;
  348. begin
  349. {
  350. Doesn't keep a permanent history list like TIdIPWatch...
  351. but does track previous IP addresses to detect changes.
  352. }
  353. FPreviousIPAddresses.Assign(FIPAddresses);
  354. FIPAddresses.Clear;
  355. LAddresses := TIdStackLocalAddressList.Create;
  356. try
  357. GStack.GetLocalAddressList(LAddresses);
  358. for I := 0 to LAddresses.Count-1 do begin
  359. FIPAddresses.Add(LAddresses[I].IPAddress);
  360. end;
  361. finally
  362. LAddresses.Free;
  363. end;
  364. FAdapterCount := FIPAddresses.Count;
  365. end;
  366. end.