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

[Dezipaitor]

Und unter Windows XP 64bit funktioniert es?

[fkerber]

Hi!

Diese Frage kann ich leider nicht beantworten - aber wenn es jemand testen könnte, wäre das klasse!


Ciao, Frederic

[Dezipaitor]

Baaaaaaaaaaah!

Du musst schon genau angeben, welche Windowsversion und welche Bierzahl! Auf Win64 läuft oftmals einiges anders als auf 32Bit. Du redest also von Vista 64 aber auch über WindowsXP 32. D.h. ob es unter Vista und XP im allgemeinen funktioniert, kannst du nicht sagen.

[fkerber]

Hi!

Kein Grund hier rum zu baaahen, oder?

Es handelt sich um einen von mir aufbereiteten Code, das heißt, der Code stammt nicht von mir, sondern von den angegebenen Usern. Ich habe die Informationen zusammengetragen und der Code steht hier, um diskutiert und verbessert zu werden, bevor er in die Code-Library wandert.

Insofern verstehe ich deine Aufregung jetzt nicht.


Viele Grüße,
Frederic

[Dezipaitor]

Sorry, aber du bist zu unspezifisch.

Heiko hat den Code in die JWSCL eingebaut und wir haben ihn getestet und verbessert. Dass jetzt hier erzählt wird, dass es nicht funktioniert, hat die Alarmglocken schrillen lassen. Scheint wohl ein Fehlalarm zu sein, weil ich vermute, dass die Funktion mit dem Dienst fehlschlägt.

Aber wer braucht die denn? Wenn der Dienst nicht läuft, dann sollten alle COM Aufrufe auch fehlschlagen - man müsste nur die COM Fehlermeldung rausfinden.

[fkerber]

Hi!

Zitat:

Zitat von Dezipaitor

Sorry, aber du bist zu unspezifisch.

Heiko hat den Code in die JWSCL eingebaut und wir haben ihn getestet und verbessert. Dass jetzt hier erzählt wird, dass es nicht funktioniert, hat die Alarmglocken schrillen lassen.

Erstens ist das für mich eine vollkommen neue Information, dass dieser Code irgendwo eingesetzt wird, zweitens hat niemand behauptet, der Code würde nicht funktionieren (ich sagte scheinbar) und vor allem kann diese Aussage für obigen Code vollkommen korrekt sein, da er eben diese Überprüfung enthält. Wenn es also so sein sollte, dass die Überprüfung unter Vista fehlschlägt wäre meine Aussage vollkommen korrekt - was aber nicht heißt, dass die Eintrag-hinzufügen-Funktion an sich nicht funktioniert.


Ciao, Frederic

[Dezipaitor]

Zitat:

Zitat von fkerber

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.

Also das funktioniert "scheinbar" in Vista 64 nicht richtig, oder?

Wenn du etwas testest, musst du auf jeden Fall auch die Rahmenbedingungen dazu angeben, besonders dann, wenn du 64bit verwendest, da diese Plattform einfach noch nicht die große Mehrheit bei Desktopsystemen darstellt. Wenn du XP oder Vista meinst gehe zumindest ich davon aus, dass 32bit verwendet wird und werde dies dort testen. Einerseits redest du über Vista64 aber auf der anderen Seite über XP32 - das ist verwirrend. Oder was würdest du denken, wenn ich allgemein sage, dass ich Quelltext X auf Windows getestet habe? Welches Windows? Alle? Nur eins? Win7? 16bit?

IMHO sollte soetwas genau in der Codelib drinstehen, denn wer weiß schon, wie lange es drinbleibt. Und am Ende weiß keiner mehr für welches Windows der Quelltext ursprünglich entwickelt und getestet wurde (Nur für den Fall, wenn es nicht schon so ist :) ).

[fkerber]

Hi!

Wer sagt denn, dass obiger Code unter Vista 32-Bit läuft?
Bisher noch niemand...

Ciao, Frederic

[Mithrandir]

Nicht zerfleischen, Leute...

Wenn mir jemand eine kurze Testapp inkl. SC erstellt, dann teste ich das eben auf meinem Laptop (Vista 32bit), falls sich in den nächsten 48 Stunden keiner bereiterklärt. Delphi habe ich nicht installiert, deshalb kann ich kein Beispiel basteln.

Gruß,
Daniel

[Dezipaitor]

Ich schaue mir das mit dem Servicemanager gerade an.
Der ganze Code ist fehlerhaft und funktioniert auch unter XP nur dann, wenn man Adminrechte hat.

[Dezipaitor]

So isses besser, imho.

Delphi-Quellcode:

function IsWindowsFirewallServiceActive: Boolean;
var
  SCM, hService: LongWord;
  sStatus: TServiceStatus;
  dwStat: Cardinal;
begin
  SCM  := OpenSCManager(nil, nil, SC_MANAGER_ENUMERATE_SERVICE);
  if SCM <> 0 then
  begin
    hService := OpenService(SCM, PChar('SharedAccess'), SERVICE_QUERY_STATUS);
    if hService = 0 then //Vista,Win7
      hService := OpenService(SCM, PChar('MpsSvc'), SERVICE_QUERY_STATUS);

    try
      if (hService <> 0) then
      begin
        if (QueryServiceStatus(hService, sStatus)) then
        begin
          result := sStatus.dwCurrentState = SERVICE_RUNNING;
          exit;
        end;
      end;
    finally
      CloseServiceHandle(SCM);
      CloseServiceHandle(hService);
    end;
  end;

  raise EAccessViolation.Create('Could not determine Firewall Service status');
end;

[fkerber]

Hi!

Vielen Dank für deine Mühe.
Und genau für sowas ist eben diese Sparte da!


Ciao, Frederic

[fkerber]

Hi!

Also meine Tests zeigen mit deinem Code folgendes:

Vista Ultimate, 64 Bit: Test liefert false, egal ob Firewall-Service läuft oder nicht
Win XP - Home, 32 Bit: Test liefert richtige Ergebnisse


Ciao, Frederic

[Dezipaitor]

D.h. sStatus.dwCurrentState muss einen anderen Wert haben, als der angezeigte. Gib ihn einfach mal aus.

[fkerber]

Hi!

Also was mir aufgefallen ist:
hService ist nicht 0 wie ich es vermutet hätte, wenn ich deinen Kommentar hindert dem if lese.
Wenn ich mir sStatus.dwCurrentState ausgeben lasse ist es 1, wenn der Service läuft und ebenfalls 1, wenn er nicht läuft...

Wenn ich den Code so verändere, dass er immer

Delphi-Quellcode:

hService := OpenService(SCM, PChar('MpsSvc'), SERVICE_QUERY_STATUS);

ausführt, funktioniert der Test einwandfrei (Rückgabewert 4=SERVICE_RUNNING, wenn er läuft).
Es liegt also nicht an sStatus.dwCurrentState, sondern es liegt daran, dass hService nicht 0 ist, obwohl es Vista ist... (hService hat immer wechselnde Werte).


Ciao, Frederic

[Dezipaitor]

Tut mir leid, das ist ein Denkfehler gewesen.
Der SharedAccess-Dienst ist unter XP "Windows-Firewall/Gemeinsame Nutzung der Internetverbindung", während
in Vista es nur noch "Gemeinsame Nutzung der Internetverbindung" ist. Die WF ist ein eigener "Dienst".

Wir testen daher zuerst auf den Vista-Fall, da der in XP fehlschlägt (wenn kein anderer Dienst so heißt - muss ggf. noch mehr überprüft werden).

Delphi-Quellcode:

function IsWindowsFirewallServiceActive: Boolean;
var
  SCM, hService: LongWord;
  sStatus: TServiceStatus;
  dwStat: Cardinal;
begin
  SCM  := OpenSCManager(nil, nil, SC_MANAGER_ENUMERATE_SERVICE);
  if SCM <> 0 then
  begin
    //Vista,Win7
    hService := OpenService(SCM, PChar('MpsSvc'), SERVICE_QUERY_STATUS);

    if (hService = 0) and IsWindowsXP then 
      hService := OpenService(SCM, PChar('SharedAccess'), SERVICE_QUERY_STATUS);
    try
      if (hService <> 0) then
      begin
        if (QueryServiceStatus(hService, sStatus)) then
        begin
          result := sStatus.dwCurrentState = SERVICE_RUNNING;
          exit;
        end;
      end;
    finally
      CloseServiceHandle(SCM);
      CloseServiceHandle(hService);
    end;
  end;

  raise EAccessViolation.Create('Could not determine Firewall Service status');
end;

[fkerber]

Hi!

Wenn ich versuche den Code zu testen, sagt er:

Zitat:

[DCC Fehler] Unit1.pas(39): E2003 Undefinierter Bezeichner: 'IsWindowsXP'

Ciao, Frederic

[Dezipaitor]

IsWindowsXP kannst du mit jeder beliebigen Funktion ersetzen, die auf XP (ggf. noch >= SP2) prüft, da die IsWindowsFirewallServiceActive sonst unter Win2000 TRUE zurückliefert.

[Dezipaitor]

IsWindowsXP kannst du mit jeder beliebigen Funktion ersetzen, die auf XP (ggf. noch >= SP2) prüft, da die IsWindowsFirewallServiceActive sonst unter Win2000 (bzw. XP SP0/1) TRUE zurückliefert.


(Kann sein, dass DP gerade einen Schluckauf hat? Posts editieren oder adden dauert extrem lange oder funktionieren garnicht. :gruebel: )

[sirius]

Zitat:

Zitat von Dezipaitor

Der ganze Code ist fehlerhaft und funktioniert auch unter XP nur dann, wenn man Adminrechte hat.

Ja das hoffe ich doch. Und selbst da finde ich es unbefriedigend.

Verstehe ich das nur grad falsch? Warum kann ein Programm sich eigenhändig in die ExceptionList meiner Firewall eintragen? Ich hoffe mal dass das nicht geht.

[Dezipaitor]

Zitat:

Zitat von sirius

Ja das hoffe ich doch. Und selbst da finde ich es unbefriedigend.

Verstehe ich das nur grad falsch? Warum kann ein Programm sich eigenhändig in die ExceptionList meiner Firewall eintragen? Ich hoffe mal dass das nicht geht.

Der ursprüngliche Code fragt nur den FW Status ab. Aber das macht er, indem er erstmal alle Rechte anfordert. Das ist aber falsch, wenn man nur mal was lesen will, da man in diesem Fall immer Adminrechte braucht. Mit dem Rest hat das nichts zu tun. Schreibend braucht man da sowieso Adminrechte - aber lesend nicht unbedingt.

[fkerber]

Hi!

Ich habe nun diese genommen:

Delphi-Quellcode:

function IsWindowsXP: Boolean;
begin
  Result := (Win32MajorVersion = 5) and ( Win32MinorVersion = 1);
end;

Und damit funktioniert der Test vollkommen zufriedenstellend!
Danke für deine Mühe - ich werde es im Beitrag ergänzen/austauschen.


@Sirius:
Ich glaube die Aussage war nur auf die IsWindowsFirewallServiceActive-Funktion bezogen...


Ciao, Frederic

[Dezipaitor]

Du musst auf SP2 oder höher testen. Sonst kommt wieder ein TRUE raus!

[fkerber]

Hi!

Ist das hier eine praktikable Lösung? Es sieht nicht danach aus, aber was besseres ist mir nicht präsent...

Delphi-Quellcode:

function IsWindowsXP: Boolean;
begin
  Result := (Win32MajorVersion = 5) and ( Win32MinorVersion = 1) and (strtoint(copy(Win32CSDVersion,length(Win32CSDVersion),1))>=2);
end;

Ciao, Frederic

[shmia]

Falls irgend möglich würde ich auf das Abfragen der Windows Version verzichten.
Beispiel:
Die Funktion GetDefaultPrinterA() gibt es erst ab Windows 2000 (und höher).
Man könnte jetzt die Windowsversion abfragen und dann so reagieren:
Wenn WindowsVersion >= 2000 dann verwende GetDefaultPrinterA() anderfalls schau in die Registry oder die Win.ini.

Eine andere Strategie wäre mit GetProcAddress() zu prüfen, ob es die Funktion GetDefaultPrinterA() gibt.
Falls ja, benütze die Funktion, falls nein, erfolgt ein Fallback auf die älteren Alternativen.
Eine (unsichere) Abfrage der Windows Version wird hier nicht nötigt.

Übertragen auf die Firewall Geschichte heisst das:
Zuerst prüfen, ob die modernste API verfügbar ist (also ob die ProgID 'HNetCfg.FwMgr' registriert ist).
Falls nicht arbeite mit der API der älteren Windows Versionen.
Villeicht kommt ja ein Servicepack, der fehlende Funktionalität in den älteren Windowsversionen nachrüstet.
ok, ich glaube nicht mehr an den Weihnachtsmann, aber so ist man auf alles gerüstet :-)

[Dezipaitor]

Hier geht es nicht um die Verfügbarkeit einer API Funktion, sondern, ob ein Dienst eine FW implementiert hat oder nur die "Gemeinsame Internetnutzung". In XP < SP2 gibt es keine FW, und so würde ohne die Abfrage, trotzdem ermittelt, dass eine Windows Firewall existiert.

Natürlich geht es hier nur um die Windows Interne FW. 3rd Party FW sind nicht abgedeckt.