Einzelnen Beitrag anzeigen

Benutzerbild von fkerber
fkerber
(CodeLib-Manager)

Registriert seit: 9. Jul 2003
Ort: Ensdorf
6.723 Beiträge
 
Delphi XE Professional
 
#1

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

  Alt 2. Mär 2009, 00:28
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;
Frederic Kerber
  Mit Zitat antworten Zitat