Delphi 7 Windows Vista/7 Firewall Exception Network Locations

Question

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

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.

Macswan

Answer 1

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;

Mainsail

Wow that works pretty good, it even renders the Fire Wall private and public policies manually irremovable! Thanks a lot RRUZ! – Macswan

what if CreateOleObject returns nil ? btw, is there MSDN page for CreateOleObject with documentation what it can and can not return ? – Twelvemo

@Arioch'The, the CreateOleObject function internally uses the CoCreateInstance WinApi method , and all the error codes was trapped using the OleCheck method, so if any error occurs a exception is raised. – Mainsail

Thanks RRUZ, it's ready-to-use code. Does the code need to be run with administrator permission? – Amenable