Windows Firewall - Eintrag erstellen / löschen / ändern

[fkerber]

HeikoAdams stellt dazu folgenden Code zur Verfügung. Dieser entstand durch Weiterentwicklung eines Code-Schnipsels, den smallsmoker gepostet hatte:

Hinweise:
Der Code scheint nur unter Windows XP zu funktionieren.

Vor dem Anlegen oder Löschen einer Ausnahme wird erst einmal geprüft, ob die Firewall überhaupt aktiviert ist, ob Ausnahmen zugelassen sind und ob der Firewall-Dienst läuft.

Delphi-Quellcode:

unit FirewallTools;

interface

procedure AddToWinFirewall(const ApplicationFilename, NameOnExeptionlist: string;
  Enabled: Boolean);
procedure DeleteFromWinFirewall(const ApplicationFilename: string);
function IsFirewallServiceActive: Boolean;
function IsFirewallActive: Boolean;

implementation

uses ComObj, Variants, WINSVC;  

const 
  NET_FW_SCOPE_ALL = 0;
  NET_FW_IP_VERSION_ANY = 2;
  FW_MGR_CLASS_NAME = 'HNetCfg.FwMgr';
  FW_AUTHORIZEDAPPLICATION_CLASS_NAME = 'HNetCfg.FwAuthorizedApplication';

function IsFirewallServiceActive: Boolean;
var
  SCM, hService: LongWord;
  sStatus: TServiceStatus;
  dwStat: Cardinal;
begin
  dwStat := SERVICE_RUNNING;
  SCM  := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  hService := OpenService(SCM, PChar('SharedAccess'), SERVICE_ALL_ACCESS);

  if (hService > 0) then
    if (QueryServiceStatus(hService, sStatus)) then
      dwStat := sStatus.dwCurrentState;
  CloseServiceHandle(hService);

  Result := (SERVICE_RUNNING = dwStat);
end;

function IsFirewallActive: Boolean;
var
  fwMgr: Variant;
  Profile: Variant;
begin
  fwMgr := CreateOleObject(FW_MGR_CLASS_NAME);
  Profile := fwMgr.LocalPolicy.CurrentProfile;
  Result := Profile.FirewallEnabled;

  Profile := Unassigned;
  fwMgr := Unassigned 
end;

function FirewallExceptionsAllowed: Boolean;
var
  fwMgr: Variant;
  Profile: Variant;
begin
  fwMgr := CreateOleObject(FW_MGR_CLASS_NAME);
  Profile := fwMgr.LocalPolicy.CurrentProfile;
  Result := not Profile.ExceptionsNotAllowed;

  Profile := Unassigned;
  fwMgr := Unassigned 
end;

procedure AddToWinFirewall(ApplicationFilename, NameOnExeptionlist: string;
  Enabled: Boolean);
var
  fwMgr: Variant;
  Profile: Variant;
  App: Variant;
  FirewallActive: Boolean;
  ServiceActive: Boolean;
  ExceptionsAllowed: Boolean;
begin
  FirewallActive := IsFirewallActive;
  ServiceActive := IsFirewallServiceActive;
  ExceptionsAllowed := FirewallExceptionsAllowed;

  if not ServiceActive
  or not  FirewallActive
  or (FirewallActive and not ExceptionsAllowed) then
    Exit;

  fwMgr := CreateOleObject(FW_MGR_CLASS_NAME);
  Profile := fwMgr.LocalPolicy.CurrentProfile;

  App := CreateOleObject(FW_AUTHORIZEDAPPLICATION_CLASS_NAME);
  App.ProcessImageFileName := applicationfilename;
  App.Name := NameOnExeptionlist;
  App.Scope := NET_FW_SCOPE_ALL;
  App.IpVersion := NET_FW_IP_VERSION_ANY;
  App.Enabled := enabled;

  Profile.AuthorizedApplications.Add(App);

  App := Unassigned;
  Profile := Unassigned;
  fwMgr := Unassigned;
end;

procedure DeleteFromWinFirewall(ApplicationFilename: string);
var
  fwMgr: Variant;
  Profile: Variant;
  FirewallActive: Boolean;
  ServiceActive: Boolean;
  ExceptionsAllowed: Boolean;
begin
  FirewallActive := IsFirewallActive;
  ServiceActive := IsFirewallServiceActive;
  ExceptionsAllowed := FirewallExceptionsAllowed;

  if not ServiceActive
  or not  FirewallActive
  or (FirewallActive and not ExceptionsAllowed) then
    Exit;

  fwMgr := CreateOleObject(FW_MGR_CLASS_NAME);

  Profile := fwMgr.LocalPolicy.CurrentProfile;
  Profile.AuthorizedApplications.Remove(ApplicationFilename);

  Profile := Unassigned;
  fwMgr := Unassigned;
end;

end.

Ein Beispielaufruf könnte so aussehen:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var spathtoapp : string;
begin
  spathtoapp := paramstr(0);
  addtowinfirewall(spathtoapp,'meinprogrammname',true); //add to Windows Firewall Exeption List enabled
  addtowinfirewall(spathtoapp,'meinprogrammname',false); //change to disabled
  deletefromwinfirewall(spathtoapp); //delete from Windows Firewall Exeption List
end;