unit DUrlMonMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
  Tocsg.CommonData, CtrlWndActiveHook, ManagerUrlData, Tocsg.Controls,
  System.Generics.Collections, NetFwTypeLib_TLB, ThdExtrUrl;

const
  DLL_WNDHOOK = 'CatchWndMsg.dll';
  DAT_URLDATA = 'dcsDataInf.dat';

  MAP_FILENAME_CATCHWND = 'Global\WHCBAssist220520'; // urlmon

  WM_WNDHOOK_RELOAD = WM_USER + 9630;
  WM_WNDHOOK_NOTIFY = WM_USER + 9633;
  WM_MESSAGEHOOK_NOTIFY = WM_USER + 9636;

  WND_STATE_ATTACH_HOOK     = 1;
  WND_STATE_DETACH_HOOK     = 2;
  WND_STATE_ACTIVATE        = 3;
  WND_STATE_WINDOW_MIN      = 4;
  WND_STATE_WINDOW_MAX      = 5;
  WND_STATE_WINDOW_MOVESIZE = 6;
  WND_STATE_REDRAW_TITLE    = 7;
  WND_STATE_CREATE_MAIN     = 8;
  WND_STATE_DESTROY_MAIN    = 9;
  WND_STATE_WINDOW_NORMAL   = 10;
  WND_STATE_ACTIVATE2       = 11;

type
  PSharedData = ^TSharedData;
  TSharedData = packed record
    hRcvWnd: ULONGLONG;
    dwLastInput: DWORD;
  end;

  TDlgUrlMonMain = class(TForm)
    pnTop: TPanel;
    pnBottom: TPanel;
    lbStatus: TLabel;
    btnUrlMonStart: TButton;
    pnClient: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    lbBrowser: TLabel;
    edUrl: TEdit;
    edInfo: TEdit;
    Label4: TLabel;
    edTitle: TEdit;
    chAlwaysTop: TCheckBox;
    tInit: TTimer;
    Label5: TLabel;
    mmCutUrl: TMemo;
    Label6: TLabel;
    rdCutKind_NetworkPrevent: TRadioButton;
    rdCutKind_CloseTab: TRadioButton;
    Label7: TLabel;
    edCutInfo: TEdit;
    procedure btnUrlMonStartClick(Sender: TObject);
    procedure chAlwaysTopClick(Sender: TObject);
    procedure tInitTimer(Sender: TObject);
  private
    { Private declarations }
    DcCutBW_: TDictionary<String,INetFwRule>;
    WndHook_: TCtrlWndActiveHook;
    MgUrl_: TManagerUrlData;
    MgCtrls_: TManagerInputControlsData;
    CutUrlList_,
    CutInfoList_: TStringList;
    ThdExtrUrl_: TThdExtrUrl;
    procedure SetMonitorActive(bVal: Boolean);
  public
    { Public declarations }
    Constructor Create(aOwner: TComponent); override;
    Destructor Destroy; override;

    procedure process_WM_WNDHOOK_NOTIFY(var msg: TMessage); Message WM_WNDHOOK_NOTIFY;
    procedure process_WM_CATCH_URL(var msg: TMessage); Message WM_CATCH_URL;
  end;

var
  DlgUrlMonMain: TDlgUrlMonMain;

implementation

uses
  Tocsg.Path, Tocsg.Exception, Tocsg.Trace, Winapi.ActiveX,
  System.Variants, Tocsg.Process, Tocsg.WndUtil, Tocsg.Strings, DNotice,
  superobject, GlobalDefine, Tocsg.Win32, Tocsg.Firewall, Tocsg.Safe;

{$R *.dfm}

procedure ClearTestFwPolicy(aFwRules: INetFwRules = nil);
var
  fwPolicy2: INetFwPolicy2;
  FwRuleList: TFwRuleEntList;
  i: Integer;
begin
  try
    if aFwRules = nil then
    begin
      fwPolicy2 := CoNetFwPolicy2.Create;
      if fwPolicy2 = nil then
        exit;
      aFwRules := fwPolicy2.Rules;
    end;

    Guard(FwRuleList, TFwRuleEntList.Create);
    if GetFwRulesToList(aFwRules, FwRuleList) = 0 then
      exit;

    for i := 0 to FwRuleList.Count - 1 do
    begin
      if FwRuleList[i].sName.StartsWith('eTestHe') then
        RemoveFwRule(aFwRules, FwRuleList[i].sName);
    end;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. ClearFwPolicy()');
  end;
end;

{ TDlgUrlMonMain }

Constructor TDlgUrlMonMain.Create(aOwner: TComponent);
begin
  Inherited Create(aOwner);

  MgUrl_ := TManagerUrlData.Create;
  MgUrl_.LoadFromFile(GetRunExePathDir + DAT_URLDATA);
  lbStatus.Caption := Format('%s개의 URL 평판 정보가 있습니다.', [InsertPointComma(MgUrl_.GetUrlCount, 3)]);
  WndHook_ := nil;

  MgCtrls_ := TManagerInputControlsData.Create(CutFileExt(GetRunExePath) + '.ini');
  MgCtrls_.RegInputCtrl(mmCutUrl);
  MgCtrls_.RegInputCtrl(edInfo);
  MgCtrls_.RegInputCtrl(chAlwaysTop);
  MgCtrls_.RegInputCtrl(rdCutKind_NetworkPrevent);
  MgCtrls_.RegInputCtrl(rdCutKind_CloseTab);
  MgCtrls_.Load;

  if mmCutUrl.Text = '' then
    mmCutUrl.Text := 'daum.net;naver.com';

  if edCutInfo.Text = '' then
    edCutInfo.Text := 'Gambling;Pornography';

  if not rdCutKind_NetworkPrevent.Checked and not rdCutKind_CloseTab.Checked then
    rdCutKind_NetworkPrevent.Checked := true;

  CutUrlList_ := TStringList.Create;
  CutInfoList_ := TStringList.Create;

  DcCutBW_ := TDictionary<String,INetFwRule>.Create;

  CoInitialize(nil);
  ThdExtrUrl_ := TThdExtrUrl.Create(Handle);
  ThdExtrUrl_.StartThread;

  ClearTestFwPolicy;
  SetMonitorActive(false);
  tInit.Enabled := true;
end;

Destructor TDlgUrlMonMain.Destroy;
begin
  if WndHook_ <> nil then
    FreeAndNil(WndHook_);
  FreeAndNil(ThdExtrUrl_);
  FreeAndNil(DcCutBW_);
  CoUninitialize;
  FreeAndNil(CutInfoList_);
  FreeAndNil(CutUrlList_);
  FreeAndNil(MgCtrls_);
  FreeAndNil(MgUrl_);
  Inherited;
  ClearTestFwPolicy;
end;

procedure TDlgUrlMonMain.SetMonitorActive(bVal: Boolean);
begin
  Label1.Enabled := bVal;
  lbBrowser.Enabled := bVal;
  Label4.Enabled := bVal;
  Label2.Enabled := bVal;
  Label3.Enabled := bVal;
  edTitle.Enabled := bVal;
  edUrl.Enabled := bVal;
  edInfo.Enabled := bVal;

  Label5.Enabled := not bVal;
  Label6.Enabled := not bVal;
  Label7.Enabled := not bVal;
  mmCutUrl.Enabled := not bVal;
  edCutInfo.Enabled := not bVal;
  rdCutKind_NetworkPrevent.Enabled := not bVal;
  rdCutKind_CloseTab.Enabled := not bVal;
end;

procedure TDlgUrlMonMain.chAlwaysTopClick(Sender: TObject);
begin
  if chAlwaysTop.Checked then
    FormStyle := fsStayOnTop
  else
    FormStyle := fsNormal;
  MgCtrls_.Save;
end;

procedure TDlgUrlMonMain.btnUrlMonStartClick(Sender: TObject);
begin
  if WndHook_ = nil then
  begin
    WndHook_ := TCtrlWndActiveHook.Create(Handle, false);

    mmCutUrl.Text := Trim(mmCutUrl.Text);
    edCutInfo.Text := Trim(edCutInfo.Text);
    SplitString(LowerCase(mmCutUrl.Text), ';', CutUrlList_);
    SplitString(LowerCase(edCutInfo.Text), ';', CutInfoList_);

    MgCtrls_.Save;
    btnUrlMonStart.Caption := 'URL 모니터 중지';
    SetMonitorActive(true);
  end else begin
    FreeAndNil(WndHook_);
    ClearTestFwPolicy;
    btnUrlMonStart.Caption := 'URL 모니터 시작';
    SetMonitorActive(false);
  end;
  Application.ProcessMessages;
end;

procedure TDlgUrlMonMain.process_WM_WNDHOOK_NOTIFY(var msg: TMessage);
var
  LEnt: TWindowLogEntry;


  procedure PreventUrl(sPName, sUrl, sInfo: String);
  var
    O: ISuperObject;
    sTemp: String;
    fwRule: INetFwRule;
    SetRule: TFwRule;
  begin
    if rdCutKind_NetworkPrevent.Checked then
    begin
      if not DcCutBW_.ContainsKey(sPName) then
      begin
        ZeroMemory(@SetRule, SizeOf(SetRule));
        SetRule.sName := 'eCrmHE-' + CutFileExt(sPName) + 'URL';
        sTemp := GetProcessPathByPid(GetProcessPidByName(sPName));
        if not FileExists(sTemp) then
          exit;
        SetRule.sAppName := sTemp;
        SetRule.bEnabled := true;
        fwRule := AddFwRule(SetRule);
        DcCutBW_.Add(sPName, fwRule);
      end else
        fwRule := DcCutBW_[sPName];

      if not fwRule.Enabled then
      begin
        fwRule.Enabled := true;
        Keybd_Event(VK_F5, MapVirtualKey(VK_F5, 0), 0, 0);
        Keybd_Event(VK_F5, MapVirtualKey(VK_F5, 0), KEYEVENTF_KEYUP, 0);
      end;
    end else
    if rdCutKind_CloseTab.Checked then
    begin
      Keybd_Event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0);
      Keybd_Event(Integer('W'), MapVirtualKey(Integer('W'), 0), 0, 0);
      Keybd_Event(Integer('W'), MapVirtualKey(Integer('W'), 0), KEYEVENTF_KEYUP, 0);
      Keybd_Event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0);
    end;

    sTemp := sUrl + '::' + sInfo;
    if not MutexExists(sTemp) then
    begin
      O := SO;
      O.I['T'] := TYPE_MSG_PREVENT_URL;
      O.S['D'] := sTemp;
      TDlgNotice.Create(nil).PopupMessage(O.AsString);
    end;
  end;

  procedure ProcessUrl;
  var
    sPName, sData: String;
    i: Integer;
    fwRule: INetFwRule;
  begin
    sPName := LEnt.OwnerWindow.ModuleName.ToLower;

    if (sPName = 'iexplore.exe') or (sPName = 'msedge.exe') or
       (sPName = 'whale.exe') or (sPName = 'chrome.exe') or
       (sPName = 'firefox.exe') or (sPName = 'opera.exe') then
    begin

    ThdExtrUrl_.PushBW(msg.LParam);
    exit;

      lbBrowser.Caption := sPName;
      edTitle.Text := LEnt.sTitle;
      edUrl.Text := LEnt.sSubTitle;
      edInfo.Text := MgUrl_.GetUrlCate(edUrl.Text);

      if edUrl.Text = '' then
        exit;

      sData := LowerCase(edUrl.Text);
      for i := 0 to CutUrlList_.Count - 1 do
        if Pos(CutUrlList_[i], sData) <> 0 then
        begin
          PreventUrl(sPName, edUrl.Text, edInfo.Text);
          exit;
        end;

      sData := LowerCase(edInfo.Text);
      for i := 0 to CutInfoList_.Count - 1 do
        if Pos(CutInfoList_[i], sData) <> 0 then
        begin
          PreventUrl(sPName, edUrl.Text, edInfo.Text);
          exit;
        end;

      if DcCutBW_.ContainsKey(sPName) then
        DcCutBW_[sPName].Enabled := false;
    end;
  end;

begin
  if msg.WParamLo = WND_STATE_DETACH_HOOK then
  begin
  // 이 경우는 UI적용 때문에 특수 상황이다.

    exit;
  end;

  if msg.LParam = Handle then
    exit;

  LEnt := WndHook_.ProcessHookNotify(msg);
  if (LEnt.dtLog <> 0) and (LEnt.OwnerWindow.ModuleName <> '') then
  begin
    case msg.WParamLo of
      WND_STATE_ACTIVATE        :
      begin
        {$IFDEF DEBUG} TTgTrace.T('(%s:%d) 활성화 - %s', [LEnt.OwnerWindow.ModuleName, LEnt.OwnerWindow.PID, LEnt.sTitle]); {$ENDIF}
        ProcessUrl;
      end;
      WND_STATE_WINDOW_MIN      :
      begin
        {$IFDEF DEBUG} TTgTrace.T('(%s:%d) 최소화 - %s', [LEnt.OwnerWindow.ModuleName, LEnt.OwnerWindow.PID, LEnt.sTitle]); {$ENDIF}
      end;
      WND_STATE_WINDOW_MAX      :
      begin
        {$IFDEF DEBUG} TTgTrace.T('(%s:%d) 최대화 - %s', [LEnt.OwnerWindow.ModuleName, LEnt.OwnerWindow.PID, LEnt.sTitle]); {$ENDIF}
      end;
      WND_STATE_WINDOW_MOVESIZE :
      begin
        {$IFDEF DEBUG} TTgTrace.T('(%s:%d) 이동 / 크기조절 - %s', [LEnt.OwnerWindow.ModuleName, LEnt.OwnerWindow.PID, LEnt.sTitle]); {$ENDIF}
      end;
      WND_STATE_REDRAW_TITLE    :
      begin
      {$IFDEF DEBUG}
        TTgTrace.T('(%s:%d) 캡션변경 - %s, Sub=%s', [LEnt.OwnerWindow.ModuleName, LEnt.OwnerWindow.PID, LEnt.sTitle, LEnt.sSubTitle]);
      {$ENDIF}
        ProcessUrl;
      end;
      WND_STATE_CREATE_MAIN     :
      begin
        {$IFDEF DEBUG} TTgTrace.T('(%s:%d) 메인폼 생성 - %s', [LEnt.OwnerWindow.ModuleName, LEnt.OwnerWindow.PID, LEnt.sTitle]); {$ENDIF}
      end;
      WND_STATE_DESTROY_MAIN    :
      begin
        {$IFDEF DEBUG} TTgTrace.T('(%s:%d) 메인폼 종료 - %s', [LEnt.OwnerWindow.ModuleName, LEnt.OwnerWindow.PID, LEnt.sTitle]); {$ENDIF}
      end;
//        WND_STATE_WINDOW_NORMAL   :
//        begin
//          {$IFDEF DEBUG} TTgTrace.T('(%s:%d) 최소 / 최대화 복귀 - %s', [LEnt.OwnerWindow.ModuleName, LEnt.OwnerWindow.PID, LEnt.sTitle]); {$ENDIF}
//          if not (wmeRestore in gCollectWndMon.CollectPolicy.WindowMon.Events) then exit;
//          WndLog.Event := wleRestore;
//        end;
      WND_STATE_ACTIVATE2       :
      begin
        {$IFDEF DEBUG} TTgTrace.T('(%s:%d) 활성화 - %s', [LEnt.OwnerWindow.ModuleName, LEnt.OwnerWindow.PID, LEnt.sTitle]); {$ENDIF}
      end;
//          WND_STATE_DETACH_HOOK :
//          begin
//            {$IFDEF DEBUG} TTgTrace.T('(%s:%d) WND_STATE_DETACH_HOOK - %s', [LEnt.OwnerWindow.ModuleName, LEnt.OwnerWindow.PID, LEnt.sTitle]); {$ENDIF}
//          end;
      else exit;
    end;
  end else
  if msg.WParamLo = WND_STATE_ATTACH_HOOK then
  begin
    //
  end;
end;

procedure TDlgUrlMonMain.tInitTimer(Sender: TObject);
begin
  tInit.Enabled := false;
//  btnUrlMonStart.Click;
end;

procedure TDlgUrlMonMain.process_WM_CATCH_URL(var msg: TMessage);
var
  pInfo: PBwInfo;

  procedure PreventUrl(sPName, sUrl, sInfo: String);
  var
    O: ISuperObject;
    sTemp: String;
    fwRule: INetFwRule;
    SetRule: TFwRule;
    FwList: TFwRuleEntList;
  begin
    if rdCutKind_NetworkPrevent.Checked then
    begin
//      Guard(FwList, TFwRuleEntList.Create);
//      if GetFwRulesToList(FwList) > 0 then
//      begin
//        sTemp := 'eCrmHE-' + CutFileExt(sPName) + 'URL';
//        if FwList.GetFwRuleByName(sTemp) = nil then
//        begin
//          ZeroMemory(@SetRule, SizeOf(SetRule));
//          SetRule.sName := 'eCrmHE-' + CutFileExt(sPName) + 'URL';
//          sTemp := GetProcessPathByPid(GetProcessPidByName(sPName));
//          if not FileExists(sTemp) then
//            exit;
//          SetRule.sAppName := sTemp;
//          SetRule.nProtocol := NET_FW_IP_PROTOCOL_TCP;
//          SetRule.bEnabled := true;
//          AddFwRule(SetRule);
//        end;
//      end;

      if not DcCutBW_.ContainsKey(sPName) then
      begin
        ZeroMemory(@SetRule, SizeOf(SetRule));
        SetRule.sName := 'eTestHe-' + CutFileExt(sPName) + 'URL';
        SetRule.sGroup := 'Tocsg Group';
        sTemp := GetProcessPathByPid(GetProcessPidByName(sPName));
        if not FileExists(sTemp) then
          exit;
        SetRule.sAppName := sTemp;
        SetRule.bEnabled := true;
        fwRule := AddFwRule(SetRule);
        DcCutBW_.Add(sPName, fwRule);
      end else
        fwRule := DcCutBW_[sPName];

      if not fwRule.Enabled then
        fwRule.Enabled := true;

      Keybd_Event(VK_F5, MapVirtualKey(VK_F5, 0), 0, 0);
      Keybd_Event(VK_F5, MapVirtualKey(VK_F5, 0), KEYEVENTF_KEYUP, 0);
    end else
    if rdCutKind_CloseTab.Checked then
    begin
      Keybd_Event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0);
      Keybd_Event(Integer('W'), MapVirtualKey(Integer('W'), 0), 0, 0);
      Keybd_Event(Integer('W'), MapVirtualKey(Integer('W'), 0), KEYEVENTF_KEYUP, 0);
      Keybd_Event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0);
    end;

    sTemp := sUrl + '::' + sInfo;
    if not MutexExists(sTemp) then
    begin
      O := SO;
      O.I['T'] := TYPE_MSG_PREVENT_URL;
      O.S['D'] := sTemp;
      TDlgNotice.Create(nil).PopupMessage(O.AsString);
    end;
  end;

  procedure ProcessUrl;
  var
    sPName, sData: String;
    i: Integer;
    fwRule: INetFwRule;
  begin
    sPName := pInfo.sPName;
    if (sPName = 'iexplore.exe') or (sPName = 'msedge.exe') or
       (sPName = 'whale.exe') or (sPName = 'chrome.exe') or
       (sPName = 'firefox.exe') or (sPName = 'opera.exe') then
    begin
      lbBrowser.Caption := sPName;
      edTitle.Text := pInfo.sTitle;
      edUrl.Text := pInfo.sUrl;
      edInfo.Text := MgUrl_.GetUrlCate(edUrl.Text);

      if edUrl.Text = '' then
        exit;

      sData := LowerCase(edUrl.Text);
      for i := 0 to CutUrlList_.Count - 1 do
        if Pos(CutUrlList_[i], sData) <> 0 then
        begin
          PreventUrl(sPName, edUrl.Text, edInfo.Text);
          exit;
        end;

      sData := LowerCase(edInfo.Text);
      for i := 0 to CutInfoList_.Count - 1 do
        if Pos(CutInfoList_[i], sData) <> 0 then
        begin
          PreventUrl(sPName, edUrl.Text, edInfo.Text);
          exit;
        end;

//      RemoveFwRule('eCrmHE-' + CutFileExt(sPName) + 'URL');
      if DcCutBW_.ContainsKey(sPName) then
        DcCutBW_[sPName].Enabled := false;
    end;
  end;

begin
  pInfo := PBwInfo(msg.LParam);
  ProcessUrl;
end;

end.