尝试从我们的开源
SQlite3UI.pas单元中提取的代码:
- function GetXPFirewall(var fwMgr,profile: OleVariant): boolean;
- begin
- Result := (Win32Platform=VER_PLATFORM_WIN32_NT) and
- (Win32MajorVersion>5) or ((Win32MajorVersion=5) and (Win32MinorVersion>0));
- if result then // need Windows XP at least
- try
- fwMgr := CreateOleObject('HNetCfg.FwMgr');
- profile := fwMgr.LocalPolicy.CurrentProfile;
- except
- on E: Exception do
- result := false;
- end;
- end;
- const
- NET_FW_PROFILE_DOMAIN = 0;
- NET_FW_PROFILE_STANDARD = 1;
- NET_FW_IP_VERSION_ANY = 2;
- NET_FW_IP_PROTOCOL_UDP = 17;
- NET_FW_IP_PROTOCOL_TCP = 6;
- NET_FW_SCOPE_ALL = 0;
- NET_FW_SCOPE_LOCAL_SUBNET = 1;
- procedure AddApplicationToXPFirewall(const EntryName,ApplicationPathAndExe: string);
- var fwMgr,profile,app: OleVariant;
- begin
- if GetXPFirewall(fwMgr,profile) then
- try
- if profile.FirewallEnabled then begin
- app := CreateOLEObject('HNetCfg.FwAuthorizedApplication');
- try
- app.ProcessImageFileName := ApplicationPathAndExe;
- app.Name := EntryName;
- app.Scope := NET_FW_SCOPE_ALL;
- app.IpVersion := NET_FW_IP_VERSION_ANY;
- app.Enabled :=true;
- profile.AuthorizedApplications.Add(app);
- finally
- app := varNull;
- end;
- end;
- finally
- profile := varNull;
- fwMgr := varNull;
- end;
- end;
- procedure AddPortToXPFirewall(const EntryName: string; PortNumber: cardinal);
- var fwMgr,port: OleVariant;
- begin
- if GetXPFirewall(fwMgr,profile) then
- try
- if profile.FirewallEnabled then begin
- port := CreateOLEObject('HNetCfg.FWOpenPort');
- port.Name := EntryName;
- port.Protocol := NET_FW_IP_PROTOCOL_TCP;
- port.Port := PortNumber;
- port.Scope := NET_FW_SCOPE_ALL;
- port.Enabled := true;
- profile.GloballyOpenPorts.Add(port);
- end;
- finally
- port := varNull;
- profile := varNull;
- fwMgr := varNull;
- end;
- end;
它将允许您将应用程序或端口添加到XP防火墙.应该从德尔福6到XE工作.