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;

[sx2008]

Ich würde die Unit so ändern, dass die Funktionen IsFirewallServiceActive und IsFirewallActive im Interface Abschnitt der Unit liegen, denn das könnte durchaus für den Aufrufer von Interesse sein.
Ich habe noch weitere Änderungen gemacht und kommentiert und würde vorschlagen diese Änderungen (ohne meine Kommentare) im orginalen Sourcecode vorzunehmen.

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;  // verlagert von Interface nach hier

const // die Konstanten brauchen nicht veröffentlicht werden
  NET_FW_SCOPE_ALL = 0;
  NET_FW_IP_VERSION_ANY = 2;
  FW_MGR_CLASS_NAME = 'HNetCfg.FwMgr';
  FW_AUTHORIZEDAPPLICATION_CLASS_NAME = 'HNetCfg.FwAuthorizedApplication';

[fkerber]

Hi!

Stimmt, da hast du recht!
Werde das gleich oben ergänzen - Danke.


Ciao, Frederic

[toms]

Zitat:

Delphi-Quellcode:

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;

Was geschieht, wenn OpenSCManager fehlschlägt?
Ich würde noch ein if(SCM > 0) then hinzufügen
Was geschieht, wenn hService <= 0 zurückgibt? Muss dann wirklich CloseServiceHandle aufgerufen werden?

[axellang]

Hallo,

na ich will mich ja nicht einmischen aber hier findest Du einen "Windows Firewall Ports & Applications Manager" in Delphi geschrieben mit full source (letztes update 19.02.09). Letztendlich kannst Du dann im Source rumstöbern, lernen und Antworten auf deine Fragen finden.


Gruß

Axel

[toms]

Zitat:

Zitat von axellang

Hallo,

na ich will mich ja nicht einmischen aber hier findest Du einen "Windows Firewall Ports & Applications Manager" in Delphi geschrieben mit full source (letztes update 19.02.09). Letztendlich kannst Du dann im Source rumstöbern, lernen und Antworten auf deine Fragen finden.

Gruß

Axel

Hallo Axel

Danke für den Hinweis. Meine Fragen waren eher dazu da, damit man den Source-Code anpassen kann.
(Waren nicht wirklich echte Fragen)

[axellang]

Zitat:

Zitat von toms

Hallo Axel

Danke für den Hinweis. Meine Fragen waren eher dazu da, damit man den Source-Code anpassen kann.
(Waren nicht wirklich echte Fragen)

Ja, ist mir schon klar. Aber mit der Anwendung bzw. dem Source, hast Du die Möglichkeit zu sehen wie dass was Du vorhast, gemacht wird. Mit der Anwendung (siehe oben) kannst Du alle Funktionen der Windows Firewall steuern. Egal ob XP, Vista oder Win. 2003 Server.

Das ist besser wie jede Win. Firewall Hilfe.

Axel

[shmia]

Zitat:

Zitat von axellang

... findest Du einen "Windows Firewall Ports & Applications Manager" in Delphi geschrieben mit full source (letztes update 19.02.09). Letztendlich kannst Du dann im Source rumstöbern

Ich habe im Sourcecode rumgestöbert und finde ihn relativ unbrauchbar. :cry:
Es gibt keine Unit zum Ansteuern der Firewall sondern eine Anwendung, die so verzahnt ist, dass man kaum etwas davon extrahieren kann.
Es werden völlig unnötigerweise Threads eingesetzt.
Alle Manipulationen finden über die Registry statt; die Firewall API von Microsoft wird nicht benützt.

[Dezipaitor]

Zitat:

Zitat von fkerber

Der Code scheint nur unter Windows XP zu funktionieren.

Kannst du bitte etwas konkreter darauf eingehen? Was passiert in Vista? Wo?

thx

PS.

Also das hier funkz bei mir:
https://jedi-apilib.svn.sourceforge....clFirewall.pas

[fkerber]

Hi!

Ein erster Test unter Vista Ultimate 64-bit veranlasste ihn hier

Delphi-Quellcode:

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

zum Exit - natürlich bei laufender Firewall und Ausnahmen zugelassen.


Ciao, Frederic