المساعد الشخصي الرقمي

مشاهدة النسخة كاملة : برنامج لمنع الوصول إلى بعض مواقع الأنترنيت


HAFTARI
11-03-2008, 07:59 PM
السلام عليكم و رحم ة الله تعالى و بركاته
أقدم لكم هذه المرة برنامج من إنجازاتي الخاصة ب الدلفي و الذي يمنع الوصول إلى مواقع الأنترنت المحضورة في قائمة Hosts
الرجاء أن أسمحوا لي إخوتي فالبرنامج غير مشروح بالعربي و لكن بالفرنسي -معدرة مرة أخرى-
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\Dri vers\etc\hosts');// remplir le memo à partir du fichier hosts

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

ListeSites.LoadFromFile('C:\Windows\System32\Drive rs\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.

و في الختام أتمنى أن تكونوا قد استفدتم من هذاالمثال و هو هدية إلى كل مبتدئ في البرمجة مثلنا جميعا,
و السلام عليكم و رحمة الله تعالى و بركاته

B.M.AbdelAziZ
11-03-2008, 08:18 PM
بسم الله الرحمن الرحيم

برامج حظر المواقع الإباحية اكثر تعقيدا خاصة من حيث "طريقة الحظر" لكنها كبداية ليست سيئة

والسلام عليكم ورحمة الله

gladiator16
03-03-2011, 03:47 PM
السلام عليكم ورحمة الله وبركاته
امنع المواقع الاباحية عن اطفالك بهذا البرنامج
خصائص البرنامج
اضافة وحذف وتعديل المواقع
ايجاد مسار الهوست حيثما يوجد الويندلوز

King SofT
03-03-2011, 04:53 PM
بارك الله فيك اخي
جاري التجريب

B.M.AbdelAziZ
03-03-2011, 06:46 PM
gladiator16 مرفقك نفس مرفق HAFTARI
عندما تعدل على برامج غيرك اذكر ذلك
تم دمج الموضوعين

gladiator16
04-03-2011, 10:45 AM
gladiator16 مرفقك نفس مرفق haftari
لقد اخذت القليل فقط منه :)
في الفورم.شاو فقط وهذا
هو المستخدم فقط
t:=tstringlist.create;
t.loadfromfile(windowsdirectory+'system32\drivers\ etc\hosts');
lst2.items.loadfromfile(windowsdirectory+'system32 \drivers\etc\hosts');
for i:=19 to t.count-1 do begin
h:=t.strings[i];
lst1.items.add(copy((h),11,length(h))) ;
والباقي اضافاتي
وشكراا لصاحب الموضوع على مشاركتنا

karamofweb
04-03-2011, 01:12 PM
محاولة في المستوى و فكرة سديدة، لكن على ما أظن البرنامج فيه مشكل، فأول ما جربته هو جوجل google لكنه لم يغلق أي شيئ منه