Interdire l'accès à certain sites internet

Cette source est considérée comme dangereuse, elle a néamoins été gardée dans un but pédagogique :
Cette source est considérée comme dangereuse, elle a néamoins été gardée dans un but pédagogique.

Description

Bonjour ;-)

Ben c'est un petit soft permettant d'interdire l'accès à certain sites Internet.

Grace à ce programme vous aller découvrie:

1-C'est quoi le fichier hosts
2-Comment charger un hosts dans une StringList
3-Ajouter/Supprimer des lignes du fichier
4-Enregistrer Une StringList dans un fichier hosts
5-Et enfin, comment Interdire l'accès à certain sites Internet via un programme crée en Delphi ;-)

Pour conclûre, je souhaite que mon exemple vous servira dans vos projets

Mes salutations les plus profondes distinguées.

Bonne chance et plein de succès.

Source / Exemple :


unit Afirst;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Buttons, ExtCtrls;

type
  TAFirstPage = class(TForm)
    PageControl: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    MmHost: TMemo;
    LBSites: TListBox;
    SBDelete: TSpeedButton;
    Panel: TPanel;
    EditSites: TEdit;
    SBAdd: TSpeedButton;
    LabelAdd: TLabel;
    GroupBox: TGroupBox;
    SBClose: TSpeedButton;
    SpeedButton1: TSpeedButton;
    LLSI: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure SBCloseClick(Sender: TObject);
    procedure SBAddClick(Sender: TObject);
    procedure SBDeleteClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure EditSitesKeyPress(Sender: TObject; var Key: Char);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  AFirstPage: TAFirstPage;
  ListeSites:TStrings;
implementation

{$R *.dfm}

procedure TAFirstPage.FormCreate(Sender: TObject);
var Hosts:string;
    Lignes:integer;
begin
LBSites.Clear; // Vider la ListBox

MmHost.Clear;    // Vider le memo

MmHost.Lines.LoadFromFile('C:\Windows\System32\Drivers\etc\hosts');// remplir le memo à partir du fichier hosts

ListeSites:=TStringList.Create; // Création d'une StringList

ListeSites.LoadFromFile('C:\Windows\System32\Drivers\etc\hosts');// charger la variable ListeSites à partir du fichier hosts
// maintenant on doit remplir notre ListBox à partir du hosts mais on a
// pas besoin d'avoir toutes le contenue du hosts, donc, on doit avoir que la
// liste des sites intendits
// si on appercoit le memo on constate que la liste des sites interdits
// commence par la Ligne 19, donc

for Lignes:=19 to ListeSites.Count-1 do
begin
hosts:=ListeSites.Strings[lignes];
if hosts<>'' then
LBSites.Items.Add(copy(hosts,17,length(hosts)));
end;

end;

procedure TAFirstPage.SBCloseClick(Sender: TObject);
begin
Application.Terminate; // Fermer l'application
end;

procedure TAFirstPage.SBAddClick(Sender: TObject);
begin
// Si EditSites n'est pas vide ajouter son contenue à LBSites si non Affichier le message
if EditSites.GetTextLen<>0 then
begin
// Ajouter le contenue de l'EditSites à notre LBSites (ListBox);
LBSites.Items.Add(EditSites.Text);
// Séléctionner le contenue de l'EditSites
EditSites.SelectAll;
// Ajouter le contenu de l'EditSites
ListeSites.Add('127.0.0.1       '+EditSites.Text);
// si non Affichier le message
end else begin
ShowMessage('Aucun site à interdire');
end;

end;

procedure TAFirstPage.SBDeleteClick(Sender: TObject);
var Numero:integer;
begin
Numero:=LBSites.ItemIndex;// Avoir l'index de la LBSites;
LBSites.DeleteSelected;// Supprimer l'item séléctionné;
ListeSites.Delete(19+Numero); // 19 Lignes + l'index de la LBSites varbiable numéro;
end;

procedure TAFirstPage.SpeedButton1Click(Sender: TObject);
begin
ListeSites.SaveToFile('C:\Windows\System32\Drivers\etc\hosts'); // Sauvegarder ListeSites
end;

procedure TAFirstPage.EditSitesKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then SBAdd.Click;
end;

procedure TAFirstPage.FormKeyPress(Sender: TObject; var Key: Char);
begin
// n'oublie pas de modifier KeyPreview
if key = #27 then // si la touche Echap est cliquée
SBClose.click;
end;

end.

Conclusion :


Toutes crétiques, interventoins, commentaires ... les bienvenus

Désolé pour les fautes de frappes ou d'orthographe.

et bonne chance à tt le monde.

Codes Sources

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.