this slowpoke moves

Firewall Ein und Ausschalten

uses ExtCtrls, ComObj

Procedure SetFirewallOn;
Const
  NET_FW_PROFILE2_DOMAIN  = 1;
  NET_FW_PROFILE2_PRIVATE = 2;
  NET_FW_PROFILE2_PUBLIC  = 4;
var
 fwPolicy2       : OleVariant;
 CurrentProfiles : OleVariant;
begin
  if (Win32MajorVersion=6) or (Win32MajorVersion=10) then
    begin
      if Win32MinorVersion>0 then
        begin
          fwPolicy2   := CreateOleObject('HNetCfg.FwPolicy2');
          CurrentProfiles := fwPolicy2.CurrentProfileTypes;
            if not fwPolicy2.FirewallEnabled[NET_FW_PROFILE2_DOMAIN]  then
            fwPolicy2.FirewallEnabled[NET_FW_PROFILE2_DOMAIN]:= True;
            if not fwPolicy2.FirewallEnabled[NET_FW_PROFILE2_PRIVATE]  then
            fwPolicy2.FirewallEnabled[NET_FW_PROFILE2_PRIVATE]:= True;
              if not fwPolicy2.FirewallEnabled[NET_FW_PROFILE2_PUBLIC]  then
              fwPolicy2.FirewallEnabled[NET_FW_PROFILE2_PUBLIC]:= True;

        end;
        fwPolicy2 := Unassigned;
        CurrentProfiles := Unassigned;
     end
      else
  begin
    Showmessage('Diese Anwendung funktioniert nicht auf diesem Betriebssystemen');
  end;
end;

Procedure SetFirewallOff;
Const
  NET_FW_PROFILE2_DOMAIN  = 1;
  NET_FW_PROFILE2_PRIVATE = 2;
  NET_FW_PROFILE2_PUBLIC  = 4;
var
 fwPolicy2       : OleVariant;
 CurrentProfiles : OleVariant;
begin
  if (Win32MajorVersion=6) or (Win32MajorVersion=10) then
    begin
      if Win32MinorVersion>0 then
        begin
          fwPolicy2   := CreateOleObject('HNetCfg.FwPolicy2');
          CurrentProfiles := fwPolicy2.CurrentProfileTypes;
          if fwPolicy2.FirewallEnabled[NET_FW_PROFILE2_DOMAIN]  then
            fwPolicy2.FirewallEnabled[NET_FW_PROFILE2_DOMAIN]:= False;
          if fwPolicy2.FirewallEnabled[NET_FW_PROFILE2_PRIVATE]  then
            fwPolicy2.FirewallEnabled[NET_FW_PROFILE2_PRIVATE]:= False;
          if fwPolicy2.FirewallEnabled[NET_FW_PROFILE2_PUBLIC]  then
            fwPolicy2.FirewallEnabled[NET_FW_PROFILE2_PUBLIC]:= False;
        end;
        fwPolicy2 := Unassigned;
        CurrentProfiles := Unassigned;
     end
      else
  begin
    Showmessage('Diese Anwendung funktioniert nicht auf diesem Betriebssystemen');
  end;
end;


procedure TForm1.Timer1Timer(Sender: TObject);
Const
  NET_FW_PROFILE2_DOMAIN  = 1;
  NET_FW_PROFILE2_PRIVATE = 2;
  NET_FW_PROFILE2_PUBLIC  = 4;
var
 fwPolicy2       : OleVariant;
 CurrentProfiles : OleVariant;
begin
  if (Win32MajorVersion=6) or (Win32MajorVersion=10) then
    begin
      if Win32MinorVersion>0 then
        begin
          fwPolicy2 := CreateOleObject('HNetCfg.FwPolicy2');
          CurrentProfiles := fwPolicy2.CurrentProfileTypes;

         if (CurrentProfiles and NET_FW_PROFILE2_PRIVATE)<>0 then
           begin
             Label1.Caption := 'Sie sind mit einem privaten Netzwerk verbunden';

             Label2.Font.Style:=[fsBold];
             Label3.Font.Style:=Label3.Font.Style-[fsBold];
             Label4.Font.Style:=Label4.Font.Style-[fsBold];
           end;

         if (CurrentProfiles and NET_FW_PROFILE2_PUBLIC)<>0 then
           begin
             Label1.Caption := 'Sie sind mit einem öffentlichen Netzwerk verbunden';

             Label2.Font.Style:= Label2.Font.Style-[fsBold];
             Label3.Font.Style:=[fsBold];
             Label4.Font.Style:=Label4.Font.Style-[fsBold];
           end;


         if (CurrentProfiles and NET_FW_PROFILE2_DOMAIN)<>0 then
           begin
             Label1.Caption := 'Sie sind mit einem Netzwerk von Domaine verbunden';

             Label2.Font.Style:= Label2.Font.Style-[fsBold];
             Label3.Font.Style:=Label3.Font.Style-[fsBold];
             Label4.Font.Style:=[fsBold];
           end;

          if fwPolicy2.FirewallEnabled[NET_FW_PROFILE2_PRIVATE]= True then
              begin
                Shape_Etat_Parefeu_Prive.Brush.Color:=clLime;
                Label2.Caption:='Die Windows-Firewall ist in privaten Netzwerken (privat oder geschäftlich) aktiviert.';
              end
                else
              begin
                Shape_Etat_Parefeu_Prive.Brush.Color:=clRed;
                Label2.Caption:='Die Windows-Firewall ist in privaten Netzwerken (privat oder geschäftlich) deaktiviert.';
                Label2.Font.Style:=Label2.Font.Style-[fsBold];
              end;

          if fwPolicy2.FirewallEnabled[NET_FW_PROFILE2_PUBLIC]= True then
                begin
                Shape_Etat_Parefeu_Public.Brush.Color:=clLime;
                Label3.Caption:='Die Windows-Firewall ist in öffentlichen Netzwerken oder Gastnetzwerken aktiviert';
                end
                  else
                begin
                  Shape_Etat_Parefeu_Public.Brush.Color:=clRed;
                  Label3.Caption:='Die Windows-Firewall ist in öffentlichen Netzwerken oder Gastnetzwerken deaktiviert';
                  Label3.Font.Style:=Label3.Font.Style-[fsBold];
                end;

         if fwPolicy2.FirewallEnabled[NET_FW_PROFILE2_DOMAIN]= True then
              begin
                Shape_Etat_Parefeu_Domaine.Brush.Color:=clLime;
                Label4.Caption:='Die Windows-Firewall ist in Domänennetzwerken aktiviert';
              end
                else
              begin
                Shape_Etat_Parefeu_Domaine.Brush.Color:=clRed;
                Label4.Caption:='Die Windows-Firewall ist in Domänennetzwerken deaktiviert';
                Label2.Font.Style:=Label2.Font.Style-[fsBold];
              end;
          fwPolicy2 := Unassigned;
          CurrentProfiles := Unassigned;
        end;
  end;
end;
Firewall Einschalten :
procedure TForm1.Button1Click(Sender: TObject);
begin
  Try
    SetFirewallOn;
  Except on E:exception do
    begin
      if E.Message='Zugriff verweigert' then
      MessageDlg(E.Message+#13#10+'Info: Die Anwendung muss als Administrator ausgeführt werden.',mtError,[mbOK],0)
        else
      MessageDlg(E.Message,mtError,[mbOK],0);
    end;
  end;
end;
Firewall Ausschalten :

procedure TForm1.Button2Click(Sender: TObject);
begin
  Try
    SetFirewallOff;
  Except on E:exception do
    begin
      if E.Message='Zugriff verweigert' then
      MessageDlg(E.Message+#13#10+'Info: Die Anwendung muss als Administrator ausgeführt werden.',mtError,[mbOK],0)
        else
      MessageDlg(E.Message,mtError,[mbOK],0);
    end;
  end;
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate