1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
{
This file is part of the Free Pascal run time library.
Copyright (c) 2009 by the Free Pascal development team
Misc windows utility functions
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{$mode objfpc}{$H+}
unit winutils;
Interface
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
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
SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5)) ;
const
SECURITY_BUILTIN_DOMAIN_RID = $00000020;
DOMAIN_ALIAS_RID_ADMINS = $00000220;
function IsWindowsAdmin: Boolean;
var
hAccessToken: THandle;
ptgGroups: PTokenGroups;
dwInfoBufferSize: DWORD;
psidAdministrators: PSID;
g: Integer;
bSuccess: BOOL;
begin
Result := False;
bSuccess := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, hAccessToken) ;
if not bSuccess then
begin
if GetLastError = ERROR_NO_TOKEN then
bSuccess := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, hAccessToken) ;
end;
if bSuccess then
begin
GetMem(ptgGroups, 1024) ;
bSuccess := GetTokenInformation(hAccessToken, TokenGroups, ptgGroups, 1024, dwInfoBufferSize) ;
CloseHandle(hAccessToken) ;
if bSuccess then
begin
AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, psidAdministrators) ;
for g := 0 to ptgGroups^.GroupCount - 1 do
if EqualSid(psidAdministrators, ptgGroups^.Groups[g].Sid) then
begin
Result := True;
Break;
end;
FreeSid(psidAdministrators) ;
end;
FreeMem(ptgGroups) ;
end;
end;
procedure UnBlockFile(const name:String);
var f : file;
begin
assignfile(f,name+':Zone.Identifier');
rewrite(f,1);
truncate(f);
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.
|
