Имя пользователя:
Пароль:
 

Показать сообщение отдельно

Пользователь


Сообщения: 76
Благодарности: 43

Профиль | Отправить PM | Цитировать


ROMKA-1977, Пробуйте. Проверял на Ansi - Unicode, от Restools
Скрытый текст
Код: Выделить весь код
 
const
  NET_FW_SCOPE_ALL = 0;
  NET_FW_IP_VERSION_ANY = 2;
  NET_FW_ACTION_ALLOW = 1;

procedure SetFirewallExceptionXP(AppName,FileName:string);
var
  FirewallObject: Variant;
  FirewallManager: Variant;
  FirewallProfile: Variant;
begin
  try
    FirewallObject := CreateOleObject('HNetCfg.FwAuthorizedApplication');
    FirewallObject.ProcessImageFileName := FileName;
    FirewallObject.Name := AppName;
    FirewallObject.Scope := NET_FW_SCOPE_ALL;
    FirewallObject.IpVersion := NET_FW_IP_VERSION_ANY;
    FirewallObject.Enabled := True;
    FirewallManager := CreateOleObject('HNetCfg.FwMgr');
    FirewallProfile := FirewallManager.LocalPolicy.CurrentProfile;
    FirewallProfile.AuthorizedApplications.Add(FirewallObject);
  except
  end;
end;

procedure SetFirewallExceptionVista(AppName,FileName:string);
var
  firewallRule: Variant;
  firewallPolicy: Variant;
begin
  try
    firewallRule := CreateOleObject('HNetCfg.FWRule');
    firewallRule.Action := NET_FW_ACTION_ALLOW;
    firewallRule.Description := AppName;
    firewallRule.ApplicationName := FileName;
    firewallRule.Enabled := True;
    firewallRule.InterfaceTypes := 'All';
    firewallRule.Name := AppName;

    firewallPolicy := CreateOleObject('HNetCfg.FwPolicy2');
    firewallPolicy.Rules.Add(firewallRule);
  except
  end;
end;

procedure SetFirewallException(AppName,FileName:string);
var
  WindVer: TWindowsVersion;
begin
  try
    GetWindowsVersionEx(WindVer);
    if WindVer.NTPlatform and (WindVer.Major >= 6) then
      SetFirewallExceptionVista(AppName,FileName)
    else
      SetFirewallExceptionXP(AppName,FileName);
  except
  end;
end;

procedure RemoveFirewallException( FileName:string );
var
  FirewallManager: Variant;
  FirewallProfile: Variant;
begin
  try
    FirewallManager := CreateOleObject('HNetCfg.FwMgr');
    FirewallProfile := FirewallManager.LocalPolicy.CurrentProfile;
    FireWallProfile.AuthorizedApplications.Remove(FileName);
  except
  end;
end;

procedure CurStepChanged(CurStep: TSetupStep);
begin
  if CurStep=ssPostInstall then begin
     SetFirewallException('{#MyAppName}', ExpandConstant('{app}')+'\{#MyAppExeName}');
     end;
end;

procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
begin
  if CurUninstallStep=usPostUninstall then begin
     RemoveFirewallException(ExpandConstant('{app}')+'\{#MyAppExeName}');
  end;
end;

Последний раз редактировалось TryRooM, 07-08-2015 в 23:55.

Это сообщение посчитали полезным следующие участники:

Отправлено: 23:20, 07-08-2015 | #866