mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 17:27:32 +00:00
init
This commit is contained in:
+268
@@ -0,0 +1,268 @@
|
||||
unit WinFirewall;
|
||||
|
||||
{
|
||||
WinFirewall.pas — управление правилами Windows Firewall для HPSDR-приложения.
|
||||
|
||||
Логика работы:
|
||||
1. Сначала пробуем добавить все недостающие правила через COM без elevation.
|
||||
Если программа запущена с правами администратора — всё добавится сразу.
|
||||
2. Если COM не удался (нет прав) — собираем ВСЕ недостающие правила в одну
|
||||
batch-команду и вызываем UAC elevation ОДИН РАЗ.
|
||||
|
||||
Создаёт до 4 правил (каждое проверяется по имени, дубли не добавляются):
|
||||
"<AppName> UDP In" — входящий UDP (HPSDR Protocol 2)
|
||||
"<AppName> UDP Out" — исходящий UDP (HPSDR Protocol 2)
|
||||
"<AppName> TCP In" — входящий TCP (WebSocket/HTTP сервер)
|
||||
"<AppName> TCP Out" — исходящий TCP (WebSocket/HTTP сервер)
|
||||
}
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses SysUtils;
|
||||
|
||||
function FirewallRuleExists(const RuleName: string): Boolean;
|
||||
procedure FirewallEnsureAllowed(const ExePath, AppName: string);
|
||||
|
||||
implementation
|
||||
|
||||
{$IFDEF WINDOWS}
|
||||
uses
|
||||
Windows, ComObj, ActiveX, Variants, ShellAPI;
|
||||
|
||||
const
|
||||
PROGID_NETFW_POLICY2 = 'HNetCfg.FwPolicy2';
|
||||
PROGID_NETFW_RULE = 'HNetCfg.FWRule';
|
||||
NET_FW_RULE_DIR_IN = 1;
|
||||
NET_FW_RULE_DIR_OUT = 2;
|
||||
NET_FW_IP_PROTOCOL_TCP = 6;
|
||||
NET_FW_IP_PROTOCOL_UDP = 17;
|
||||
NET_FW_ACTION_ALLOW = 1;
|
||||
FW_PROFILE_ALL = Integer($7FFFFFFF);
|
||||
SEE_MASK_NOCLOSEPROCESS = DWORD($00000040);
|
||||
SEE_MASK_FLAG_NO_UI = DWORD($00000400);
|
||||
|
||||
{ ── Проверка наличия правила через COM ───────────────────────────────────── }
|
||||
|
||||
function FirewallRuleExists(const RuleName: string): Boolean;
|
||||
var
|
||||
FwPolicy2: OleVariant;
|
||||
FwRules: OleVariant;
|
||||
FwRule: OleVariant;
|
||||
Enum: IEnumVariant;
|
||||
fetched: LongWord;
|
||||
v: OleVariant;
|
||||
begin
|
||||
Result := False;
|
||||
try
|
||||
CoInitialize(nil);
|
||||
try
|
||||
FwPolicy2 := CreateOleObject(PROGID_NETFW_POLICY2);
|
||||
FwRules := FwPolicy2.Rules;
|
||||
Enum := IEnumVariant(IUnknown(FwRules._NewEnum));
|
||||
if Enum = nil then Exit;
|
||||
while Enum.Next(1, v, fetched) = S_OK do
|
||||
begin
|
||||
if fetched = 0 then Break;
|
||||
try
|
||||
FwRule := v;
|
||||
if CompareText(string(FwRule.Name), RuleName) = 0 then
|
||||
begin
|
||||
Result := True;
|
||||
Break;
|
||||
end;
|
||||
except
|
||||
end;
|
||||
v := Unassigned;
|
||||
end;
|
||||
finally
|
||||
CoUninitialize;
|
||||
end;
|
||||
except
|
||||
Result := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ── Добавление одного правила через COM (без elevation) ───────────────────── }
|
||||
|
||||
function TryAddRuleCOM(const ExePath, RuleName: string;
|
||||
Protocol, Direction: Integer; const Description: string): Boolean;
|
||||
var
|
||||
FwPolicy2: OleVariant;
|
||||
FwRules: OleVariant;
|
||||
FwRule: OleVariant;
|
||||
begin
|
||||
Result := False;
|
||||
try
|
||||
CoInitialize(nil);
|
||||
try
|
||||
FwPolicy2 := CreateOleObject(PROGID_NETFW_POLICY2);
|
||||
FwRules := FwPolicy2.Rules;
|
||||
FwRule := CreateOleObject(PROGID_NETFW_RULE);
|
||||
|
||||
FwRule.Name := RuleName;
|
||||
FwRule.Description := Description;
|
||||
FwRule.Protocol := Protocol;
|
||||
FwRule.Direction := Direction;
|
||||
FwRule.Action := NET_FW_ACTION_ALLOW;
|
||||
FwRule.Profiles := FW_PROFILE_ALL;
|
||||
FwRule.Enabled := True;
|
||||
|
||||
// ApplicationName только для входящих — для исходящих netsh dir=out
|
||||
// тоже не принимает program= на ряде версий Windows, поэтому
|
||||
// ограничиваем по приложению только In-правила
|
||||
if Direction = NET_FW_RULE_DIR_IN then
|
||||
FwRule.ApplicationName := ExePath;
|
||||
|
||||
FwRules.Add(FwRule);
|
||||
Result := True;
|
||||
finally
|
||||
CoUninitialize;
|
||||
end;
|
||||
except
|
||||
Result := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ── Elevation: добавляем ВСЕ недостающие правила ОДНИМ вызовом UAC ─────────
|
||||
Параметр Cmd — готовая batch-строка с несколькими netsh-командами,
|
||||
разделёнными через &&. Запускается cmd.exe /C "..." через runas. }
|
||||
|
||||
procedure RunElevated(const Cmd: AnsiString);
|
||||
var
|
||||
SEI: TShellExecuteInfoA;
|
||||
FileBuf: array[0..15] of AnsiChar;
|
||||
VerbBuf: array[0..7] of AnsiChar;
|
||||
ParamBuf: array[0..4095] of AnsiChar;
|
||||
begin
|
||||
StrPCopy(FileBuf, 'cmd.exe');
|
||||
StrPCopy(VerbBuf, 'runas');
|
||||
StrPCopy(ParamBuf, Cmd);
|
||||
|
||||
FillChar(SEI, SizeOf(SEI), 0);
|
||||
SEI.cbSize := SizeOf(SEI);
|
||||
SEI.fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI;
|
||||
SEI.lpVerb := @VerbBuf[0];
|
||||
SEI.lpFile := @FileBuf[0];
|
||||
SEI.lpParameters := @ParamBuf[0];
|
||||
SEI.nShow := SW_HIDE;
|
||||
|
||||
if ShellExecuteExA(@SEI) and (SEI.hProcess <> 0) then
|
||||
begin
|
||||
WaitForSingleObject(SEI.hProcess, 15000);
|
||||
CloseHandle(SEI.hProcess);
|
||||
end;
|
||||
end;
|
||||
|
||||
function NetshAddRule(const RuleName, ExePath, Proto, Dir: string): string;
|
||||
begin
|
||||
// Строит одну netsh-команду для добавления правила.
|
||||
// program= добавляем только для входящих (dir=in), для dir=out не указываем —
|
||||
// Windows Firewall для Out-правил program= игнорирует или отклоняет.
|
||||
Result := 'netsh advfirewall firewall add rule' +
|
||||
' name="' + RuleName + '"' +
|
||||
' dir=' + Dir +
|
||||
' action=allow' +
|
||||
' protocol=' + Proto +
|
||||
' enable=yes profile=any';
|
||||
if Dir = 'in' then
|
||||
Result := Result + ' program="' + ExePath + '"';
|
||||
end;
|
||||
|
||||
{ ── Основная точка входа ─────────────────────────────────────────────────── }
|
||||
|
||||
procedure FirewallEnsureAllowed(const ExePath, AppName: string);
|
||||
type
|
||||
TRuleInfo = record
|
||||
Name: string;
|
||||
Proto: Integer;
|
||||
Dir: Integer;
|
||||
Desc: string;
|
||||
ProtoStr: string;
|
||||
DirStr: string;
|
||||
end;
|
||||
const
|
||||
RULE_COUNT = 4;
|
||||
var
|
||||
Rules: array[0..RULE_COUNT-1] of TRuleInfo;
|
||||
i: Integer;
|
||||
NeedElevate: Boolean;
|
||||
BatchCmd: AnsiString;
|
||||
Sep: AnsiString;
|
||||
begin
|
||||
// Описываем все 4 правила
|
||||
Rules[0].Name := AppName + ' UDP In';
|
||||
Rules[0].Proto := NET_FW_IP_PROTOCOL_UDP;
|
||||
Rules[0].Dir := NET_FW_RULE_DIR_IN;
|
||||
Rules[0].Desc := 'HPSDR Protocol 2 UDP inbound';
|
||||
Rules[0].ProtoStr := 'udp';
|
||||
Rules[0].DirStr := 'in';
|
||||
|
||||
Rules[1].Name := AppName + ' UDP Out';
|
||||
Rules[1].Proto := NET_FW_IP_PROTOCOL_UDP;
|
||||
Rules[1].Dir := NET_FW_RULE_DIR_OUT;
|
||||
Rules[1].Desc := 'HPSDR Protocol 2 UDP outbound';
|
||||
Rules[1].ProtoStr := 'udp';
|
||||
Rules[1].DirStr := 'out';
|
||||
|
||||
Rules[2].Name := AppName + ' TCP In';
|
||||
Rules[2].Proto := NET_FW_IP_PROTOCOL_TCP;
|
||||
Rules[2].Dir := NET_FW_RULE_DIR_IN;
|
||||
Rules[2].Desc := 'HPSDR WebSocket/HTTP server TCP inbound';
|
||||
Rules[2].ProtoStr := 'tcp';
|
||||
Rules[2].DirStr := 'in';
|
||||
|
||||
Rules[3].Name := AppName + ' TCP Out';
|
||||
Rules[3].Proto := NET_FW_IP_PROTOCOL_TCP;
|
||||
Rules[3].Dir := NET_FW_RULE_DIR_OUT;
|
||||
Rules[3].Desc := 'HPSDR WebSocket/HTTP server TCP outbound';
|
||||
Rules[3].ProtoStr := 'tcp';
|
||||
Rules[3].DirStr := 'out';
|
||||
|
||||
// Шаг 1: пробуем добавить через COM без elevation.
|
||||
// Если запущены с правами админа — всё добавится здесь, UAC не понадобится.
|
||||
NeedElevate := False;
|
||||
for i := 0 to RULE_COUNT - 1 do
|
||||
begin
|
||||
if FirewallRuleExists(Rules[i].Name) then Continue;
|
||||
if not TryAddRuleCOM(ExePath, Rules[i].Name,
|
||||
Rules[i].Proto, Rules[i].Dir, Rules[i].Desc) then
|
||||
NeedElevate := True; // COM не удался — запомним, соберём batch
|
||||
end;
|
||||
|
||||
if not NeedElevate then Exit;
|
||||
|
||||
// Шаг 2: COM не удался (нет прав). Собираем ВСЕ недостающие правила
|
||||
// в одну batch-строку и поднимаем UAC ровно ОДИН РАЗ.
|
||||
BatchCmd := '/C ';
|
||||
Sep := '';
|
||||
for i := 0 to RULE_COUNT - 1 do
|
||||
begin
|
||||
if FirewallRuleExists(Rules[i].Name) then Continue;
|
||||
BatchCmd := BatchCmd + Sep +
|
||||
AnsiString(NetshAddRule(Rules[i].Name, ExePath,
|
||||
Rules[i].ProtoStr, Rules[i].DirStr));
|
||||
Sep := ' && ';
|
||||
end;
|
||||
|
||||
if BatchCmd <> '/C ' then
|
||||
RunElevated(BatchCmd);
|
||||
end;
|
||||
|
||||
{$ELSE}
|
||||
|
||||
{ ── Заглушки для Linux / macOS ───────────────────────────────────────────── }
|
||||
|
||||
function FirewallRuleExists(const RuleName: string): Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure FirewallEnsureAllowed(const ExePath, AppName: string);
|
||||
begin
|
||||
end;
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user