paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 01:09:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Simple Add/remove firewall rule wrapper by d4nn13 (forum)

Browse Source 
git-svn-id: trunk@25021 -
This commit is contained in:
marco 2013-06-30 16:19:01 +00:00
parent 6ab95815d8
commit ee5ce52d4c
1 changed files with 43 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
packages/winunits-base/src/winutils.pp
View File

@ -18,7 +18,7 @@ unit winutils;
Interface
Uses Windows;
Uses Windows, ComObj, ActiveX;
// returns True if the currently logged Windows user has Administrator rights. Delphi.about.com
// From Delphi.about.com with permission, http://delphi.about.com/od/delphitips2007/qt/is_win_admin.htm
@ -27,6 +27,21 @@ function IsWindowsAdmin: Boolean;
// Removes Browsers "downloaded" attribute from a file.
procedure UnBlockFile(const name: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_IP_PROTOCOL_UDP = 17;
NET_FW_ACTION_ALLOW = 1;
// add firewall rule e.g.
// AddProgramExceptionToFireWall( Application.Title,Application.Title, Application.ExeName, NET_FW_IP_PROTOCOL_TCP, NET_FW_PROFILE2_DOMAIN or NET_FW_PROFILE2_PRIVATE or NET_FW_PROFILE2_PUBLIC);
procedure AddProgramExceptionToFireWall(Const wsCaption, wsDescription, wsExecutable: WideString; iProtocol,iProfile:Integer);
// remove firewall rule, e.g. RemoveExceptionFromFW(Application.Title);
procedure RemoveExceptionFromFW(Const exCaption: WideString);
implementation
const
@ -91,4 +106,31 @@ begin
closefile(f);
end;
procedure AddProgramExceptionToFireWall(Const wsCaption, wsDescription, wsExecutable: WideString; iProtocol, iProfile:Integer);
var
fwPolicy2 : OleVariant;
RulesObject : OleVariant;
NewRule : OleVariant;
begin
fwPolicy2 := CreateOleObject('HNetCfg.FwPolicy2');
RulesObject := fwPolicy2.Rules;
NewRule := CreateOleObject('HNetCfg.FWRule');
NewRule.Name := wsCaption;
NewRule.Description := wsDescription;
NewRule.Applicationname := wsExecutable;
NewRule.Protocol := iProtocol;
NewRule.Enabled := TRUE;
NewRule.Profiles := iProfile;
NewRule.Action := NET_FW_ACTION_ALLOW;
RulesObject.Add(NewRule);
end;
procedure RemoveExceptionFromFW(Const exCaption: WideString);
var
fwPolicy2 : OleVariant;
begin
fwPolicy2 := CreateOleObject('HNetCfg.FwPolicy2');
fwPolicy2.Rules.Remove(exCaption);
end;
end.