V5.73

UnitPareFeu.pas

@@ -0,0 +1,185 @@
+unit UnitPareFeu;
+
+interface
+function verifie_regle : integer;
+function cree_regle : boolean;
+
+implementation
+
+uses
+  SysUtils,ActiveX,ComObj,Variants,UnitPrinc,Graphics,unitConfig;
+Const
+  NET_FW_ACTION_ALLOW = 1;
+  NET_FW_IP_PROTOCOL_TCP = 6;
+  NET_FW_IP_PROTOCOL_UDP = 17;
+  NET_FW_IP_PROTOCOL_ANY = 256;
+  net_fw_profile2_private=2;
+  net_fw_profile2_public=4;
+  net_fw_rule_dir_out=2;
+  net_fw_rule_dir_in=1;
+  NET_FW_MODIFY_STATE_OK = 0;
+  NET_FW_MODIFY_STATE_GP_OVERRIDE = 1;
+  NET_FW_MODIFY_STATE_INBOUND_BLOCKED = 2;
+  nom_regle_cdm='CDM rail';
+
+// Ajoute une règle à un programme en utilisant Microsoft Windows Firewall APIs.
+function AddApplicationRule : boolean;
+var
+  CurrentProfiles,fwPolicy2,RulesObject,NewRule : OleVariant;
+  s,fichier : string;
+  r : boolean;
+begin
+  r:=false;
+  if IsWow64Process then fichier:='C:\Program Files (x86)\CDM-Rail\cdr.exe' else fichier:='C:\Program Files\CDM-Rail\cdr.exe';
+  // Crée l'objet FwPolicy2
+  fwPolicy2:=CreateOleObject('HNetCfg.FwPolicy2');
+  RulesObject:=fwPolicy2.Rules;
+  CurrentProfiles:= fwPolicy2.CurrentProfileTypes;
+  //CurrentProfiles:=net_fw_profile2_private or net_fw_profile2_public;
+
+  //Crée l'objet de la règle.
+  NewRule:=CreateOleObject('HNetCfg.FWRule');
+
+  NewRule.Name:=nom_regle_cdm;
+  NewRule.Description:='Autorise le socket de/vers CDM rail';
+
+  NewRule.Applicationname:=fichier;
+  NewRule.Protocol:=NET_FW_IP_PROTOCOL_TCP;
+  //NewRule.LocalPorts := '9999';   // '80,443,4520-4533'   sans spécif=tous ports
+  NewRule.Direction:=net_fw_rule_dir_in;
+  NewRule.Enabled:=True;
+  NewRule.Grouping:='';
+  NewRule.Profiles:=CurrentProfiles;
+  NewRule.Action:=NET_FW_ACTION_ALLOW;
+
+  //Ajouter une règle
+  try
+    RulesObject.Add(NewRule);
+    r:=true;
+  except
+    begin
+      s:='Erreur: impossible d''accéder au pare feu windows. Le pare feu est géré par un programme tiers.';
+      Affiche(s,clred);
+      formconfig.Labelinfo.caption:=s;
+      r:=false;
+    end;
+  end;
+  result:=r;
+end;
+
+function cree_regle : boolean;
+var CoResult : Hresult;
+    s : string;
+    r : boolean;
+begin
+  r:=false;
+  try
+    CoResult:=CoInitializeEx(nil,COINIT_MULTITHREADED);
+    try
+      r:=AddApplicationRule;
+    finally
+    begin
+      CoUninitialize;
+      if r then
+      begin
+        s:='Ajout de la règle '+nom_regle_cdm+' dans le pare-feu';
+        formconfig.Labelinfo.caption:=s;
+        Affiche(s,clyellow);
+      end;
+    end;
+  end;
+  except
+    on E:EOleException do
+    begin
+      Affiche('EOleException '+E.Message+intToSTR(E.ErrorCode),clred);
+      r:=false;
+    end;
+    on E:Exception do
+    begin
+      Affiche(E.Classname+':'+E.Message,clred);
+      r:=false;
+    end;
+  end;
+  result:=r;
+end;
+
+
+// vérifie si la règle cdm est dans le parefeu windows
+// retour =0 : pas dans le pare feu
+// =1 oui mais inactive
+// =2 oui et active
+function CheckingRuleEnabled : integer;
+var
+  fwPolicy2,RulesObject,rule : OleVariant;
+  PolicyModifyState,CurrentProfiles : Integer;
+  bIsEnabled,trouve : Boolean;
+  oEnum : IEnumvariant;
+  iValue : LongWord;
+  s : string;
+begin
+  fwPolicy2:= CreateOleObject('HNetCfg.FwPolicy2');
+  RulesObject:=fwPolicy2.Rules;
+  CurrentProfiles:=fwPolicy2.CurrentProfileTypes;
+  trouve:=false ;
+  oEnum:=IUnknown(Rulesobject._NewEnum) as IEnumVariant;
+  while (oEnum.Next(1,rule,iValue)=0) and not(trouve) do
+  begin
+    if (rule.Profiles And CurrentProfiles)<>0 then
+    begin
+      s:=rule.Name;
+      trouve:=s=nom_regle_cdm;
+      if trouve then
+      begin
+        Affiche('Description de l''autorisation socket pour CDM rail dans le pare-feu Windows',clyellow);
+        Affiche('Nom : ' + s,clLime);
+        Affiche('Description : ' + rule.Description,clLime);
+        Affiche('Nom d''application: ' + rule.ApplicationName,clLime);
+        Affiche('Nom du service: ' + rule.ServiceName,clLime);
+        bIsEnabled:=rule.enabled;
+        if bisEnabled then affiche('Activée',clLime) else affiche('désactivée',clLime) ;
+        if (rule.Protocol=NET_FW_IP_PROTOCOL_TCP) or (rule.Protocol=NET_FW_IP_PROTOCOL_UDP) then
+        begin
+          if (rule.Protocol=NET_FW_IP_PROTOCOL_TCP) then Affiche('Protocole : TCP',clLime);
+          if (rule.Protocol=NET_FW_IP_PROTOCOL_UDP) then Affiche('Protocole : UDP',clLime);
+          Affiche('Ports locaux : ' + rule.LocalPorts,clLime);
+          Affiche('Ports distants : ' + rule.RemotePorts,clLime);
+          Affiche('Adresses locales : ' + rule.LocalAddresses,clLime);
+          Affiche('Adresses distantes : ' + rule.RemoteAddresses,clLime);
+        end;
+      end;
+    end;
+  end;
+  if not(trouve) then
+  begin
+    result:=0;
+  end
+  else
+    begin
+      if bIsEnabled then result:=2 else result:=1;
+    end;
+end;
+
+function verifie_regle : integer;
+var i : integer;
+begin
+  i:=0;
+  try
+    CoInitialize(nil);
+    try
+      i:=CheckingRuleEnabled;
+    finally
+      CoUninitialize;
+    end;
+  except
+    on E:EOleException do
+        Affiche('EOleException '+E.Message+intToSTR(E.ErrorCode),clred);
+    on E:Exception do
+        Affiche(E.Classname+':'+E.Message,clred);
+  end;
+  result:=i;
+end;
+
+
+begin
+end.
+