{*******************************************************} { } { ThdUrlIpMon } { } { Copyright (C) 2022 kku } { } {*******************************************************} unit ThdUrlIpMon; interface uses Tocsg.Obj, Tocsg.Thread, System.SysUtils, System.Classes, Winapi.Windows, Winapi.Messages, System.Generics.Collections; const WM_INIT_LIST = WM_USER + 9842; WM_ADD_URLIP = WM_USER + 9843; type PUimEnt = ^TUimEnt; TUimEnt = record sUrl, sStoredPath: String; IpList: TStringList; end; TUimEntList = class(TList) protected procedure Notify(const Item: PUimEnt; Action: TCollectionNotification); override; public Constructor Create(sUrls: String; bStored: Boolean); end; TThdUrlIpMon = class(TTgThread) protected hRcvWnd_: HWND; EntList_: TUimEntList; nTermSec_: Integer; bStored_: Boolean; procedure OnUimEntNotify(Sender: TObject; const Item: PUimEnt; Action: TCollectionNotification); procedure Execute; override; public Constructor Create(hRcvWnd: HWND; sUrls: String; nTermSec: Integer; bStored: Boolean); Destructor Destroy; override; end; implementation uses Tocsg.Strings, Tocsg.Url, Tocsg.Safe, Tocsg.Path, Tocsg.Trace; { TUimEntList } Constructor TUimEntList.Create(sUrls: String; bStored: Boolean); var IpList, UrlList: TStringList; i, c: Integer; pEnt: PUimEnt; sDataDir: String; begin Inherited Create; Guard(UrlList, TStringList.Create); SplitString(sUrls, '|', UrlList); sDataDir := GetRunExePathDir + 'Data\'; Guard(IpList, TStringList.Create); for i := 0 to UrlList.Count - 1 do begin New(pEnt); pEnt.sUrl := UrlList[i]; pEnt.IpList := TStringList.Create; pEnt.sStoredPath := sDataDir + StringReplace(UrlList[i], '/', '{', [rfReplaceAll]) + '.txt'; Add(pEnt); if bStored then begin if FileExists(pEnt.sStoredPath) then begin IpList.Clear; try IpList.LoadFromFile(pEnt.sStoredPath, TEncoding.UTF8); for c := 0 to IpList.Count - 1 do pEnt.IpList.Add(IpList[c]); pEnt.IpList.Sort; except // .. end; end; end; end; end; procedure TUimEntList.Notify(const Item: PUimEnt; Action: TCollectionNotification); begin if Action = cnRemoved then begin FreeAndNil(Item.IpList); Dispose(Item); end; end; { TThdUrlIpMon } Constructor TThdUrlIpMon.Create(hRcvWnd: HWND; sUrls: String; nTermSec: Integer; bStored: Boolean); begin Inherited Create; hRcvWnd_ := hRcvWnd; nTermSec_ := nTermSec; if nTermSec <= 0 then nTermSec := 60; bStored_ := bStored; EntList_ := TUimEntList.Create(sUrls, bStored_); EntList_.OnNotify := OnUimEntNotify; end; Destructor TThdUrlIpMon.Destroy; begin FreeAndNil(EntList_); Inherited; end; procedure TThdUrlIpMon.OnUimEntNotify(Sender: TObject; const Item: PUimEnt; Action: TCollectionNotification); begin if Action = cnRemoved then Dispose(Item); end; procedure TThdUrlIpMon.Execute; var i, c, nAddCnt: Integer; sAddIps: String; ChkIpList: TStringList; dwTick, dwChkTick: DWORD; pEnt: PUimEnt; begin SendMessage(hRcvWnd_, WM_INIT_LIST, 0, NativeInt(EntList_)); dwChkTick := 0; Guard(ChkIpList, TStringList.Create); if bStored_ then ForceDirectories(GetRunExePathDir + 'Data\'); while not Terminated and not GetWorkStop do begin dwTick := GetTickCount; if (dwChkTick = 0) or (((dwTick - dwChkTick) div 1000) >= nTermSec_) then begin dwChkTick := dwTick; for i := 0 to EntList_.Count - 1 do begin pEnt := EntList_[i]; nAddCnt := 0; sAddIps := ''; SplitString(ExtractIPsFromUrl(pEnt.sUrl), ',', ChkIpList); for c := 0 to ChkIpList.Count - 1 do if pEnt.IpList.IndexOf(ChkIpList[c]) = -1 then begin pEnt.IpList.Add(ChkIpList[c]); pEnt.IpList.Sort; Inc(nAddCnt); SumString(sAddIps, ChkIpList[c], ','); if bStored_ then WriteLnFileEndUTF8(pEnt.sStoredPath, ChkIpList[c]); end; if nAddCnt > 0 then SendMessage(hRcvWnd_, WM_ADD_URLIP, NativeInt(IntToStr(nAddCnt) + ':' + sAddIps), NativeInt(EntList_[i])); end; end; Sleep(500); end; end; end.