5

I have this chunk of code which I found and implemented according to http://www.activexperts.com/activmonitor/windowsmanagement/scripts/networking/windowsfirewall/

procedure AddExceptionToFirewall (Caption: String; Executable: String);
var
  FirewallMsg: OleVariant;
  Application: OleVariant;
  CurrentProfile: OleVariant;
begin
  FirewallMsg:= CreateOLEObject ('HNetCfg.FwMgr');
  CurrentProfile:= FirewallMsg.LocalPolicy.CurrentProfile;
  Application:= CreateOLEObject ('HNetCfg.FwAuthorizedApplication');
  Application.ProcessImageFileName:= Executable;
  Application.Name:= Caption;
  Application.Scope:= FW_SCOPE_ALL;
  Application.IpVersion:= FW_IP_VERSION_ANY;
  Application.Enabled:= True;
  CurrentProfile.AuthorizedApplications.Add (Application);
end;

The thing is, on Windows 7, it adds the exception only as Public and not as Private as you can see circled in RED in here

enter image description here

When set to Public only, my program has problems accessing my host via an FTP connection, thus rendering my program useless. This problem is particular only for Windows Vista/7; on XP, the current configuration works fine.

Please if you have any clue or helpful pointers, share them.

Shade
  • 9,936
  • 5
  • 60
  • 85
ziGi
  • 828
  • 8
  • 28

1 Answers1

9

Starting with windows Vista you must use the INetFwPolicy2 and INetFwRule interfaces to gain access to the new firewall features.

Try this sample which add a new rule in the Public and Private profile.

procedure AddExceptionToFirewall(Const Caption, Executable: String);
const
NET_FW_PROFILE2_DOMAIN  = 1;
NET_FW_PROFILE2_PRIVATE = 2;
NET_FW_PROFILE2_PUBLIC  = 4;

NET_FW_IP_PROTOCOL_TCP = 6;
NET_FW_ACTION_ALLOW    = 1;
var
  fwPolicy2      : OleVariant;
  RulesObject    : OleVariant;
  Profile        : Integer;
  NewRule        : OleVariant;
begin
  Profile             := NET_FW_PROFILE2_PRIVATE OR NET_FW_PROFILE2_PUBLIC;
  fwPolicy2           := CreateOleObject('HNetCfg.FwPolicy2');
  RulesObject         := fwPolicy2.Rules;
  NewRule             := CreateOleObject('HNetCfg.FWRule');
  NewRule.Name        := Caption;
  NewRule.Description := Caption;
  NewRule.Applicationname := Executable;
  NewRule.Protocol := NET_FW_IP_PROTOCOL_TCP;
  NewRule.Enabled := TRUE;
  NewRule.Profiles := Profile;
  NewRule.Action := NET_FW_ACTION_ALLOW;
  RulesObject.Add(NewRule);
end;
RRUZ
  • 134,889
  • 20
  • 356
  • 483
  • Wow that works pretty good, it even renders the Fire Wall private and public policies manually irremovable! Thanks a lot RRUZ! – ziGi Feb 09 '12 at 02:36
  • what if CreateOleObject returns nil ? btw, is there MSDN page for CreateOleObject with documentation what it can and can not return ? – Arioch 'The Jun 09 '13 at 13:33
  • 1
    @Arioch'The, the `CreateOleObject` function internally uses the [CoCreateInstance](http://msdn.microsoft.com/en-us/library/windows/desktop/ms686615%28v=vs.85%29.aspx) WinApi method , and all the error codes was trapped using the `OleCheck` method, so if any error occurs a exception is raised. – RRUZ Jun 10 '13 at 04:01
  • Thanks RRUZ, it's ready-to-use code. Does the code need to be run **with administrator permission**? – Edwin Yip May 19 '16 at 06:31