BSOne.SFC/Tocsg.Module/UrlIpMon/ThdUrlIpMon.pas

{*******************************************************}
{                                                       }
{       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<PUimEnt>)
  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.