البحث ثم المطابقة مع قاعدة البيانات

[Benhlell]

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

PHP كود :

unit Unit1;

[]interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, sPanel, sSkinProvider, sSkinManager, ComCtrls, XPMan,
  StdCtrls, sEdit, sAlphaListBox, sButton, AdvPicture, DB, DBTables, Grids,
  DBGrids;

type
  TForm1 = class(TForm)
    sSkinManager1: TsSkinManager;
    sSkinProvider1: TsSkinProvider;
    sPanel1: TsPanel;
    sListBox1: TsListBox;
    sPanel2: TsPanel;
    Edit1: TsEdit;
    XPManifest1: TXPManifest;
    ProgressBar1: TProgressBar;
    sButton1: TsButton;
    sButton2: TsButton;
    sButton3: TsButton;
    DataSource1: TDataSource;
    Table1: TTable;
    Label1: TLabel;
    DBGrid1: TDBGrid;
    procedure sButton1Click(Sender: TObject);
    procedure RF(const folder: TFileName);
    procedure sButton3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.sButton1Click(Sender: TObject);
begin
RF('C:\');//برتشن البحث
end;
procedure TForm1.RF(const folder: TFileName);
var
  Sr: TSearchRec;
begin
   if FindFirst(folder + '*.*', faAnyFile, Sr) = 0 then
    begin
       Edit1.Text:=folder;
      try
      repeat
        if (Sr.Attr and faDirectory = 0) or( Sr.Name <> '.') and (Sr.Name <> '..') then
            Begin
            If Table1.Locate('Nom',Sr.Name , [locaseinsensitive,lopartialkey]) Then //تم البحث في حقل الاسماء
               Deletefile(Folder+Sr.Name);//عند المطابقة مع قاعدة لبيانات يتوقف البرنامج
            end;
      until FindNext(Sr) <> 0;
      except
      FindClose(Sr);
      raise;
    end;
FindClose(Sr);
end;
if FindFirst(folder + '*.*', faAnyFile Or faDirectory, Sr) = 0 then
  begin
    try
      repeat
        if ((Sr.Attr and faDirectory) <> 0) and
           (Sr.Name <> '.') and (Sr.Name <> '..') then
           begin
            RF(folder + Sr.Name + '\');
            Edit1.Text:=folder;
            Edit1.Refresh;
           end;
      until FindNext(Sr) <> 0;
      except
      FindClose(Sr);
      raise;
    end;
    FindClose(Sr);
  end;
end;


procedure TForm1.sButton3Click(Sender: TObject);
begin
Close;        //الخروج من البرنامج
end;

end. 


[/align][/align][/align]
ساضع البرنامج في المرفقات

[Benhlell]

وجدت حلها
-
مشكل اخر كيف استعمل المكون sCheckListBox1 بحيث عند وضع العلامة على شرط واحد يتم تنقيد امر
مثال

PHP كود :

if FrmScan.CheckBox1.Checked = True then
   sowmessage('Yes'); 


[AL-MOB4RM3G]

وجدت حلها

جميل اخي الكريم,
بما انّك وجدت الحلّ فقم بوضع الحلّ هنا لعل احد يستفيد منه بارك الله لك,

امّا بخصوص سؤآلك,

يمكن ان تستفيد من الحدث, OnClickCheck للمكون نفسه,

وهذا مثآل ربما يفيدك,

PHP كود :

procedure TForm1.CheckListBox1ClickCheck(Sender: TObject);
begin
if form1.CheckListBox1.State[0] = cbChecked then
  begin
    Showmessage('Checked');
  end;
end; 


بالتوفيق

[Benhlell]

اما بنسبة للحل فانا كنت نخطا جعلت البحث يفرق بين الحروف الكبير والصغير (تافه ها ها ها)
ومشكور اخي على الفكرة جربتها ونجحة

[Benhlell]

كود :

procedure TForm1.sButton1Click(Sender: TObject); begin RF('C:\');//برتشن البحث end; procedure TForm1.RF(const folder: TFileName); var Sr: TSearchRec; begin if FindFirst(folder + '*.*', faAnyFile, Sr) = 0 then begin Edit1.Text:=folder; try repeat if (Sr.Attr and faDirectory = 0) or( Sr.Name <> '.') and (Sr.Name <> '..') then Begin until FindNext(Sr) <> 0; except FindClose(Sr); raise; end; FindClose(Sr); end;

كيف اجعل السورس يبحث عن اكثر من امتداد :monster1:

[Benhlell]

اعمل على برنامج للبحث عن الملفت وعرضها في قائمة لكن عند النقر على الزر يتوقف البرنامج نهائيا حتى يتم عملية البحث ثم يقوم بعرض محتوى القائمة )يعلق البرنامج( اضطر احيانا الى النقر على Alt Ctrl Supp واقاغه ماهو الحل
افيدوني مما علمكم الله:monster2:

[kachwahed]

أولا: ألق السلام أخي الكريم
السلام عليكم ورحمة الله
لم تقدم أي معلومات تفيد في تحديد موضع الخلل
على الأقل اكتب خوارزم البحث الذي استخدمته ربما نجد الخلل، أو أرفق جزء من المشروع.

[Benhlell]

وضعت لك اخي البرنامج في المرفقات عند تنفذه تجد الحل كما انه يحوي اكواد مفيدة للاستفادة:oops:
لقد وضعت للبرنامج قاعدة بيانات لكن لم ادخلها بعد فهو يحوي اخطاء كثيرة

[kachwahed]

لم أتمكن من تنفيذ المشروع بسبب استخدام المكونات (AlphaSkin)
كان من المفروض أن تكون آخر شيء...
عموما، يبدو أن الخلل في إجراء البحث، أظن أنه في شرط توقف Repeat هنا:

كود :

Procedure tfrmMain.RS(Folder:TfileName); Var Sr:TsearchRec; begin If FindFirst (Folder+ Ext ,FaAnyFile, Sr) = 0 Then try Repeat If ((Sr.Attr And Fadirectory)=0) Or (Sr.Name <> '.') And (Sr.Name <> '..') Then Begin ListBox1.Items.Add(Folder+Sr.Name); End; [color=Red] Until FindNext(Sr)<>0 ;[/color] except FindClose(Sr); end; If FindFirst (Folder+ '*.*' ,FaAnyFile or Fadirectory, Sr) = 0 Then try Repeat If ((Sr.Attr And Fadirectory)<>0) Or (Sr.Name <> '.') And (Sr.Name <> '..') Then Begin RS(Folder+Sr.Name+'\'); End; Until FindNext(Sr)<>0 ; except FindClose(Sr); end end; //---------------------------------------------------------------- Procedure tfrmMain.RF(Folder:TfileName); Var Sr:TsearchRec; begin If FindFirst (Folder+ '*.*' ,FaAnyFile, Sr) = 0 Then try Repeat If ((Sr.Attr And Fadirectory)=0) Or (Sr.Name <> '.') And (Sr.Name <> '..') Then Begin FrmScan.sCheckListBox1.Items.Add(Folder+Sr.Name); FrmScan.sLabelFX1.Caption:=Folder; FrmScan.sLabelFX1.Refresh; End; Until FindNext(Sr)<>0 ; except FindClose(Sr); end; If FindFirst (Folder+ '*.*' ,FaAnyFile or Fadirectory, Sr) = 0 Then try Repeat If ((Sr.Attr And Fadirectory)<>0) Or (Sr.Name <> '.') And (Sr.Name <> '..') Then Begin RF(Folder+Sr.Name+'\'); End; [color=Red] Until FindNext(Sr)<>0 ;[/color] except FindClose(Sr); end end;

حاول كتابة خوارزمية البحث بصيغة أخرى.

[Benhlell]

كيف يمكن فتح ملف معطوب ومقارنتة مع امضاء الفيروس ؟؟؟