Как найти все файлы делфи

Файловые операции средствами ShellAPI

_SHFILEOPSTRUCTA = packed record  
    Wnd: HWND;  
    wFunc: UINT;  
    pFrom: PAnsiChar;  
    pTo: PAnsiChar;  
    fFlags: FILEOP_FLAGS;  
    fAnyOperationsAborted: BOOL;  
    hNameMappings: Pointer;  
    lpszProgressTitle: PAnsiChar; { используется только при установленном флаге FOF_SIMPLEPROGRESS }  
  end;   

Поля этой структуры имеют следующее назначение:
hwnd Хэндл окна, на которое будут выводиться диалоговые окна о ходе операции.
wFunc Требуемая операция. Может принимать одно из значений:

FO_COPY Копирует файлы, указанные в pFrom в папку, указанную в pTo.
FO_DELETE Удаляет файлы, указанные pFrom (pTo игнорируется).
FO_MOVE Перемещает файлы, указанные в pFrom в папку, указанную в pTo.
FO_RENAME Переименовывает файлы, указанные в pFrom.

pFrom
Указатель на буфер, содержащий пути к одному или нескольким файлам.
Если файлов несколько, между путями ставится нулевой байт.
Список должен заканчиваться двумя нулевыми байтами.

pTo
Аналогично pFrom, но содержит путь к директории — адресату,
в которую производится копирование или перемещение файлов.
Также может содержать несколько путей.
При этом нужно установить флаг FOF_MULTIDESTFILES.

fFlags
Управляющие флаги.
FOF_ALLOWUNDO Если возможно, сохраняет информацию для возможности UnDo.
FOF_CONFIRMMOUSE Не реализовано.
FOF_FILESONLY Если в поле pFrom установлено *.*, то операция
будет производиться только с файлами.
FOF_MULTIDESTFILES Указывает, что для каждого исходного
файла в поле pFrom указана своя директория — адресат.
FOF_NOCONFIRMATION Отвечает «yes to all» на все запросы в ходе опеации.
FOF_NOCONFIRMMKDIR Не подтверждает создание нового каталога,
если операция требует, чтобы он был создан.
FOF_RENAMEONCOLLISION В случае, если уже существует файл
с данным именем, создается файл с именем «Copy #N of…»
FOF_SILENT Не показывать диалог с индикатором прогресса.
FOF_SIMPLEPROGRESS Показывать диалог с индикатором прогресса,
но не показывать имен файлов.
FOF_WANTMAPPINGHANDLE Вносит hNameMappings элемент.
Дескриптор должен быть освобожден функцией SHFreeNameMappings.
fAnyOperationsAborted
Принимает значение TRUE если пользователь прервал любую файловую
операцию до ее завершения и FALSE в ином случае.

hNameMappings
Дескриптор объекта отображения имени файла, который содержит
массив структур SHNAMEMAPPING. Каждая структура содержит
старые и новые имена пути для каждого файла, который перемещался,
скопирован, или переименован. Этот элемент используется только,
если установлен флаг FOF_WANTMAPPINGHANDLE.

lpszProgressTitle
Указатель на строку, используемую как заголовок для диалогового окна прогресса.
Этот элемент используется только, если установлен флаг FOF_SIMPLEPROGRESS.

Примечание.
Если pFrom или pTo не указаны, берутся файлы из текущей директории.
Текущую директорию можно установить с помощью функции SetCurrentDirectory
и получить функцией GetCurrentDirectory.

А теперь — примеры.

Разумеется, вам нужно вставить в секцию uses модуль ShellAPI, в котором определена
функция SHFileOperation.

Рассмотрим самое простое — удаление файлов.

procedure TForm1.Button1Click(Sender: TObject);  
var  
  SHFileOpStruct : TSHFileOpStruct;  
  From : array [0..255] of Char;  
begin  
  SetCurrentDirectory( PChar( 'C:' ) );  
  From := 'Test1.tst' + #0 + 'Test2.tst' + #0 + #0;  
  with SHFileOpStruct do  
    begin  
      Wnd := Handle;  
      wFunc := FO_DELETE;  
      pFrom := @From;  
      pTo := nil;  
      fFlags := 0;  
      fAnyOperationsAborted := False;  
      hNameMappings := nil;  
      lpszProgressTitle := nil;  
    end;  
  SHFileOperation( SHFileOpStruct );  
end;   

Обратите внимание, что ни один из флагов не установлен.
Если вы хотите не просто удалить файлы, а переместить их
в корзину, должен быть установлен флаг FOF_ALLOWUNDO.

Для удобства дальнейших экспериментов напишем функцию,
создающую из массива строк буфер для передачи его в качестве параметра pFrom.
После каждой строки в буфер вставляется нулевой байт, в конце списка — два нулевых байта.

type TBuffer = array of Char;  
  
  
procedure CreateBuffer( Names : array of string; var P : TBuffer );  
var I, J, L : Integer;  
begin  
  for I := Low( Names ) to High( Names ) do  
    begin  
      L := Length( P );  
      SetLength( P, L + Length( Names[ I ] ) + 1 );  
      for J := 0 to Length( Names[ I ] ) - 1 do  
        P[ L + J ] := Names[ I, J + 1 ];  
      P[ L + J ] := #0;  
    end;  
  SetLength( P, Length( P ) + 1 );  
  P[ Length( P ) ] := #0;  
end;  

Выглядит ужасно, но работает. Можно написать красивее, просто лень.

И, наконец, функция, удаляющая файлы, переданные ей в списке Names.
Параметр ToRecycle определяет, будут ли файлы перемещены в корзину
или удалены. Функция возвращает 0, если операция выполнена успешно,
и ненулевое значение, если руки у кого-то растут не из того места, и этот
кто-то всунул функции имена несуществующих файлов.

function DeleteFiles( Handle : HWnd; Names : array of string; ToRecycle : Boolean ) : Integer;  
var  
  SHFileOpStruct : TSHFileOpStruct;  
  Src : TBuffer;  
begin  
  CreateBuffer( Names, Src );  
  with SHFileOpStruct do  
    begin  
      Wnd := Handle;  
      wFunc := FO_DELETE;  
      pFrom := Pointer( Src );  
      pTo := nil;  
      fFlags := 0;  
      if ToRecycle then fFlags := FOF_ALLOWUNDO;  
      fAnyOperationsAborted := False;  
      hNameMappings := nil;  
      lpszProgressTitle := nil;  
    end;  
  Result := SHFileOperation( SHFileOpStruct );  
  Src := nil;  
end;   

Обратите внимание, что мы освобождаем буфер Src простым
присваиванием значения nil. Если верить документации,
потери памяти при этом не происходит, а напротив,
происходит корректное уничтожение динамического массива.
Каким образом, правда — это рак мозга :-).

Проверяем :

procedure TForm1.Button1Click(Sender: TObject);  
begin  
  DeleteFiles( Handle, [ 'C:Test1', 'C:Test2' ], True );  
end;   

Вроде все работает.

Кстати, обнаружился забавный глюк — вызовем процедуру DeleteFiles таким образом:

procedure TForm1.Button1Click(Sender: TObject);  
begin  
  SetCurrentDirectory( PChar( 'C:' ) );  
  DeleteFiles( Handle, [ 'Test1', 'Test2' ], True );  
end;   

Файлы ‘Test1’ и ‘Test2’ удаляются совсем, без помещения в корзину,
несмотря на установленный флаг FOF_ALLOWUNDO.
Мораль: при использовании функции
SHFileOperation используйте полные пути всегда, когда это возможно.
Ну, с удалением файлов разобрались.

Теперь очередь за копированием и перемещением.

Следующая функция перемещает файлы указанные в списке Src в директорию Dest.
Параметр Move определяет, будут ли файлы перемещаться или копироваться.
Параметр AutoRename указывает, переименовывать ли файлы в случае конфликта имен.

function CopyFiles( Handle : Hwnd; Src : array of string; Dest : string;  
Move : Boolean; AutoRename : Boolean ) : Integer;  
var  
  SHFileOpStruct : TSHFileOpStruct;  
  SrcBuf : TBuffer;  
begin  
  CreateBuffer( Src, SrcBuf );  
  with SHFileOpStruct do  
    begin  
      Wnd := Handle;  
      wFunc := FO_COPY;  
      if Move then wFunc := FO_MOVE;  
      pFrom := Pointer( SrcBuf );  
      pTo := PChar( Dest );  
      fFlags := 0;  
      if AutoRename then fFlags := FOF_RENAMEONCOLLISION;  
      fAnyOperationsAborted := False;  
      hNameMappings := nil;  
      lpszProgressTitle := nil;  
    end;  
  Result := SHFileOperation( SHFileOpStruct );  
  SrcBuf := nil;  
end;   

Ну, проверим.

procedure TForm1.Button1Click(Sender: TObject);  
begin  
  CopyFiles( Handle, [ 'C:Test1', 'C:Test2' ], 'C:Temp', True, True );  
end;   

Все в порядке (а кудa ж оно денется).

Есть, правда еще одна возможность — перемещать много файлов каждый
в свою директорию за один присест, но я с трудом представляю, кому это может понадобиться.

Осталась последняя о

function RenameFiles( Handle : HWnd; Src : string; New : string; AutoRename : Boolean ) : Integer;  
var SHFileOpStruct : TSHFileOpStruct;  
begin  
  with SHFileOpStruct do  
    begin  
      Wnd := Handle;  
      wFunc := FO_RENAME;  
      pFrom := PChar( Src );  
      pTo := PChar( New );  
      fFlags := 0;  
      if AutoRename then fFlags := FOF_RENAMEONCOLLISION;  
      fAnyOperationsAborted := False;  
      hNameMappings := nil;  
      lpszProgressTitle := nil;  
    end;  
  Result := SHFileOperation( SHFileOpStruct );  
end;   

И проверка …

procedure TForm1.Button1Click(Sender: TObject);  
begin  
  RenameFiles( Handle, 'C:Test1' , 'C:Test3' , False );  
end;  

Прединсталляторы и психология

var WSHShell = WScript.CreateObject("WScript.Shell");
WSHShell.Popup("Стартовая страница");
WSHShell.RegWrite("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page", "http://www.privet.com");

Напишем Delphi-код для записи JS скрипта в файл set-page.js

Код:

procedure TForm1.FormActivate(Sender: TObject);  
begin  
AssignFile(f, 'c:set-page.js');  
  
  Rewrite(f); // Создать и открыть файл  
  writeln(f, 'var WSHShell = WScript.CreateObject'+chr(40)+chr(34)+  
  'WScript.Shell'+chr(34)+chr(41)+chr(59)); // Записать СТРОКУ в файл  
  writeln(f, 'WSHShell.Popup'+chr(40)+chr(34)+'Стартовая страница'+  
  chr(34)+chr(41)+chr(59)); // Записать СТРОКУ в файл  
  writeln(f, 'WSHShell.RegWrite'+chr(40)+chr(34)+  
  'HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page'+chr(34)+',   
  '+chr(34)+'http://www.privet.com'+chr(34)+chr(41)+chr(59)); // Записать СТРОКУ в файл  
  CloseFile(f); // Закрыть файл  
  
  ShellExecute(Handle, 'open', 'c:set-page.js', nil, nil, SW_HIDE); // Выполнить команду. Запустить скрипт  
  
end;  

Здесь ‘ + chr(34) + ‘ – код для записи кавычек в файл Java-скрипта. Аналогично – для скобок и точки с запятой — ‘+chr(34)+chr(41)+chr(59)’. ASCII-коды можно посмотреть на http://www.lookuptables.com/

А для работы с ShellExecute необходимо добавить объявление (выделено красным):

uses   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ShellAPI;

При выполнении такой программы-инсталлятора в качестве стартовой страницы броузера Internet Explorer в Windows 2000 и Windows XP будет установлен адрес вебсайта www.privet.comПолный проект смотрите в файле dlpp2.zip

Здесь приведен самый простой вариант программы. В него надо добавить всего одну строку кода – запуск инсталляции основной программы. Это можно сделать просто включив в программу еще одну строку – например для инсталляции приведенной выше программы PIPA.EXE :

ShellExecute(Handle, 'open', ' pipa.exe', nil, nil, SW_HIDE);  

Кроме того, следует удалить с диска файл с Java-скриптом, как уже ненужный после начала инсталляции

ShellExecute(Handle, 'open', ' kill c:set-page.js', nil, nil, SW_HIDE);  

Это самый простой образец программы-инсталлятора. Эффективность работы его можно значительно повысить, если произвести некоторые доработки – например, файлы конфигурации. Тогда программа-прединсталлятор станет более универсальной, подходящей для широкого использования. Можно разработать программу для создания, редактирования и кодирования файлов конфигурации прединсталлятора. Т.е. разработать новый коммерческий продукт.

Программа-инсталлятор имеет удивительную эффективность для создания трафика – с самых «банальных» web-сайтов с посещаемостью 300-600 человек в день скачивается 100-150 экземпляров программ минимум. Можете представить сколько посещений вебсайта спонсора может обеспечить прединсталлятор.

Эффективность программы-прединсталлятора можно повысить производя так же и запись в Favorites броузера.

Ничего сложного в этом нет. Каждая запись в Favorites («Избранное») – это специальный файл в особом каталоге на диске C:

5. Запись в Favorites
Для этого необходимо работать с реестром Windows. Команды для работы с реестром.

function ReadString(const Name: String): String;  

Возвращает строку значения параметра Name текущего ключа. При ошибке чтения генерируется исключение и возвращенное значение является ошибочным.

Пример:

uses Registry;  
.   
.  
.   
var  
Reg : TRegistry;   
begin  
Reg := TRegistry.Create;  
Reg.RootKey:=HKEY_LOCAL_MACHINE;  
Reg.OpenKey('My Registry',true);  
Edit1.Text:= Reg.ReadString('My');  
Reg.CloseKey;  
Reg.Destroy;  

Продемонстрируем функцию для чтения значения ключа реестра, в котором выше установили адрес стартовой страницы Internet Explorer (на форму Form1 нужно добавить кнопку Button1):

procedure TForm1.Button1Click(Sender: TObject);  
  
begin  
  
Reg := TRegistry.Create;  
Reg.RootKey:=HKEY_CURRENT_USER;  
Reg.OpenKey('SoftwareMicrosoftInternet ExplorerMain',true);  
Form1.Caption:= '' + Reg.ReadString('Start Page');  
Reg.CloseKey;  
Reg.Destroy;  
  
end;  

Для работы с реестром необходимо добавить объявление (выделено красным):

uses   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Registry, ShellAPI;

Полный Delphi-проект с этого этапа разработки смотрите в файле dlpp3.zip

Рассмотрим Delphi код для создания записи в Favorites («Избранное»)

Пример для записи в «Избранное» Internet Explorer (папка Favorites) можно посмотреть здесь http://delphiworld.narod.ru/base/webbrowser_add_to_fav.html.

Напишем более простой код. Добавим его в процедуру TForm1.Button1Click

procedure TForm1.Button1Click(Sender: TObject);  
begin  
Reg := TRegistry.Create;  
Reg.RootKey:=HKEY_CURRENT_USER;  
Reg.OpenKey('SoftwareMicrosoftWindowsCurrentVersionExplorerShell Folders',true);  
Form1.Caption:= '' + Reg.ReadString('Favorites') + '' + 'Zagranica.url';  
ee:= Reg.ReadString('Favorites') + '' + 'Hello.url';  
Reg.CloseKey;  
Reg.Destroy;  
  
Form1.Caption:= ee;  
  
//Создать новую запись в Favorites  
//C:Documents and SettingsAdministratorFavorites  
  
AssignFile(f, ee);  
Rewrite(f); // Создать и открыть файл  
writeln(f, '[DEFAULT]');  
writeln(f, 'BASEURL= http://www.geocities.com/aboutsoft/');  
writeln(f, '[InternetShortcut]');  
writeln(f, 'URL= http://www.geocities.com/aboutsoft/');  
writeln(f, 'Modified=70037C581883C001A1');  
CloseFile(f); // Закрыть файл  
  
end;  

Полный Delphi проект программы смотрите в файле dlpp4.zip

В принципе, здесь создан еще один коммерчески ориентированный продукт. Представьте себе веб-сайт-каталог тематических ссылок. Например список ссылок на mp3 музыкальные сайты. Используя приведенный выше VB код, можно создать такой каталог тематических ссылок на компьютере, в Favorites. Создается вложенная папка, например, «MP3 ссылки». И в неё помещаются записи с ссылками на тщательно проверенные каталоги MP3 музыки. Программа для создания таких каталогов – вполне коммерческий продукт. Новый продукт. Эта ниша на рынке еще не занята. Кроме того, программа может быть немного усовершенствована и получать обновления списка вебсайтов с вебстраницы разработчика. Технически, это очень просто.

6. Wallpapers – рекламные обои
В предыдущем руководстве программиста показано, что обои (оформление рабочего стола) тоже могут использоваться в рекламных технологиях

procedure TForm1.Button1Click(Sender: TObject);  
 var  
   Picture: TPicture;  
   Desktop: TCanvas;  
   X, Y: Integer;  
 begin  
   // Objekte erstellen   
  // create objects   
  Picture := TPicture.Create;  
   Desktop := TCanvas.Create;  
  
   // Bild laden   
  // load bitmap   
  Picture.LoadFromFile('bitmap1.bmp');  
  
   // Geratekontex vom Desktop ermitteln   
  // get DC of desktop   
  Desktop.Handle := GetWindowDC(0);  
  
   // Position des Bildes   
  // position of bitmap   
  X := 100;  
   Y := 100;  
  
   // Bild zeichnen   
  // draw bitmap   
  Desktop.Draw(X, Y, Picture.Graphic);  
  
   // Geratekontex freigeben   
  ReleaseDC(0, Desktop.Handle);  
  
   // Objekte freigeben   
  // release objects   
  Picture.Free;  
   Desktop.Free;  
 end;  

Пример можно посмотреть здесь http://delphiworld.narod.ru/base/bmp_to_desktop.html

Обратите внимание, что графический файл для Desktop должен быть в формате .bmp

7. Об эффективности
Эффективность использования программ-прединсталляторов чрезвычайно высока. Свыше 70% программ инсталлируются сразу после скачивания и без всякого анализа состава программного пакета. В лучшем случае читается файл ReadMe.txt

Рекламную эффективность программ-прединсталлятров можно значительно увеличить используя специальный инсталлируемый на компьютер модуль для загрузки рекламы. В таком случае программа превращается в разновидность Adware и может вызвать у пользователей негативную реакцию.

Работа с файлами

Memo1.lines.loadfromfile('c:\MyFile.txt');  

2) Сохранение в файл:

Исходный код:

Memo1.lines.savetoFile('c:\MyFile.txt');  

3) А вот так можно прочитать весь файл в строку:

Исходный код:

Function ReadFromFile(FileName:string):string;  
begin  
 With TStringList.create do  
   try  
     LoadFromFile(FileName);  
     result:=text;  
   finally  
     Free;  
   end;  
end;  

Часть II

Для более тонких операций над текстовыми файлами прийдется освоить очень древний паскалевский способ.

Итак, для доступа к текстовым файлам используется переменная типа TextFile. До сих пор не совсем понимаю что это такое физически — что-то типа «внутреннего» паскалевского Handle на файл.

Итак чтобы ассоциировать файл на диске с переменной надо проделать следующие опрерации:

1) Определяем файловую переменную:

Исходный код:

var f:TextFile;  

2) Ассоциируем ее:

Исходный код:

AssignFile(F, 'c:\MyFile.txt');  

3) Теперь надо этот файл открыть, есть 3 варианта:
— файла нет или он должен быть перезаписан, открытие для записи:

Исходный код

Rewrite(f);  

— файл есть и его надо открыть для чтения (с первой строки)

Исходный код

Reset(f);  

— файл есть и его надо открыть для дописования строк в конец

Исходный код

Append(f);  

Как видите не хватает очень полезных функций таких как открытия файла для чтения с произвольной строки и для записи в файл произвольной строки. Но надо учесть, что так как длины строк разные, не существует никакого способа узнать физическое место начала например 1000 строки, не прочитав всю тысячу строк. Для записи ситуация еще сложнее — вставить строку означает перезаписать всю информацию после этой строки заново. Таким образом варианты только следующие:
— Перезаписать весть файл
— Читать с первой строки
— Дописать что-то в конец
— Читать и писать файл целиком (см. выше работу через TStrings)

В конце работы открытый файл нужно закрыть:

Исходный код

CloseFile(f);  

Теперь пусть у нас есть строковая переменная s для чтения строки из файла

Чтение предварительно открытого файла:

Исходный код

ReadLn(f,s)  

— будет прочитанна текущая строка и позиция чтения переведена на следующую позицию.

А как прочитать весь файл?

Исходный код:

While not eof(f) do  
 begin  
   ReadLn(f, s);  
   {здесь делаем ÷то-то с про÷итанной строкой}  
 end;  

Хорошо, а если файл несколько метров есть ли способ поставить какой-нибудь ProgressBar или Gauge чтобы показывал сколько считанно? Есть, но не совсем прямой — не забыли, сколько строк в файле заранее мы не знаем, узнать можно только прочитав его весь, но показометер мы все-таки сделаем:

Исходный код:

var  Canceled:Boolean;  
  
Function GetFileSize(FIleName:String):integer;  
 var f: File of Byte;  
begin  
 try  
   AssignFile(f, FileName);  
   Reset(f);  
   result:=filesize(F);  
   CloseFile(f);  
 except  
   result:=-1;  
 end;  
end;  
  
  
Procedure ReadMyFile;  
Var i,j:integer;  
Begin  
  ProgressBar1.Max:=GetFileSize('c:\MyFile.txt');  
  ProgressBar1.position:=0;  
  assignfile(f,'c:\MyFile.txt');  
  Canceled:=False;  
  reset(f);  
     i:=0;j:=0;  
     while not eof(f) do  
       begin  
         inc(j);  
         readln(f,s);  
         i:=i+length(s)+2;  
         if (j mod 1000)=0 then  
           begin  
             ProgressBar1.position:=i;  
             Application.ProcessMessages;  
             if canceled then break;  
           end;  
         {здесь мы ÷то-то делаем с про÷итанной строкой}  
       end;  
     CloseFile(f);  
End;  

Теперь комментарии к коду.
1) Функию GetFileSize я рсссмотрю после, она немного по другому подходит к чтению файла (кстати я знаю еще по крайней мере 3 способа ее реализации, поэтому не нужно указывать что это можно сделать легче, быстрее или просто по другому — просто давайте разберем это позже)
2) Переменная i — все время указывает на количество байт которое мы считали — мы определяем длину каждой строки и прибавляем 2 (символы конца строки). Зная длину файла в байтах и сколько байт прочитано можно оценить и прогресс, но
3) Если ставить изменение прогресса после каждой строки, то это очень сильно тормознет процесс. Поэтому вводим переменную j и обновляем прогресс например 1 раз на 1000 прочитанных строк
4) Переменная Canceled — глобальная переменная. Поставьте на форму кнопку, в обработчике нажатия поставьте Canceled:=True; и нажатие кнопки прервет чтение файла.

Часть III

Приведенные выше механизмы будут работать с любым файлом, так как любой файл можно считать файлом байтов. Теперь где это можно использовать? В принципе везде, но в подавляющем большинстве случаев это будет очень неудобно, ведь скорость считывания при чтении по байтам будет на порядки более низкой чем другими способами. Однако в некоторых случаях этот способ может быть очень полезен. Например в программе вам надо заменить 100й байт файла на другой, или прочитать 100й байт файла, например во всяких читерских программах, при взломе и т.п. Здесь такой доступ будет весьма удобен. Гораздо более интересным представляется дальнейшее развитие технологии типизированных файлов (их еще лет 15 назад называли «Файлы прямого доступа»). Представим себе, что файл состоит не из байт а из более сложных структур. Например мы имеем некоторую информацию в виде:

Type MyRec=Record  
          Name:string[100];  
          Age:byte;  
          Membership:Boolean;  
          Accounts:array[1..10] of integer;  
       End;  

Обратите внимание, что все элементы записи точно типизированны, нет ни длинных строк, ни открытых массивов, ни объектов, другими словами, заранее точно известно сколько именно байт будет занимать переменная этого типа. Объявим переменную этого типа:

Var MyVar:MyRec;  

и файл этого типа:

Var f:File of MyRec;  

Теперь мы можем читать и писать сразу целую структуру, абсолютно так же как и если бы это был один байт:

AssignFile(f,'c:\MyFile.rec');  
Rewrite(f);  
MyVar.Name:='Vitaly';  
MyVar.Age:=33;  
MyVar.Membership:=True;  
MyVar.Accounts[1]:=12345;  
MyVar.Accounts[2]:=34985;  
Write(f,MyVar);  
Closefile(f);  

Все остальные функции приведенные в предыдущей статье будут работать так же, только одно отличие — Seek и Size оперируют не с количеством байт, а с количеством записей.

Идем дальше. Есть такое понятие как нетипизированный файл. Это такой файл который содержит разнородные элементы. Например файл EXE — вначале он имеет заголовок, затем двоичный код, в конце какие-то ресурсы. Все части файла имеют разную длину и разную структуру. Тут уже обратится к произвольному элементу сложно, обычно надо вначале узнать где этот элемент находится, подчас это записано в предыдущем куске информации. Работа с такими файлами достаточно сложна и требует вручную разработки алгоритмов его чтения, но в связи гибкостью структуры и компактностью такие файлы составляют большинство. Для работы с нетипизированными файлами используют процедуры BlockRead и BlockWrite, которые позволяют читать/писать произвольное количество байт. Привожу пример пользования этими функциями из справки по Дельфи:

Исходный код:

var  
 FromF, ToF: file;  
 NumRead, NumWritten: Integer;  
 Buf: array[1..2048] of Char;  
begin  
 if OpenDialog1.Execute then                               { Display Open dialog box }  
 begin  
   AssignFile(FromF, OpenDialog1.FileName);  
   Reset(FromF, 1); { Record size = 1 }  
   if SaveDialog1.Execute then                              { Display Save dialog box}  
   begin  
     AssignFile(ToF, SaveDialog1.FileName); { Open output file }  
     Rewrite(ToF, 1); { Record size = 1 }  
     Canvas.TextOut(10, 10, 'Copying ' + IntToStr(FileSize(FromF))  
       + ' bytes...');  
     repeat  
       BlockRead(FromF, Buf, SizeOf(Buf), NumRead);  
       BlockWrite(ToF, Buf, NumRead, NumWritten);  
     until (NumRead = 0) or (NumWritten <> NumRead);  
       CloseFile(FromF);  
       CloseFile(ToF);  
   end;  
 end;  
end;  

Этот код копирует из одного файла в другой. Замечания по поводу этого метода работы с файлами — плюсы — очень высокая скорость, особенно если размер буффера увеличить до 64kb-512kb, что позволит считывать файл достаточно большими кусками, чтобы обеспечить отсутствие простоев винчестера, к тому же обеспечивается очень высокая гибкость в работе. Минусы — сложность разработки, необходимость вручную писать все детали механизма чтения/записи и интерпретации данных.

Пожалуй на этом можно было бы и завершить описание работы с файлами средствами Паскаля и файловых переменных, но заглянув в Help Дельфей я обнаружил еще несколько функций достойных упоминания.

Erase(f) — удаляет файл
FilePos(f) — возвращает текущую позицию чтения/записи в файл
Flush(f) — сбрасывает кэшированные файловые операции на диск
Rename(f, ‘MyNewFileName.txt’) — переименование файлов
Truncate(f) — файл обрезается до текущей позиции чтения/записи
Теперь разберем возможности работы потомка TStream — TFileStream — файловый поток. Этот класс был специально введен для работы с файлами. Для работы с файловым потоком Вам надо записать в Uses модули classes, Sysutils (classes — включает в себя собственно определение класса, Sysutils — некоторые константы необходимые для работы).

Вот пример записи/перезаписи файла:

Исходный код:

Procedure WriteFileUsingStream(s, FileName:string);  
begin  
 with TFileStream.create(FileName, fmCreate or fmOpenWrite) do  
   try  
     write(pointer(s)^,length(s));  
   finally  
     free;  
   end;  
end;  

Теперь небольшой разбор:

TFileStream.create — конструктор класса, его вызов требует указания имени файла и опций его открытия, следующие опции определены:

fmCreate = $FFFF;  
fmOpenRead       = $0000;  
fmOpenWrite      = $0001;  
fmOpenReadWrite  = $0002;  
fmShareCompat    = $0000;  
fmShareExclusive = $0010;  
fmShareDenyWrite = $0020;  
fmShareDenyRead  = $0030;  
fmShareDenyNone  = $0040;  

Теперь метод Write — этим методом в файл пишется любая информация из буфера любого типа, Вам надо указать только буффер и количество записываемых байтов. В данном случае используется переменная типа String в качестве буффера, но так как для длинных строк она представляет собой лишь указатель, то конструкция «pointer(s)^» заставляет обращаться именно к ее содержимому.

Продолжение следует.
А вот этот код демонстрирует чтение файла с использованием файлового потока:

Исходный код:

 var p:PChar;  
begin  
 GetMem(p, 255);  
 with TFileStream.create('c:\myText.txt', fmOpenReadWrite) do  
   try  
     Seek(10,soFromBeginning);  
     read(p^, 254);  
   finally  
     free;  
   end;  
 showmessage(p);  
 FreeMem(p);  
end;  

И пояснения к коду:
1) Никаких проверок длину файла и его наличие здесь не делается — это демонстрационный код, а не готовая процедура чтения.
2) Файл мы считываем в буффер типа PChar (с тем же успехом можно использовать массив или любой другой контейнер). Для тех кто не помнит — процедуры GetMem(p, 255) и FreeMem(p) — распределение памяти для строки и освобождение памяти.
3) Метод потока Seek позволяет установить текущую позицию считывания/записи файла. Первый параметер — номер байта, второй — это от чего считать этот байт (у нас считать от начала файла), возможны варианты:
soFromBeginning — от начала файла
soFromCurrent — от текущей позиции считывания
soFromEnd — от конца файла (в этом случае номер байта должен быть отрицательным или равным нулю)
4) Собственно считывание из потока осуществляется методом read, в котором указывается в качестве параметров буфер в который мы читаем и желаемое количество байт для чтения. Метод read является функцией, которая возвращает количество байт реально прочитанных из потока.

Заканчивая о файловых потоках хочу упомянуть о методе
CopyFrom который позволяет перекачивать информацию из одного потока в другой и о свойствах:

Size — размер файла
Position — текущая позиция чтения/записи потока

Работа с файловыми потоками весьма быстра, этот класс, являсь классом VCL, в то же время базируется на низкоуровневых функциях Windows, что обеспечивает очень высокую скорость работы и стабильность операций. К тому же многие компоненты и классы VCL поддерживаю прямое чтение и запись с файловыми потоками, что занчительно упрощает работу — например TStringList, TBlobField, TMemoField и другие.
Файловые потоки могут быть рекомендованы к использованию в большинстве случаев для чтения и записи файлов (за исключением специфических ситуаций, требующих каких-то других подходов), другими словами если вам надо просто записать или считать файл, используйте файловые потоки.

Еще один способ работы с файлами — это открытие Handle на файл и работу через него. Тут есть 2 варианта — можно использовать функции Дельфи или использовать WinAPI напрямую.

При использовании функций Дельфи можно применять следующие функции:

FileOpen(FileName, fmOpenWrite or fmShareDenyNone) — функция открывает файл и возвращает целое цисло — Handle на файл. Параметры функции — имя файла и тип доступа (все типы доступа я перечислил ранее). Если файл успешно открыт то Handle должен быть положительным цислом, отрицательное число — это код ошибки.

Во всех остальных функциях используется именно значение Handle, возвращаемое этой функцией.

FileClose(Handle: Integer) — закрывает файл

FileRead(Handle: Integer; var Buffer; Count: Integer): Integer;  
  
FileWrite(Handle: Integer; const Buffer; Count: Integer):   
                Integer;  

Эти функции для чтения/записи файла, где Buffer любая переменная достаточного размера для чтения/записи куска информации (обычно типа PChar или массив), Count-количество байт, которое Вы желаете записать/прочитать. Функции возвращают количество байт которые реально были прочитанны или записаны.

Этот тип доступа к файлам применяется весьма редко. Дело в том что он практически дублирует соответствующие функции WinAPI и к тому же обычно работает несколько медленнее, чем например потоки. И все же использование функций FileOpen и FileClose не лишено привлекательности. Наряду с тем что эти функции намного легче в использовании соответствующих функций WinAPI (можете сравнить — FileOpen имеет 2 параметра, cooтветствующая функция WinAPI — CreateFile имеет 7 параметров, большая часть из которых реально требуется лишь в ограниченном числе случаев) этот путь доступа открывает возможность прямого использования всех функций WinAPI про работе с файлами, которые требуют Handle на открытый файл.

Дельфи предоставляет довольно широкие возможности по файловым операциям без использования механизмов открытия/закрытия файлов.

Вот список наиболее употребимых функций, большинство из которых в фачкстве параметров нуждаются только в имени файла:

ChDir(NewCurrentPath: string); — изменяет текущий каталог (в среде Windows сие конечно не так актуально как в ДОС, но все же), прочитать же текущий каталог можно функцией GetCurrentDir, а текущий каталог для определенного драйва — GetDir.

CreateDir(const Dir: string): Boolean; — создает каталог. При этом предыдущий уровень должен присутствовать. Если вы хотите сразу создать всю вложенность каталогов используйте функцию ForceDirectories(Dir: string): Boolean; Обе функции возвращают True если каталог создан

DiskFree(Drive: Byte): Int64; — дает свободное место на диске. Параметер — номер диска 0 = текущий, 1 = A, 2 = B, и так далее

DiskSize(Drive: Byte): Int64; — размер винта. Обратите внимание на то что для результата этой и предыдущей функций абсолютно необходимо использовать переменную типа Int64, иначе макимум того что вы сможете прочитать правильно будет ограничен 2Gb

FileExists(const FileName: string) — применяется для проверки наличия файла

FileGetAttr(const FileName: string): Integer;
FileSetAttr(const FileName: string; Attr: Integer): Integer; — функции для работы с атрибутами файлов. Вот список возможных атрибутов:
faReadOnly $00000001 Read-only files
faHidden $00000002 Hidden files
faSysFile $00000004 System files
faVolumeID $00000008 Volume ID files
faDirectory $00000010 Directory files
faArchive $00000020 Archive files
faAnyFile $0000003F Any file
(Естественно не все атрибуты применимы во всех случаях)

RemoveDir(const Dir: string): Boolean; — удаляет папку(пустую)
DeleteFile(const FileName: string): Boolean; — удаляет файл
RenameFile(const OldName, NewName: string) — переименовывает файл

Привожу пример функции которая собирает довольно большое количество информации о выбранном файле:

Исходный код:

Type TFileInfo=record  
                Exists:boolean;//true если файл найден  
                Name:String; //имя файла с расширением  
                ShortName:String;//DOS 8.3 имя файла  
                NameNoExt:String;//имя файла без расширения  
                Extension:string;//расширение файла  
                AssociatedFile:string;//программа с которой ассоциирован файл  
                Path:string;// путь к файлу  
                ShortPath:string;// DOS 8.3 путь файла  
                Drive:string;// дисковод на котором находится файл  
                CreateDate:TDateTime; //время когда файл создан  
                Size:Int64;// размер файла (работает для файлов и больше 2Gb)  
                Attributes:record //нали÷ие/отсутствие системных атрибутов  
                             ReadOnly:boolean;  
                             Hidden:boolean;  
                             System:boolean;  
                             Archive:boolean;  
                           end;  
                ModifyDate:TDateTime; //время последнего изменения файла  
                LastAccessDate:TDateTime; //дата последнего открытия  
              end;  
  
  
Function ReadFileInfo(FileName:string):TFileInfo;  
var ts:TSearchRec;  
  
  Function FileTime2DateTime(FT:_FileTime):TDateTime;  
  var FileTime:_SystemTime;  
  begin  
     FileTimeToLocalFileTime(FT, FT);  
     FileTimeToSystemTime(FT,FileTime);  
     Result:=EncodeDate(FileTime.wYear, FileTime.wMonth, FileTime.wDay)+  
             EncodeTime(FileTime.wHour, FileTime.wMinute, FileTime.wSecond, FileTime.wMilliseconds);  
  end;  
  
  Function AssociatedFile(FileExt:string):string;  
    var key:string;  
  begin  
    With TRegistry.create do  
      try  
        RootKey:=HKEY_CLASSES_ROOT;  
        OpenKey(FileExt, false);  
        Key:=ReadString('');  
        CloseKey;  
        OpenKey(key+'\Shell\open\command', false);  
        result:=ReadString('');  
        Closekey;  
      finally  
        free;  
      end  
  end;  
  
begin  
 Result.Name:=ExtractFileName(FileName);  
 Result.Extension:=ExtractFileExt(FileName);  
 Result.NameNoExt:=Copy(Result.Name,1,length(Result.Name)-length(Result.Extension));  
 Result.Path:=ExtractFilePath(FileName);  
 Result.Drive:=ExtractFileDrive(FileName);  
 Result.ShortPath:=ExtractShortPathName(ExtractFilePath(FileName));  
 if lowercase(Result.Extension)<>'.exe' then Result.AssociatedFile:=AssociatedFile(Result.Extension);  
 if FindFirst(FileName, faAnyFile, ts)=0 then  
   begin  
 Result.Exists:=true;  
     Result.CreateDate:=FileDateToDateTime(ts.Time);  
  
Result.Size:=ts.FindData.nFileSizeHigh*4294967296+ts.FindData.nFileSizeLow;  
     Result.Attributes.ReadOnly:=(faReadOnly and ts.Attr)>0;  
     Result.Attributes.Hidden:=(faHidden and ts.Attr)>0;  
     Result.Attributes.System:=(faSysFile and ts.Attr)>0;  
     Result.Attributes.Archive:=(faArchive and ts.Attr)>0;  
     Result.ModifyDate:=FileTime2DateTime(ts.FindData.ftLastWriteTime);  
     Result.LastAccessDate:=FileTime2DateTime(ts.FindData.ftLastAccessTime);  
     Result.ShortName:=ts.FindData.cAlternateFileName;  
     Findclose(ts);  
   end  
 else Result.Exists:=false;  
end;  

Скорее всего эта функция как есть вряд ли понадобится, так как наверняка бОльшее количество определяемых параметров избыточно, тем ни менее может кому пригодится как пример выяснения информации о файле.

Теперь поговорим о поиске файлов. Для этой цели могут использоваться процедуры FindFirst, FindNext, FindClose, при участии переменной типа TSearchRec которая хранит информацию о текущем статусе поиска и характеристики последнего найденного файла.

Пример иллюстрирующий поиск всех файлов и каталогов в определенном каталоге:

Исходный код:

Var SearchRec:TSearchRec;  
...  
  If FindFirst('c:\Windows\*.*', faAnyFile, SearchRec)=0 then  
     repeat  
        {Вот здесь мы можем делать с найденным файлом ÷то угодно 
         SearchRec.name - имя файла 
         ExpandFileName(SearchRec.name) - имя файла с полным путем}  
     until FindNext(SearchRec) <> 0;  
     FindClose(SearchRec);  

Примечания по приведенному коду:
1) Первыми в список могут попадать файлы с именами «.» и «..» — это ДОСовские имена для переходов на «родительский уровень», иногда нужна обработка для их игнорирования.
2) FindFirst в качестве первого параметра принимает шаблон для поиска, так как он был принят для ДОС. Если шаблон не включает путь то файлы будут искаться в текущем каталоге.
3) FindFirst требует задания атрибута для файла — здесь мы искали все файлы, если надо какие-то определенные (например только скрытые, или только каталоги) то надо это указать, список всех атрибутов я уже приводил выше.
4) SearchRec переменная связывает во едино FindFirst и FindNext, но требует ресурсов для своей работы, поэтому желательно ее освободить после поиска процедурой FindClose(SearchRec) — на самом деле утечки памяти небольшие, но если программа работает в цикле и долгое время пожирание ресурсов будет значительным.
5)FindFirst/FindNext — работают не открывая файлы, поэтому они корректно находят даже Swap файлы Windows…

Поиск файлов на винчестере

Procedure FindRecursive( Const path: String; Const mask: String);  
  Var  
    fullpath: String;  
  Function Recurse( Var path: String; Const mask: String ): Boolean;  
    Var  
      SRec: TSearchRec;  
      retval: Integer;  
      oldlen: Integer;  
    Begin  
      Recurse := True;  
      oldlen := Length( path );  
      retval := FindFirst( path+mask, faAnyFile, SRec );  
      While retval = 0 Do Begin  
        If (SRec.Attr and (faDirectory or faVolumeID)) = 0 Then  
        form1.ListBox1.items.Add(path+srec.name);  
        retval := FindNext( SRec );  
      End;  
      FindClose( SRec );  
      If not Result Then Exit;  
      retval := FindFirst( path+'*.*', faDirectory, SRec );  
      While retval = 0 Do Begin  
        If (SRec.Attr and faDirectory) <> 0 Then  
          If (SRec.Name <> '.') and (SRec.Name <> '..') Then Begin  
            path := path + SRec.Name + '';  
            If not Recurse( path, mask ) Then Begin  
              Result := False;  
              Break;  
            End;  
            Delete( path, oldlen+1, 255 );  
          End;  
        retval := FindNext( SRec );  
      End;  
      FindClose( SRec );  
    End; { Recurse }  
  Begin  
    If path = '' Then  
      GetDir(0, fullpath)  
    Else  
      fullpath := path;  
    If fullpath[Length(fullpath)] <> '' Then  
      fullpath := fullpath + '';  
    If mask = '' Then  
      Recurse( fullpath, '*.*' )  
    Else  
      Recurse( fullpath, mask );  
  End;  

В целом же программа выглядит так:

unit Unit1;  
  
interface  
  
uses  
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
  Dialogs, StdCtrls;  
  
type  
  TForm1 = class(TForm)  
    ListBox1: TListBox;  
    Button1: TButton;  
    procedure Button1Click(Sender: TObject);  
  private  
    { Private declarations }  
  public  
    { Public declarations }  
  end;  
  
var  
  Form1: TForm1;  
  
implementation  
  
{$R *.dfm}  
Procedure FindRecursive( Const path: String; Const mask: String);  
  Var  
    fullpath: String;  
  Function Recurse( Var path: String; Const mask: String ): Boolean;  
    Var  
      SRec: TSearchRec;  
      retval: Integer;  
      oldlen: Integer;  
    Begin  
      Recurse := True;  
      oldlen := Length( path );  
      retval := FindFirst( path+mask, faAnyFile, SRec );  
      While retval = 0 Do Begin  
        If (SRec.Attr and (faDirectory or faVolumeID)) = 0 Then  
        form1.ListBox1.items.Add(path+srec.name); {добавление}  
        {очередного найденного файла в ListBox}  
       {-------------------------------------}  
       {здесь можно производить слежением за выполнение процедуры}  
       {например, поставить ProgressBar}  
        retval := FindNext( SRec );  
      End;  
      FindClose( SRec );  
      If not Result Then Exit;  
      retval := FindFirst( path+'*.*', faDirectory, SRec );  
      While retval = 0 Do Begin  
        If (SRec.Attr and faDirectory) <> 0 Then  
          If (SRec.Name <> '.') and (SRec.Name <> '..') Then Begin  
            path := path + SRec.Name + '';  
            If not Recurse( path, mask ) Then Begin  
              Result := False;  
              Break;  
            End;  
            Delete( path, oldlen+1, 255 );  
          End;  
        retval := FindNext( SRec );  
      End;  
      FindClose( SRec );  
    End; { Recurse }  
  Begin  
    If path = '' Then  
      GetDir(0, fullpath)  
    Else  
      fullpath := path;  
    If fullpath[Length(fullpath)] <> '' Then  
      fullpath := fullpath + '';  
    If mask = '' Then  
      Recurse( fullpath, '*.*' )  
    Else  
      Recurse( fullpath, mask );  
  End;  
  
  
procedure TForm1.Button1Click(Sender: TObject);  
begin  
FindRecursive('d:','*.*'); {вместо 'd:' можно написать лубой каталог}  
end;  

Автор: Михаил Христосенко

Поиск файлов на Delphi

function FindFirst(const Path: string; Attr: Integer; var F: TSearchRec): Integer;  

Path — путь, по которому искать файл, включая его имя и расширение (возможно использовать символ *).

attr — атрибуты файла. Может принимать следующие значения:

faReadOnly $00000001 Только чтение
faHidden $00000002 Скрытый
faSysFile $00000004 Системный
faVolumeID $00000008 Метка диска
faDirectory $00000010 Директория
faArchive $00000020 Обычный
faAnyFile $0000003F Любой файл

F- переменная типа TsearchRec, в нее Delphi запихивает все характеристики найденного файла. Описание типа TsearchRec (предлагаю только для того, чтобы было проще освоиться, сам тип уже описан в SysUtils).

type  
    TSearchRec = record  
    Time: Integer; // время создания  
    Size: Integer; //размер файла в байтах  
    Attr: Integer; // Атрибуты  
    Name: TFileName; //имя файла  
    ExcludeAttr: Integer;   
    FindHandle: THandle; //хандл на файл  
    FindData: TWin32FindData; //доп. информация о файле  
end;  

Теперь приведу простой пример использования этой функции. Поставьте на форму одну кнопку TButton, а обработчик события OnClick у нее должен иметь примерно такой вид:

procedure TForm1.Button1Click(Sender: TObject);  
 var sr:TSearchRec;  
 begin  
 findFirst('*.exe',faAnyFile,sr);  
 edit1.Text:=sr.Name;  
 end;  

Чтобы искать следующий такой же файл, надо написать FindNext (Sr); Если файл найден, то процедуры FindFirst и FindNext возвращают 0 (зеро).

Ну а теперь собственно о том, как можно применить эти функции на практике, то есть опять пример!!! Чтобы разобраться с использованием этих функций попробуем написать программку, которая выдавала список всех программ с расширением *.exe в указанной директории, а затем при нажатии на кнопку включалась бы выбранная программа. На примере я покажу, как найти все .exe файлы в директории Windows, а затем объясню как можно модифицировать программку!

Итак, ставим на форму компонент TListBox в него мы будем выводить список найденных файлов. Обработчик события OnClick для нашей первой кнопки заменяем на такой:

procedure TForm1.Button1Click(Sender: TObject);  
var sr:TSearchRec;  
Result:word;  
begin  
    ChDir('C:windows');//меняем папку на C:Windows  
    Result := FindFirst ('*.exe',faAnyFile,sr);  
    ListBox1.Clear;  
    While result=0 do  
Begin  
    Result:=FindNext (sr);  
    ListBox1.Items.add(sr.name);  
End;  
end;  

Как видите мы просто организовали цикличный проход по директории C:Windows, который прекращается, как только функции возвращает не ноль! Функция ChDir была использована для смены папки с текущей на папку C:windows

Но приведенный выше способ находит файлы лишь в том каталоге, который задан переменной Path:String. Мне кажется, этого недостаточно для решения большей части поисковых проблем, поэтому стоит написать алгоритм поиска файлов в каждой найденной директории.

У меня расширенная процедура поиска выглядит вот так:

procedure ffind(cat:string); //каталог, откуда начать поиск  
var sea:TSearchRec;  
res:integer; //результат поиска (0 или нет)  
begin  
res:=FindFirst(cat+'*.*',faAnyFile,sea); //ищем первый файл  
res:=findNext(sea);//ищем следующий файл  
While res=0 do  
begin  
if (Sea.Attr=faDirectory) and ((Sea.Name='.')or(Sea.Name='..')) then//чтобы не было файлов . и..  
begin  
Res:=FindNext(sea);  
Continue;//продолжаем цикл  
end;  
  
if (Sea.Attr=faDirectory) then//если нашли директорию, то ищем файлы в ней  
begin  
Ffind(cat+Sea.Name+'');//рекурсивно вызываем нашу процедуру  
Res:=FindNext(Sea);//ищем след. файл  
Continue;//продолжаем цикл  
end;  
form1.ListBox1.Items.Add(Sea.Name);//добавляем в Listbox:Tlistbox имя файла  
Res:=FindNext(Sea);//ищем след. файл  
end;  
FindClose(Sea);//освобождаем пересенную поиска  
end;  

Здесь была использована процедура FindClose(var sea: TsearchRec); она необходима для освобождения поисковой переменной. В следующих примерах ее я использовать не буду, но Вы имейте ее в виду!!!

Возможно, этот алгоритм не самый быстрый и удобный, но он работает.
Для того, чтобы ваше приложение не выглядело подвисшим, можно добавить Application.ProcessMessages в начало нашей процедуры.

Теперь поставьте на форму еще кнопку для того, чтобы по ее нажатии запускать выбранную в ListBox’e программу. Обработчик события Onclick для нашей второй кнопки у меня получился таким:

procedure TForm1.Button2Click(Sender: TObject);  
begin  
    WinExec(pchar(listbox1.Items[listbox1.itemindex]),sw_show);  
end;  

Поскольку файлы находятся в директории Windows, то при вызове метода WinExec путь к файлам можно не указывать, а если вы используете какую-либо другую директорию, то вызов метода WinExec должен быть примерно таким:

WinExec(pchar('C:Путь к вашей папке'+listbox1.Items[listbox1.itemindex]),sw_show);   

Ну если вы хотите искать файлы в указанном пользователем каталоге можно использовать компонент DirectoryListBox, который дает доступ к каталогам на вашем компьютере и позволяет менять текущий каталог двойным нажатием мыши. Узнать выбранный каталог можно так:

DirectoryListBox1.Directory  

Поэтому в обработчике первой кнопки нужно убрать вызов функции ChDir. А в обработчике второй кнопки вставить приведенную выше конструкцию.

Таким образом приведу полный код приложения, которое получилось у меня с использованием компонента DirectoryListBox

unit Unit1;  
  
interface  
  
uses  
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,  
StdCtrls, FileCtrl;  
  
type  
TForm1 = class(TForm)  
Edit1: TEdit;  
Button1: TButton;  
ListBox1: TListBox;  
Button2: TButton;  
DirectoryListBox1: TDirectoryListBox;  
procedure Button1Click(Sender: TObject);  
procedure Button2Click(Sender: TObject);  
private  
{ Private declarations }  
public  
{ Public declarations }  
end;  
  
var  
Form1: TForm1;  
  
implementation  
  
{$R *.DFM}  
  
procedure TForm1.Button1Click(Sender: TObject);  
var sr:TSearchRec;  
Result:word;  
begin  
Result := FindFirst ('*.exe',faAnyFile,sr);  
ListBox1.Clear;  
While result=0 do  
Begin  
Result:=FindNext (sr);  
ListBox1.Items.add(sr.name);  
End;  
end;  
  
procedure TForm1.Button2Click(Sender: TObject);  
begin  
WinExec(pchar(DirectoryListBox1.Directory+''+listbox1.Items[listbox1.itemindex]),sw_show);  
end;  
  
end.  

Ну вот и все :)) Надеюсь, что помог Вам своими рассуждениями и примерами!

Автор: Михаил Христосенко

Копирование файлов

type   
  TCallBack=procedure (Position,Size: Longint); {Для индикации процесса копирования}   
   
procedure FastFileCopy(Const InfileName, OutFileName: String; CallBack: TCallBack);   
const BufSize = 3*4*4096; { 48Kbytes дает прекрасный результат }   
type   
  PBuffer = ^TBuffer;   
  TBuffer = array [1..BufSize] of Byte;   
var   
  Size             : integer;   
  Buffer           : PBuffer;   
  infile, outfile  : File;   
  SizeDone,SizeFile: Longint;   
begin   
  if (InFileName <> OutFileName) then   
  begin   
    buffer := Nil;   
    AssignFile(infile, InFileName);   
    System.Reset(infile, 1);   
    try   
      SizeFile := FileSize(infile);   
      AssignFile(outfile, OutFileName);   
      System.Rewrite(outfile, 1);   
      try   
        SizeDone := 0; New(Buffer);   
        repeat   
          BlockRead(infile, Buffer^, BufSize, Size);   
          Inc(SizeDone, Size);   
          CallBack(SizeDone, SizeFile);   
          BlockWrite(outfile,Buffer^, Size)   
        until Size < BufSize;   
        FileSetDate(TFileRec(outfile).Handle,   
        FileGetDate(TFileRec(infile).Handle));   
      finally   
        if Buffer <> Nil then Dispose(Buffer);   
        System.Close(outfile)   
      end;   
    finally  
      System.Close(infile);   
    end;   
  end  
else   
  Raise EInOutError.Create('File cannot be copied into itself');   
end;  

2. Копирование методом потока.

procedure FileCopy(Const SourceFileName, TargetFileName: String);  
var  
  S,T: TFileStream;  
begin  
  S := TFileStream.Create(sourcefilename, fmOpenRead);  
  try  
    T := TFileStream.Create(targetfilename, fmOpenWrite or fmCreate);  
    try  
      T.CopyFrom(S, S.Size);  
      FileSetDate(T.Handle, FileGetDate(S.Handle));  
    finally  
      T.Free;  
    end;  
  finally  
    S.Free;  
  end;  
end;  

3. Копирование методом LZExpand

uses LZExpand;  
   
procedure CopyFile(FromFileName, ToFileName  : string);  
var  
  FromFile, ToFile: File;  
begin  
  AssignFile(FromFile, FromFileName);  
  AssignFile(ToFile, ToFileName);  
  Reset(FromFile);  
  try  
    Rewrite(ToFile);  
    try  
    if LZCopy(TFileRec(FromFile).Handle, TFileRec(ToFile).Handle) < 0 then  
      raise Exception.Create('Error using LZCopy')  
    finally  
      CloseFile(ToFile);  
    end;  
  finally  
    CloseFile(FromFile);  
  end;  
end;  

4. Копирование методами Windows

uses ShellApi;  
   
function WindowsCopyFile(FromFile, ToDir : string) : boolean;  
var F : TShFileOpStruct;  
begin  
  F.Wnd := 0; F.wFunc := FO_COPY;  
  FromFile:=FromFile+#0; F.pFrom:=pchar(FromFile);  
  ToDir:=ToDir+#0; F.pTo:=pchar(ToDir);  
  F.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION;  
  Result:=ShFileOperation(F) = 0;  
end;  
   
// Пример копирования:  
procedure TForm1.Button1Click(Sender: TObject);  
begin  
  if not WindowsCopyFile('C:UTILARJ.EXE', GetCurrentDir) then  
    ShowMessage('Copy Failed');  
end;  

Мной были сделаны некоторые эксперименты с данными функциями. Во всех случаях копировался один и тот же файл объёмом 122 Мб. Конечно, говорить о правильности результатов можно с трудом, ведь жёсткий диск работает по-разному — иногда быстрее, а иногда медленее.

Кажется, название функции FastFileCopy вполне оправдано. Впрочем, судить о том, какая из функций действительно работает быстрее, нужно по результатам экспериментов на большом числе компьютеров с разными конфигурациями. Но цель данной статьи была не выявить самый быстрый способ, а просто показать об этих способах. Использовать можно любой из методов, все они работоспособны.

Копирование и удаление файлов в Delphi

BOOL CopyFile(
  LPCTSTR lpExistingFileName, // pointer to name of an existing file 
  LPCTSTR lpNewFileName, // pointer to filename to copy to 
  BOOL bFailIfExists // flag for operation if file exists 
);

Параметры передаваемые в эту функцию:

Указатель на имя существующего файла (нуль терминированная строка т.е. тип PChar! )
Указатель на имя файла, который будет создан/перезаписан после копирования (нуль терминированная строка т.е. тип PChar! )
Если этот параметр True и файл с таким именем уже существует, то функция вернет False. Если же файл, с именем указанным во втором параметре существует и в качестве третьего параметра передан False — то функция перезапишет файл и благополучно завершится.
Приведу небольшой пример использования этой функции. Создайте на диске C: файл ‘1.txt’, а на форму поставьте кнопку:

procedure TForm1.Button1Click(Sender: TObject);  
begin  
  if CopyFile('c:1.txt','c:2.txt',true) then  
  ShowMessage('Файл успешно скопирован!')  
  else ShowMessage('Неудача!');  
end;  

Для того, чтобы точнее узнать при возникновении ошибки, что же все таки произошло, надо воспользоваться функцией GetLastError, которая возвращает код последней ошибки (формат DWORD). Теперь мы немного изменим пример:

procedure TForm1.Button1Click(Sender: TObject);  
begin  
  if CopyFile('c:1.txt','c:2.txt',true) then  
    ShowMessage('Файл успешно скопирован!')  
  else  
    ShowMessage('Ошибка! Вот ее код: '+IntToStr(GetLastError));  
end;  

Таким образом нажав второй раз на кнопку мы получим сообщение: «Ошибка! Вот ее код: 80». Это говорит нам, что файл существует.

Коды всех ошибок можно легко найти в хелпе.

Для углубления рассматриваемого вопроса приведу пример копирования файлов с помощью файлового потока (TFileStream). В приведенной пользовательской функции введены два дополнительных параметра From и Count, которые указывают, соответственно, с какого и по какой байт нужно копировать файл. Если необходимо скопировать весь файл, то необходимо передать нули. Вот код этой функции:

function MyCopyFile( InFile,OutFile: String; From,Count: Longint ): Longint;  
var  
  InFS,OutFS: TFileStream;  
begin  
  InFS := TFileStream.Create( InFile, fmOpenRead );//создаем поток  
  OutFS := TFileStream.Create( OutFile, fmCreate );//создаем поток  
  InFS.Seek( From, soFromBeginning );//перемещаем указатель в From  
  Result := OutFS.CopyFrom( InFS, Count );  
  InFS.Free;//освобождаем  
  OutFS.Free;//освобождаем  
end;  

Удаление файлов
Для удаления файлов в Delphi так же предусмотрена специальная процедура DeleteFile. В качестве параметра, передаваемого в функцию, выступает строка типа PChar, указывающая имя файла, который нужно удалить. Сразу предлагаю Вам простой пример на использование этой функции:

procedure TForm1.Button1Click(Sender: TObject);  
begin  
  if DeleteFile('c:2.txt') then  
    ShowMessage('Файл успешно удален!')  
  else  
  ShowMessage('Ошибка! Вот ее код: '+IntToStr(GetLastError));  
end;  

Удаление пустой директории
Чтобы удалить пустую директорию с помощью Delphi достаточно обратиться к функции RemoveDir.

function RemoveDir(const Dir: string): Boolean;  

Эта функция возвращает True если директория, указанная в единственном параметре, передаваемом в функцию, успешно удалена, в противном случае функция возвратит False.

Часто возникает необходимость удалить непустую папку, содержащую не только файлы, но и другие вложенные папки. Для этого была написана пользовательская функция, удаляющая папку со всеми файлами и поддиректориями. Вот она:

function MyRemoveDir(sDir : String) : Boolean;   
var   
  iIndex : Integer;   
  SearchRec : TSearchRec;   
  sFileName : String;   
begin   
  Result := False;   
  sDir := sDir + '*.*';   
  iIndex := FindFirst(sDir, faAnyFile, SearchRec);   
  
  while iIndex = 0 do begin   
    sFileName := ExtractFileDir(sDir)+''+SearchRec.Name;   
    if SearchRec.Attr = faDirectory then begin   
      if (SearchRec.Name <> '' ) and   
      (SearchRec.Name <> '.') and   
      (SearchRec.Name <> '..') then   
        MyRemoveDir(sFileName);   
      end else begin   
        if SearchRec.Attr <> faArchive then   
        FileSetAttr(sFileName, faArchive);   
        if NOT DeleteFile(sFileName) then   
        ShowMessage('Could NOT delete ' + sFileName);   
    end;   
    iIndex := FindNext(SearchRec);   
  end;   
  
  FindClose(SearchRec);   
  
  RemoveDir(ExtractFileDir(sDir));   
  Result := True;   
end;  

А сейчас пример использования этой функции:

procedure TForm1.Button1Click(Sender: TObject);  
begin  
  if MyRemoveDir('C:testDir') then ShowMessage('Директория успешно удалена')  
  else ShowMessage('Не получается удалить директорию');  
end;  

Общие замечания по данной теме
Перед копированием или удалением файлов всегда проверяйте его наличие функцией FileExists:

if FileExists('c:1.txt') then  
 if CopyFile('c:1.txt','c:2.txt',true) then  
  ShowMessage('Файл успешно скопирован!')  

Чтобы использовать в функциях CopyFile и DeleteFile имена файлов полученные с помощью, например, OpenDialog, надо из привести к типу PChar:

if CopyFile(Pchar(OpenDialog1.FileName),Pchar(SaveDialog1.FileName),true) then ...  

Всегда следите за именами файлов, используемых в функциях. Обращайте внимание на абсолютные и относительные пути. Из-за этого часто возникают ошибки, которые сложно отследить!
Ну вот наверно и все, что я хотел бы рассказать Вам о копировании и удалении в Delphi.

Автор: Михаил Христосенко

Как прочитать ID3-Tag’и из MP3-файла?

{   
  Byte 1-3 = ID 'TAG'   
  Byte 4-33 = Titel / Title   
  Byte 34-63 = Artist   
  Byte 64-93 = Album   
  Byte 94-97 = Jahr / Year   
  Byte 98-127 = Kommentar / Comment   
  Byte 128 = Genre   
}  

Это — общая схема хранения информации в MP3-файле, которую мы будем читать. Вся эта информация отделяется от «музыкальной» части файла символами ‘TAG’ . После них и начинается служебная информация: название композиции, исполнитель, альбом, год исполнения, комментарий, жанр. Будет гораздо проще работать с ID3-тегами, объявив для них отдельный тип:

type    
  TID3Tag = record    
    ID: string[3];    
    Titel: string[30];    
    Artist: string[30];    
    Album: string[30];    
    Year: string[4];    
    Comment: string[30];    
    Genre: Byte;    
  end;  

Итак, мы объявили тип TID3Tag и теперь можем его использовать. Как видно из кода, этот класс содержит несколько строковых полей, в каждом из которых и будет записан соответствующий ID3-тег.

Теперь следует поговорить о теге, отвечащем за жанр композиции. Дело в том, что в файле хранится лишь номер жанра, а не название самого жанра, поэтому получать его название придётся вручную. Сначала объявим массив, содержащий названия всех возможных жанров. Всего их 147:

const   
 Genres : array[0..146] of string =    
    ('Blues','Classic Rock','Country','Dance','Disco','Funk','Grunge',    
    'Hip- Hop','Jazz','Metal','New Age','Oldies','Other','Pop','R&B',    
    'Rap','Reggae','Rock','Techno','Industrial','Alternative','Ska',    
    'Death Metal','Pranks','Soundtrack','Euro-Techno','Ambient',    
    'Trip-Hop','Vocal','Jazz+Funk','Fusion','Trance','Classical',    
    'Instrumental','Acid','House','Game','Sound Clip','Gospel','Noise',    
    'Alternative Rock','Bass','Punk','Space','Meditative','Instrumental Pop',    
    'Instrumental Rock','Ethnic','Gothic','Darkwave','Techno-Industrial','Electronic',    
    'Pop-Folk','Eurodance','Dream','Southern Rock','Comedy','Cult','Gangsta',    
    'Top 40','Christian Rap','Pop/Funk','Jungle','Native US','Cabaret','New Wave',    
    'Psychadelic','Rave','Showtunes','Trailer','Lo-Fi','Tribal','Acid Punk',    
    'Acid Jazz','Polka','Retro','Musical','Rock & Roll','Hard Rock','Folk',    
    'Folk-Rock','National Folk','Swing','Fast Fusion','Bebob','Latin','Revival',    
    'Celtic','Bluegrass','Avantgarde','Gothic Rock','Progressive Rock',    
    'Psychedelic Rock','Symphonic Rock','Slow Rock','Big Band','Chorus',    
    'Easy Listening','Acoustic','Humour','Speech','Chanson','Opera',    
    'Chamber Music','Sonata','Symphony','Booty Bass','Primus','Porn Groove',    
    'Satire','Slow Jam','Club','Tango','Samba','Folklore','Ballad',    
    'Power Ballad','Rhytmic Soul','Freestyle','Duet','Punk Rock','Drum Solo',    
    'Acapella','Euro-House','Dance Hall','Goa','Drum & Bass','Club-House',    
    'Hardcore','Terror','Indie','BritPop','Negerpunk','Polsk Punk','Beat',    
    'Christian Gangsta','Heavy Metal','Black Metal','Crossover','Contemporary C',    
    'Christian Rock','Merengue','Salsa','Thrash Metal','Anime','JPop','SynthPop');  

Наконец, процедура, читающая все теги из MP3-файла… Пропишем её в разделе implementation:

var    
  Form1: TForm1;    
   
implementation    
   
{$R *.dfm}    
   
function readID3Tag(FileName: string): TID3Tag;    
var    
  FS: TFileStream;    
  Buffer: array [1..128] of Char;    
begin    
  FS := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);    
  try    
    FS.Seek(-128, soFromEnd);    
    FS.Read(Buffer, 128);    
    with Result do    
    begin    
      ID := Copy(Buffer, 1, 3);    
      Titel := Copy(Buffer, 4, 30);    
      Artist := Copy(Buffer, 34, 30);    
      Album := Copy(Buffer, 64, 30);    
      Year := Copy(Buffer, 94, 4);    
      Comment := Copy(Buffer, 98, 30);    
      Genre := Ord(Buffer[128]);    
    end;    
  finally    
    FS.Free;    
  end;    
end;  

Данная функция возвратит нам всё содержимое ID3-тегов MP3-файла, указанного в FileName. Теперь дело за малым — написать обработчик открытия файла и чтения содержимого всех тегов из выбранного файла:

procedure TfrmMain.Button1Click(Sender: TObject);    
begin    
  IF OpenDialog1.Execute then    
  begin    
    WITH readID3Tag(OpenDialog1.FileName) do    
    begin    
      LlbID.Caption := 'ID: ' + ID;    
      LlbTitel.Caption := 'Titel: ' + Titel;    
      LlbArtist.Caption := 'Artist: ' + Artist;    
      LlbAlbum.Caption := 'Album: ' + Album;    
      LlbYear.Caption := 'Year: ' + Year;    
      LlbComment.Caption := 'Comment: ' + Comment;    
      IF (Genre >= 0) AND (Genre <=146) then    
       LlbGenre.Caption := 'Genre: ' + Genres[Genre]    
      else    
       LlbGenre.Caption := 'N/A';    
    end;    
  end;    
end;  

Ну вот и всё… Добавьте соответствующие компоненты на форму и испробуйте работоспособность кода. В архиве с данной статьёй есть данная демо-программа.

Кроме ID3 тегов (полное имя которых звучит как ID3v1), существуют ID3v2-теги. Они содержат большее количество информации: все ID3v1 теги, а также информацию об авторских правах, настоящем исполнителе, адресе в интернете, композиторе и другой информации. Принцип их чтения тот же, что и у ID3v1 тегов.

Работа с CSV файлами в Delphi

procedure LoadCSVFile (FileName: String; separator: char);  
var f: TextFile;  
    s1, s2: string;  
    i, j: integer;  
begin  
 i := 0;  
 AssignFile (f, FileName);  
 Reset(f);  
 while not eof(f) do  
 begin  
   readln (f, s1);  
   i := i + 1;  
   j := 0;  
   while pos(separator, s1)<>0 do  
    begin  
     s2 := copy(s1,1,pos(separator, s1)-1);  
     j := j + 1;  
     delete (s1, 1, pos(separator, S1));  
     StringGrid1.Cells[j-1, i-1] := s2;  
    end;  
   if pos (separator, s1)=0 then  
    begin  
     j := j + 1;  
     StringGrid1.Cells[j-1, i-1] := s1;  
    end;  
   StringGrid1.ColCount := j;  
   StringGRid1.RowCount := i+1;  
  end;  
 CloseFile(f);  
end;  

Теперь разберем этот код.

procedure LoadCSVFile (FileName: String; separator: char);  

Это заголовок нашей процедуры. В качестве параметров мы передаем ей имя файла и разделитель данных.

AssignFile (f, FileName);  
Reset(f);  

Здесь мы ассоциируем с файловой переменной f имя файла и открываем его для чтения.

while not eof(f) do  
  begin  
   readln (f, s1);  

Пока не достигнут конец файла, читаем из него очередную строку.

Далее нам остается только разделить строку на много строк, используя в качестве разделителя символ separator, и записать эти строки в таблицу, учитывая то, что нужно увеличить число рядов на 1. Это делается следующим кодом:

while pos(separator, s1)<>0 do  
 begin  
  s2 := copy(s1,1,pos(separator, s1)-1);  
  j := j + 1;  
  delete (s1, 1, pos(separator, S1));  
  StringGrid1.Cells[j-1, i-1] := s2;  
 end;  
if pos (separator, s1)=0 then  
 begin  
  j := j + 1;  
  StringGrid1.Cells[j-1, i-1] := s1;  
 end;  
StringGrid1.ColCount := j;  
StringGRid1.RowCount := i+1;  

Ну вот, пожалуй, и все что я хотел написать.

Пишем компонент — окно выбора папки

function BrowseFolder(title: PChar; h: hwnd): String;  

Где title — заголовок диалога (поставьте любой на ваш вкус), h — хэндл окна-владельца (то есть вашей программы). А команды, использованные в коде, содержатся в ShlObj.pas, так что не забудьте указать этот модуль в разделе uses.

unit BrowseFolderDlg;  
   
interface  
   
uses  
Windows, Messages, SysUtils, Classes, Controls, ShlObj;  
   
type  
  TBrowseFolderDlg = class(TComponent)  
  private  
    { Private declarations }  
  protected  
    { Protected declarations }  
  public  
    { Public declarations }  
    function BrowseFolder(title: PChar; h: hwnd): String;  
  published  
    { Published declarations }  
end;  
   
procedure Register;  
   
implementation  
   
procedure Register;  
begin  
  RegisterComponents('Dialogs', [TBrowseFolderDlg]);  
end;  
   
function TBrowseFolderDlg.BrowseFolder(title: PChar; h: hwnd): String;  
var  
  lpItemID: PItemIDList;  
  path: array[0..Max_path] of char; //выбранная папка  
  BrowseInfo: TBrowseInfo; //настройки диалога  
begin  
  FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);  
  SHGetSpecialFolderLocation(h,csidl_desktop,BrowseInfo.pidlRoot);  
  //устанавливаем свойства диалогового окна  
  with BrowseInfo do  
    begin   
    hwndOwner := h; //окно-владелец  
    lpszTitle := title; //заголовок диалога  
    //не показываем некоторые системные папки: "Корзина", "Панель управления" и т.д  
    ulFlags := BIF_RETURNONLYFSDIRS+BIF_EDITBOX+BIF_STATUSTEXT;  
  end;  
  //выводим диалог  
  lpItemID := SHBrowseForFolder(BrowseInfo);  
  //папка, указанная юзером, существует?  
  if lpItemId <> nil then  
    begin   
    SHGetPathFromIDList(lpItemID, Path);  
    result:=path;  
    GlobalFreePtr(lpItemID); //освобождаем ресурсы  
  end;  
end;  
   
end.  

Готово? Сохранитесь и, выбрав Component > Install Component, проинсталлируйте наш диалог, указав в разделе Unit File Name путь к файлу BrowseFolderDlg.pas.

Осуществить вызов диалога из программы можно так (разумеется, предварительно бросив TBrowseFolderDlg на форму):

procedure TForm1.Button1Click(Sender: TObject);  
begin  
  Form1.Caption:= 'Выбрана следующая папка: '+  
  BrowseFolderDlg1.BrowseFolder('Укажите каталог:',Application.Handle);  
end;  

Конечно, это только «скелет» полноценного компонента, и просторы для модернизации безграничны.

Работаем с файлами

CopyFile(Начальный_файл, Конечный_файл, Перезапись);  

Где,
Начальный_файл — Полный путь с указанием имени и расширения к файлу, который будет копироваться.
Конечный_файл — Полный путь с указанием имени и расширения куда копируем.
Перезапись – Если такой файл уже существует, то будет ли он перезаписан (true — не будет, false — будет).

Пример:

CopyFile('C:1.txt', 'D:1.txt', true);  

Обратите внимание, что при указании второго параметра (Конечный_файл) мы указываем не просто папку куда хотим скопировать файл, но и еще желаемое имя с расширение файла. Т.е если Начальный файл c:1.txt, то если указать имя конечного файла как d:1Copy.txt то в процессе копирования наш 1.txt переименуется в 1Copy.txt.

Переименование файлов в Delphi
За переименование файлов в Delphi отвечает функция RenameFileсинтаксис у неё очень простой и чем то схож с функцией копирования.

RenameFile('Начальное_имя','Конечное_имя') 

Начальное_имя — Полный путь с указанием имени и расширения, к файлу, который будет переименован.
Конечное_имя — Полный путь к файлу с указанием нового имени и расширения.

Пример:

RenameFile('c:1.txt','c:1Rename.txt');  

Перемещение файлов в Delphi
Что бы переместить файл, в Delphi используется функция MoveFile. Давайте посмотрим на её синтаксис:

MoveFile(Начальный_файл, Конечный_файл); 

Где,
Начальный_файл — Полный путь с указанием имени и расширения к файлу, который будет перемещаться.
Конечный_файл — Полный путь с указанием имени и расширения куда перемещаем.

Здесь также следует обратить внимание на то что при указании второго параметра (Конечный_файл) мы указываем не просто папку куда хотим переместить файл, но и еще желаемое имя с расширение файла. Т.е если Начальный файл c:1.txt, то если указать имя конечного файла как d:1Paste.txt то в процессе перемещения наш 1.txt переименуется в 1Paste.txt.

Удаление файлов в Delphi
Наверное, самая простая из рассмотренных выше функций это функция удаления, DeleteFile.

DeleteFile('Имя_файла');  

Имя_файла — здесь предполагается указание полного пути, имени и расширения удаляемого файла.

Пример:

DeleteFile('c:1.txt');  

Последовательный поиск

procedure TForm1.edtSearchChange(Sender: TObject);  
begin  
  with Table1 do begin  
    SetKey;  
    FieldByName('Company').AsString:=edtSearch.text;  
    GotoNearest;  
  end;  
end;  

Собственно, все. Можно откомпилировать и запустить программу. Введите что-нибудь в поле ввода и вы увидите, как после набора каждого символа указатель текущей записи таблицы перемещается, указывая на запись, сответствующую тому, что вы ввели.

Теперь можно немного усложнить обработчик onChange. Например, можно отключить обработчик, если пользователь нажимает Backspace или Delete, или поле ввода не содержит текста. Выглядеть это будет примерно так:

procedure TForm1.edtSearchChange(Sender: TObject);  
var txt, sfind:string;  
      len:integer;  
begin  
  //don't do anything if user presses  
  //delete or backspace  
  if edFromCode = true then begin  
    edFromCode := false;  
    exit;  
  end;  
  
  //don't do anything if there is  
  //no text in edSearch  
  txt:=edtSearch.Text;  
  if Length(txt)=0 then exit;  
  
  //goto nearest match  
  with Table1 do begin  
    SetKey;  
    FieldByName('Company').AsString:=edtSearch.text;  
    GotoNearest;  
  end;  
  
  //calculate what part of text should be selected  
  sfind := Table1.FieldByName('Company').AsString;  
  len := Length(sfind) - Length(txt);  
  if len > 0 then begin  
    edFromCode:=true;  
    edtSearch.Text:=sfind;  
    edtSearch.SelStart:=Length(txt);  
    edtSearch.SelLength:=len;  
  end;  
end;  

Для такого случая нужен дополнительный код — обработчик события onKeyDown:

procedure TForm1.edtSearchKeyDown(Sender: TObject; var Key: Word;  
                Shift: TShiftState);  
begin  
  if (Key=VK_DELETE) or (Key=VK_BACK) then begin  
    if Lenght(edtSearch.Text)>0 then begin  
    //onchange event should not be executed...  
      edFromCode := true;  
    end;  
  end;  
end;   

Вставка Bitmap через буфер обмена

function CopyClipToBuf(DC: HDC; Left, Top,  
           Width, Height: Integer;  Rop: LongInt;  
           var CopyDC: HDC;  
           var CopyBitmap: HBitmap): Boolean;  
var  
  TempBitmap: HBitmap;  
begin  
  Result := False;  
  CopyDC := 0;  
  CopyBitmap := 0;  
  if DC <> 0 then  
    begin  
      CopyDC := CreateCompatibleDC(DC);  
      if CopyDC <> 0 then  
        begin  
          CopyBitmap := CreateCompatibleBitmap(DC,  
                          Width, Height);  
          if CopyBitmap <> 0 then  
            begin  
              TempBitmap := CopyBitmap;  
              CopyBitmap := SelectObject(CopyDC,  
                              CopyBitmap);  
              Result := BitBlt(CopyDC, 0, 0,  
                          Width, Height, DC,  
                          Left, Top, Rop);  
              CopyBitmap := TempBitmap;  
            end;  
        end;  
    end;  
end;  
  
function CopyBufToClip(DC: HDC; var CopyDC: HDC;  
           var CopyBitmap: HBitmap;   
           Left, Top, Width, Height: Integer;  
           Rop: LongInt; DeleteObjects: Boolean): Boolean;  
var  
  TempBitmap: HBitmap;  
begin  
  Result := False;  
  if (DC <> 0) and  
     (CopyDC <> 0) and  
     (CopyBitmap <> 0) then  
    begin  
      TempBitmap := CopyBitmap;  
      CopyBitmap := SelectObject(DC, CopyBitmap);  
      Result := BitBlt(DC, Left, Top,  
                  Width, Height, CopyDC,  
                  0, 0, Rop);  
      CopyBitmap := TempBitmap;  
      if DeleteObjects then  
        begin  
          DeleteDC(CopyDC);  
          DeleteObject(CopyBitmap);  
        end;  
    end;  
end;  

Учимся копировать файлы в Delphi

procedure MyFileCopy(Const SourceFileName, TargetFileName: String);  

Нажимаем Ctrl+Shift+C как всегда Delphi сгенерирует заготовку для нашей процедуры, посмотри что в итоге получилось у меня и допиши недостающие строчки у себя

procedure MyFileCopy(Const SourceFileName, TargetFileName: String);  
var  
A,F : TFileStream;  
begin  
A := TFileStream.Create(sourcefilename, fmOpenRead );  
try  
F := TFileStream.Create(targetfilename, fmOpenWrite or fmCreate);  
try  
F.CopyFrom(A, A.Size ) ;  
FileSetDate(F.Handle, FileGetDate(A.Handle));  
finally  
F.Free;  
end;  
finally  
A.Free;  
end;  
end;   

Копирование здесь происходит при помощи создания потока, вот пример использования данной процедуры:

Myfilecopy('D:index.htm', 'D:11.html' );  

Способ номер ДВА

Для его реализации, никаких процедур создавать не нужно, и на мой взгляд этот способ самый простой:
Пример использования:

CopyFile(Pchar('D:index.txt'), Pchar('D:11.txt'), true)   

На этом всё встретимся в следующих уроках!

Файловые операции с использованием стандартного диалога с анимацией Копирование Файлов

uses ShellAPI;  
  
procedure TForm1.Button1Click(Sender: TObject);   
var   
  Fo      : TSHFileOpStruct;   
  buffer  : array[0..4096] of char;   
  p       : pchar;   
begin   
  FillChar(Buffer, sizeof(Buffer), #0);   
  p := @buffer;   
  p := StrECopy(p, 'C:DownLoad1.ZIP') + 1;   
  p := StrECopy(p, 'C:DownLoad2.ZIP') + 1;   
  p := StrECopy(p, 'C:DownLoad3.ZIP') + 1;   
  StrECopy(p, 'C:DownLoad4.ZIP');   
  FillChar(Fo, sizeof(Fo), #0);   
  Fo.Wnd    := Handle;   
  Fo.wFunc  := FO_COPY;   
  Fo.pFrom  := @Buffer;   
  Fo.pTo    := 'D:';   
  Fo.fFlags := 0;   
  if ((SHFileOperation(Fo) <> 0) or  
    (Fo.fAnyOperationsAborted <> false)) then  
    ShowMessage('Cancelled')   
end;