Вопрос по Delphi

FEOFAN

FEOFAN

http://feofan.com
Ответ: Помощь по Delphi

Отбой. Сам нашел как это сделать=)
 
dragonion

dragonion

Добрый дракон
Ответ: Помощь по Delphi

Такой вопрос - Какой процедурой Создать сделать в Главном меню? TActionManager вроде бы не содержит такого. :(
 
Piton

Piton

Вызываю привыкание...
Re: Помощь по Delphi

SUXARIK сказав(ла):
как можно замутить поиск файлов по маске на всех жестких дисках на компе на Delphi 7? если можно пример
зараннее спасибо
Натисніть, щоб розгорнути...
Используй Win32_Find_Data поле TSearchRec.
Пример:
Код: 
procedure TForm1.Button1Click(Sender: TObject);
var
SearchRec : TSearchRec;
Success : integer;
begin
Success := SysUtils.FindFirst('C:\DownLoad\dial-u~1.htm',
faAnyFile,
SearchRec);
if Success = 0 then begin
ShowMessage(SearchRec.FindData.CFileName);
end;
SysUtils.FindClose(SearchRec);
end;
 
Merlіn

Merlіn

dead wizard
Re: Помощь по Delphi

Для поиска по всему диску нужен обход всех каталогов и подкаталогов (рекурсивный), FindFirst,FindNext ищет только в заданном каталоге.

Пример 1
Поиск файлов по маске по всему дереву каталогов, начиная с указанного

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Поиск файлов по маске по всему дереву каталогов, начиная с указанного
Продедура производит фалов по маске в указанном и во всех его вложенных
каталогах.
Параметр StartFolder указывает на начальный каталог поиска,
параметр Mask указывает маску поиска (например '*.pas'),
параметр List указывает на список строк, в которых будут записаны
результаты поиска,
Необязательный параметр ScanSubFolders указывает на необходимость
поиска во вложенных подкаталогах.
Зависимости: Windows, SysUtils, Classes, Masks
Автор: Dimka Maslov, mainbox@endimus.ru, ICQ:148442121, Санкт-Петербург
Copyright: Dimka Maslov
Дата: 29 апреля 2002 г.
***************************************************** }
Код: 
procedure FindFiles(StartFolder, Mask: string; List: TStrings;
  ScanSubFolders: Boolean = True);
var
  SearchRec: TSearchRec;
  FindResult: Integer;
begin
  List.BeginUpdate;
  try
    StartFolder := IncludeTrailingBackslash(StartFolder);
    FindResult := FindFirst(StartFolder + '*.*', faAnyFile, SearchRec);
    try
      while FindResult = 0 do
        with SearchRec do
        begin
          if (Attr and faDirectory) <> 0 then
          begin
            if ScanSubFolders and (Name <> '.') and (Name <> '..') then
              FindFiles(StartFolder + Name, Mask, List, ScanSubFolders);
          end
          else
          begin
            if MatchesMask(Name, Mask) then
              List.Add(StartFolder + Name);
          end;
          FindResult := FindNext(SearchRec);
        end;
    finally
      FindClose(SearchRec);
    end;
  finally
    List.EndUpdate;
  end;
end;
Пример использования: 
procedure TForm1.Button1Click(Sender: TObject);
begin
  FindFiles('C:\Program Files\', '*.exe', memo1.Lines, true);
end;
Натисніть, щоб розгорнути...
Пример 2
Ищем файл рекурсивно
Код: 
procedure GetAllFiles(mask: string); 
var 
  search: TSearchRec; 
  directory: string; 
begin 
  directory := ExtractFilePath(mask); 
  // find all files 
  if FindFirst(mask, $23, search) = 0 then 
  begin 
    repeat 
      // add the files to the listbox 
      Form1.ListBox1.Items.Add(directory + search.Name); 
      Inc(Count); 
    until FindNext(search) <> 0; 
  end; 
  // Subdirectories/ Unterverzeichnisse 
  if FindFirst(directory + '*.*', faDirectory, search) = 0 then 
  begin 
    repeat 
      if ((search.Attr and faDirectory) = faDirectory) and (search.Name[1] <> '.') then 
        GetAllFiles(directory + search.Name + '\' + ExtractFileName(mask)); 
    until FindNext(search) <> 0; 
    FindClose(search); 
  end; 
end; 
procedure TForm1.Button2Click(Sender: TObject); 
var 
  directory: string; 
  mask: string; 
begin 
  Count := 0; 
  Listbox1.Items.Clear; 
  directory := 'C:\temp\'; 
  mask := '*.*'; 
  Screen.Cursor := crHourGlass; 
  try 
    GetAllFiles(directory + mask); 
  finally 
    Screen.Cursor := crDefault; 
  end; 
  ShowMessage(IntToStr(Count) + ' Files found'); 
end; 

{**************************************} 
{ Code from P. Below: } 
// recursively scanning all drives 
  { excerpt from form declaration, form has a listbox1 for the 
    results, a label1 for progress, a button2 to start the scan, 
    an edit1 to get the search mask from, a button3 to stop 
    the scan. } 
  private 
    { Private declarations } 
    FScanAborted: Boolean; 
  public 
    { Public declarations } 
     
function ScanDrive(root, filemask: string; hitlist: TStrings): Boolean; 
implementation 
function TForm1.ScanDrive(root, filemask: string; hitlist: TStrings): Boolean; 
  function ScanDirectory(var path: string): Boolean; 
  var 
    SRec: TSearchRec; 
    pathlen: Integer; 
    res: Integer; 
  begin 
    label1.Caption := path; 
    pathlen := Length(path); 
    { first pass, files } 
    res := FindFirst(path + filemask, faAnyfile, SRec); 
    if res = 0 then 
      try 
        while res = 0 do  
        begin 
          hitlist.Add(path + SRec.Name); 
          res := FindNext(SRec); 
        end; 
      finally 
        FindClose(SRec) 
      end; 
    Application.ProcessMessages; 
    Result := not (FScanAborted or Application.Terminated); 
    if not Result then Exit; 
    {second pass, directories} 
    res := FindFirst(path + '*.*', faDirectory, SRec); 
    if res = 0 then 
      try 
        while (res = 0) and Result do  
        begin 
          if ((Srec.Attr and faDirectory) = faDirectory) and 
            (Srec.Name <> '.') and 
            (Srec.Name <> '..') then  
          begin 
            path := path + SRec.Name + '\'; 
            Result := ScanDirectory(path); 
            SetLength(path, pathlen); 
          end; 
          res := FindNext(SRec); 
        end; 
      finally 
        FindClose(SRec) 
      end; 
  end; 
begin 
  FScanAborted := False; 
  Screen.Cursor := crHourglass; 
  try 
    Result := ScanDirectory(root); 
  finally 
    Screen.Cursor := crDefault 
  end; 
end; 
procedure TForm1.Button2Click(Sender: TObject); 
var 
  ch: Char; 
  root: string; 
begin 
  root := 'C:\'; 
  for ch := 'A' to 'Z' do  
  begin 
    root[1] := ch; 
    case GetDriveType(PChar(root)) of 
      DRIVE_FIXED, DRIVE_REMOTE: 
        if not ScanDrive(root, edit1.Text, listbox1.Items) then 
          Break; 
    end; 
  end; 
end; 
procedure TForm1.Button3Click(Sender: TObject); 
begin // aborts scan 
  FScanAborted := True; 
end;
Натисніть, щоб розгорнути...
 
Останнє редагування:
dragonion

dragonion

Добрый дракон
Re: Помощь по Delphi

Люди, а вы ознакомились с правилами оформления программного кода? ;)
 
Hamster

Hamster

Well-Known Member
Re: Помощь по Delphi

Ломовской вопрос. Нужно чтобы первые 2с label1.caption='1' а после етих 2секунд отображался текст напрмер, label1.caption='2'
 
Ви повинні увійти або зареєструватися, щоб відповісти.
Зверху