{*******************************************************}
{                                                       }
{       Tocsg.Firewall                                  }
{                                                       }
{       Copyright (C) 2022 kku                          }
{                                                       }
{*******************************************************}

unit Tocsg.Firewall;

interface

uses
  Tocsg.Obj, System.SysUtils, System.Classes, Winapi.Windows,
  System.Generics.Collections, NetFwTypeLib_TLB;

const
{
type
  NET_FW_PROFILE_TYPE_ = TOleEnum;
const
  NET_FW_PROFILE_DOMAIN = $00000000;
  NET_FW_PROFILE_STANDARD = $00000001;
  NET_FW_PROFILE_CURRENT = $00000002;
  NET_FW_PROFILE_TYPE_MAX = $00000003;

// Constants for enum NET_FW_PROFILE_TYPE2_
type
  NET_FW_PROFILE_TYPE2_ = TOleEnum;
const
  NET_FW_PROFILE2_DOMAIN = $00000001;
  NET_FW_PROFILE2_PRIVATE = $00000002;
  NET_FW_PROFILE2_PUBLIC = $00000004;
  NET_FW_PROFILE2_ALL = $7FFFFFFF;
}
  FW_PROFILE_DOMAIN          = 1; // 도메인
  FW_PROFILE_PERSONAL        = 2; // 개인
  FW_PROFILE_DOMAIN_PERSONAL = 3; // 도메인, 개인
  FW_PROFILE_PUBLIC          = 4; // 공용
  FW_PROFILE_DOMAIN_PUBLIC   = 5; // 도메인, 공용
  FW_PROFILE_PERSONAL_PUBLIC = 6; // 개인, 공용
  FW_PROFILE_ANY             = 7; // 모두

type
  PFwRuleEnt = ^TFwRuleEnt;
  TFwRuleEnt = record
    sName,
    sGroup,
    sDesc,
    sSvrName,
    sAppName,
    sLocalPorts,
    sRemotePorts,
    sLocalAddr,
    sRemoteAddr,
    sIcmpTypesAndCodes,
    sInterfaceType: String;
    bEnabled: Boolean;
    nProfiles,
    nProtocol,
    nAction,
    nDirection: Integer;
  end;

  TFwRule = record
    sName,
    sGroup,
    sDesc,
    sAppName,
    sLocalPorts,
    sLocalAddresses,
    sRemotePorts,
    sRemoteAddresses: String;
    nProtocol,
    nProfiles,
    nAction,
    nDirection: Integer;
    bEnabled: Boolean;
  end;

  TFwRuleEntList = class(TList<PFwRuleEnt>)
  protected
    procedure Notify(const Item: PFwRuleEnt; Action: TCollectionNotification); override;
  public
    function GetFwRuleByName(sRuleName: String): PFwRuleEnt;

    procedure AddAddedRule(aRule: TFwRule); // 추가한 룰을 새로고침 하지 않게 하기위해 임시 저장
    procedure RemoveAddedRule(sFwName: String);
  end;

function FwProfileToStr(nVal: Integer): String;
function FwProtocolToStr(nVal: Integer): String;
function GetFwRulesToList(aFwRules: INetFwRules; aList: TFwRuleEntList): Integer; overload;
function GetFwRulesToList(aFwPolicy: INetFwPolicy2; aList: TFwRuleEntList): Integer; overload;
function GetFwRulesToList(aList: TFwRuleEntList): Integer; overload;

function AddFwRule(aFwRules: INetFwRules; aRule: TFwRule): INetFwRule; overload;
function AddFwRule(aFwPolicy: INetFwPolicy2; aRule: TFwRule): INetFwRule; overload;
function AddFwRule(aRule: TFwRule): INetFwRule; overload;
function RemoveFwRule(aFwRules: INetFwRules; sRuleName: String): Boolean; overload;
function RemoveFwRule(aFwPolicy: INetFwPolicy2; sRuleName: String): Boolean; overload;
function RemoveFwRule(sRuleName: String): Boolean; overload;

procedure ClearCrmFwPolicy(aFwRules: INetFwRules = nil; bForce: Boolean = false; sHead: String = '');

implementation

uses
  Tocsg.Exception, Winapi.ActiveX, System.Variants, Tocsg.Safe, Tocsg.Trace;

{ TFwRuleEntList }

procedure TFwRuleEntList.Notify(const Item: PFwRuleEnt; Action: TCollectionNotification);
begin
  if Action = cnRemoved then
    Dispose(Item);
end;

function TFwRuleEntList.GetFwRuleByName(sRuleName: String): PFwRuleEnt;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to Count - 1 do
    if CompareText(sRuleName, Items[i].sName) = 0 then
    begin
      Result := Items[i];
      exit;
    end;
end;

procedure TFwRuleEntList.AddAddedRule(aRule: TFwRule);
var
  pEnt: PFwRuleEnt;
begin
  New(pEnt);
  ZeroMemory(pEnt, SizeOf(TFwRuleEnt));
  with aRule do
  begin
    pEnt.sName := sName;
    pEnt.sGroup := sGroup;
    pEnt.sDesc := sDesc;
    pEnt.sAppName := sAppName;
    pEnt.sLocalPorts := sLocalPorts;
    pEnt.sLocalAddr := sLocalAddresses;
    pEnt.sRemotePorts := sRemotePorts;
    pEnt.sRemoteAddr := sRemoteAddresses;
    pEnt.nProtocol := nProtocol;
    pEnt.nProfiles := nProfiles;
    pEnt.nAction := nAction;
    pEnt.nDirection := nDirection;
    pEnt.bEnabled := bEnabled;
  end;
  Add(pEnt);
end;

procedure TFwRuleEntList.RemoveAddedRule(sFwName: String);
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    if Items[i].sName = sFwName then
    begin
      Delete(i);
      exit;
    end;
end;


{ Function }

function FwProfileToStr(nVal: Integer): String;
begin
  case nVal of
    1 : Result := '도메인';
    else Result := Format('Unknown(%d)', [nVal]);
  end;
end;

function FwProtocolToStr(nVal: Integer): String;
begin
  case nVal of
     1  : Result := 'ICMPv4';
     2  : Result := 'IGMP';
     6  : Result := 'TCP';
    17  : Result := 'UDP';
    41  : Result := 'IPv6';
    47  : Result := 'GRE';
    58  : Result := 'ICMPv6';
    256 : Result := '모두';
    else Result := Format('Unknown(%d)', [nVal]);
   end;
end;

function GetFwRulesToList(aFwRules: INetFwRules; aList: TFwRuleEntList): Integer;
var
  fwRule: INetFwRule;
  pEnum: IUnknown;
  pVar: IEnumVARIANT;
  v: OleVariant;
  dwFetched: DWORD;
  pEnt: PFwRuleEnt;
begin
  aList.Clear;
  Result := 0;
  if aFwRules = nil then
    exit;

  try
    pEnum := aFwRules.Get__NewEnum;
    if pEnum = nil then
      exit;

    if SUCCEEDED(pEnum.QueryInterface(IEnumVARIANT, pVar)) then
    begin
      VariantClear(v);
      while SUCCEEDED(pVar.Next(1, v, dwFetched)) do
      begin
        if VarIsEmpty(v) then
          break;

        if SUCCEEDED(IDispatch(v).QueryInterface(INetFwRule, fwRule)) then
        begin
          New(pEnt);
          pEnt.sName := fwRule.Name;
          pEnt.sGroup := fwRule.Grouping;
          pEnt.sDesc := fwRule.Description;
          pEnt.sSvrName := fwRule.serviceName;
          pEnt.sAppName := fwRule.ApplicationName;
          pEnt.sLocalPorts := fwRule.LocalPorts;
          pEnt.sRemotePorts := fwRule.RemotePorts;
          pEnt.sLocalAddr := fwRule.LocalAddresses;
          pEnt.sRemoteAddr := fwRule.RemoteAddresses;
          pEnt.sIcmpTypesAndCodes := fwRule.IcmpTypesAndCodes;
          pEnt.sInterfaceType := fwRule.InterfaceTypes;
          pEnt.bEnabled := fwRule.Enabled;
          pEnt.nProfiles := fwRule.Profiles;
          pEnt.nProtocol := fwRule.Protocol;
          pEnt.nAction := fwRule.Action;
          pEnt.nDirection := fwRule.Direction;
          aList.Add(pEnt);
          Inc(Result);
        end;

        VariantClear(v);
      end;
    end;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. GetFwRuleToList()');
  end;
end;

function GetFwRulesToList(aFwPolicy: INetFwPolicy2; aList: TFwRuleEntList): Integer;
begin
  aList.Clear;
  Result := 0;
  if aFwPolicy = nil then
    exit;

  Result := GetFwRulesToList(aFwPolicy.Rules, aList);
end;

function GetFwRulesToList(aList: TFwRuleEntList): Integer;
begin
  Result := GetFwRulesToList(CoNetFwPolicy2.Create, aList);
end;

function AddFwRule(aFwRules: INetFwRules; aRule: TFwRule): INetFwRule;
var
  FwMore: INetFwRule;
begin
  Result := nil;
  if aFwRules = nil then
    exit;

  try
    Result := CoNetFwRule.Create;
    with aRule do
    begin
      Result.Name := sName;
      Result.Grouping := sGroup;
      Result.Description := sDesc;
      if sAppName <> '' then
        Result.ApplicationName := sAppName;

      if nProtocol = 0 then
        Result.Protocol := NET_FW_IP_PROTOCOL_ANY
      else
        Result.Protocol := nProtocol;
      Result.Profiles := nProfiles;
      Result.Action := nAction;
      if nDirection = 0 then
        Result.Direction := NET_FW_RULE_DIR_OUT
      else
        Result.Direction := nDirection;

    // fwRule.Protocol 설정전에 아래 포트들 설정하면
    // 매개변수 잘못되었다는 오류나옴 22_0516 11:00:13 kku
      if sLocalPorts <> '' then
        Result.LocalPorts := sLocalPorts;
      if sLocalAddresses <> '' then
        Result.LocalAddresses := sLocalAddresses;
      if sRemotePorts <> '' then
        Result.RemotePorts := sRemotePorts;
      if sRemoteAddresses <> '' then
        Result.RemoteAddresses := sRemoteAddresses;
      Result.Enabled := bEnabled;
      aFwRules.Add(Result);

    {$IFDEF _HE_}
    // iexplore.exe는 하나 더 자동으로 등록해준다. 22_0726 13:16:13 kku
      if (sAppName <> '') and (ExtractFileName(sAppName).ToLower = 'iexplore.exe') then
      begin
        if sAppName.Contains('(x86)') then
          sAppName := StringReplace(sAppName, 'Files (x86)', 'Files', [rfReplaceAll, rfIgnoreCase])
        else
          sAppName := StringReplace(sAppName, 'Files', 'Files (x86)', [rfReplaceAll, rfIgnoreCase]);

        if FileExists(sAppName) then
        begin
          FwMore := CoNetFwRule.Create;
          FwMore.Name := sName + '2';
          FwMore.Grouping := sGroup;
          FwMore.Description := sDesc;
          FwMore.ApplicationName := sAppName;

          if nProtocol = 0 then
            FwMore.Protocol := NET_FW_IP_PROTOCOL_ANY
          else
            FwMore.Protocol := nProtocol;
          FwMore.Profiles := nProfiles;
          FwMore.Action := nAction;
          if nDirection = 0 then
            FwMore.Direction := NET_FW_RULE_DIR_OUT
          else
            FwMore.Direction := nDirection;

        // fwRule.Protocol 설정전에 아래 포트들 설정하면
        // 매개변수 잘못되었다는 오류나옴 22_0516 11:00:13 kku
          if sLocalPorts <> '' then
            FwMore.LocalPorts := sLocalPorts;
          if sLocalAddresses <> '' then
            FwMore.LocalAddresses := sLocalAddresses;
          if sRemotePorts <> '' then
            FwMore.RemotePorts := sRemotePorts;
          if sRemoteAddresses <> '' then
            FwMore.RemoteAddresses := sRemoteAddresses;
          FwMore.Enabled := bEnabled;
          aFwRules.Add(FwMore);
        end;
      end;

      TTgTrace.T('방화벽 규칙 추가. Name=%s', [sName], 2);
    {$ENDIF}
    end;
  except
    on E: Exception do
    begin
      Result := nil;
//      ETgException.TraceException(E, 'Fail .. AddFwRule()');
      ETgException.TraceException(E, Format('Fail .. AddFwRule(), RemoteAddresses=%s, RemotePorts=%s',
          [aRule.sRemoteAddresses, aRule.sRemotePorts]));
    end;
  end;
end;

function AddFwRule(aFwPolicy: INetFwPolicy2; aRule: TFwRule): INetFwRule;
begin
  Result := nil;
  if aFwPolicy = nil then
    exit;

  if aRule.nProfiles = 0 then
    aRule.nProfiles := FW_PROFILE_ANY;
//    aRule.nProfiles := aFwPolicy.CurrentProfileTypes;

  Result := AddFwRule(aFwPolicy.Rules, aRule);
end;

function AddFwRule(aRule: TFwRule): INetFwRule;
begin
  Result := AddFwRule(CoNetFwPolicy2.Create, aRule);
end;

function RemoveFwRule(aFwRules: INetFwRules; sRuleName: String): Boolean;
begin
  Result := false;
  if aFwRules = nil then
    exit;

  try
    if aFwRules.Item(sRuleName) <> nil then
      aFwRules.Remove(sRuleName);
    Result := true;
  except
//    on E: Exception do
//      ETgException.TraceException(E, Format('Fail .. RemoveFwRule(), RuleName="%s"', [sRuleName]));
  end;
end;

function RemoveFwRule(aFwPolicy: INetFwPolicy2; sRuleName: String): Boolean;
begin
  Result := false;
  if aFwPolicy = nil then
    exit;

  Result := RemoveFwRule(aFwPolicy.Rules, sRuleName);
end;

function RemoveFwRule(sRuleName: String): Boolean;
begin
  Result := RemoveFwRule(CoNetFwPolicy2.Create, sRuleName);
end;

procedure ClearCrmFwPolicy(aFwRules: INetFwRules = nil; bForce: Boolean = false; sHead: String = '');
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(sHead + 'eCrmHome') or
         FwRuleList[i].sName.StartsWith(sHead + 'eCrmHE') or
         (bForce and FwRuleList[i].sName.StartsWith('Tocsg')) then
        RemoveFwRule(aFwRules, FwRuleList[i].sName);
    end;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. ClearFwPolicy()');
  end;
end;

end.