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

В данной статье мы подробно рассмотрим применение функции SHFileOperation. function SHFileOperation(const lpFileOp: TSHFileOpStruct): Integer; stdcall; Данная функция позволяет производить копирование, перемещение, переименование и удаление (в том числе и в Recycle Bin) объектов файловой системы. Функция возвращает 0, если операция выполнена успешно, и ненулевое значение в противном :-) случае.

Функция имеет единственный аргумент - структуру типа TSHFileOpStruct, в которой и передаются все необходимые данные. Эта структура выглядит следующим образом:


_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;  

Добавлено: 07 Августа 2018 08:28:56 Добавил: Андрей Ковальчук

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

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

Прединсталляторы могут использовать разные алгоритмы работы – однократные, многократные, активные и пассивные.

1. Прединсталляторы
Это программы, исполняемые до инсталляции программного обеспечения.

Архивы бесплатного программного обеспечения идут на различные ухищрения, чтобы получить компенсацию за расходы на поддержание вебсервера и сервиса. Т.к. программы распространяются бесплатно, то зарабатывать средства приходится за счет размещения рекламы спонсоров. Прединсталляторы – тот класс программ, которые могут существенно облегчить финансовые проблемы владельцев freeware архивов.

Обычно, скачанное пользователем бесплатное или демонстрационное программное обеспечение - файл, имеет имя, отличное от SETUP, INSTALL, RUN или START. Чаще всего сейчас в имени файла используется сокращенное название программы (например, http://pipa.send-sms.ru/get.php/pipa.exe). Это позволяет вместе с архивом программы представить пользователю дополнительный EXE файл с одним из таких названий (setup.exe например).

В подавляющем количестве случаев процесс инсталляции будет начат пользователем с запуска именно этого (setup.exe) файла. При этом в файл (setup.exe) могут быть включены следующие функции:

проверка версии операционной системы;
показ рекламной информации или подключение рекламного сервиса;
запуск инсталляции основной программы;
удаление прединсталлятора из памяти.
2. На чем программировать
Если посмотреть на статистику счетчиков http://extreme-dm.com на любом из вебсайтов, то можно увидеть примерно такое распределение версий ОС у посетителей:

Видно, что наибольший процент посетителей используют ОС Windows 2000 или Windows XP. Поэтому будем ориентироваться на структуру реестра именно этих OC.

В данном документе описан процесс разработки отдельных процедур программы для Интернет-рекламы.

3. Структура программы
Программа прединсталлятор должна быть компактной, быстро исполняться, отрабатывать рекламный сервис, запускать инсталляцию основной программы и завершать свою работу.

В нашем примере программа-прединсталлятор будет состоять из прозрачной формы Form1 (Border Style = 0, Appearance = 0)

4. Подключение рекламного сервиса
Рекламный сервис может выполняться разными способами:

обязательным однократным или многократным посещением web страницы разработчика или спонсора;
размещением рекламного плаката в качестве wallpapers;
записью ссылки на web сайт спонсора или разработчика в Favorites;
каким-либо иным способом.
Внимание! В любом случае пользователь должен быть предупрежден об особенностях сервиса, включенного в программное обеспечение. Производить или не производить инсталляцию – выбор пользователя.

Рассмотрим вариант, когда программа-прединсталлятор устанавливает в качестве стартовой страницы для Internet Explorer страницу спонсора.

Для этого необходимо выполнить запись в реестр Windows. Это может быть проделано непосредственно из программы на Delphi или с помощью Java-скрипта. Достаточно создать на диске текстовый файл Java-скрипта и записать в него код, а затем запустить из Delphi программы.

Листинг для записи в текстовый файл из программы на Delphi – в файле dlpp1.zip

Текст Java-скрипта (всего 3 строчки):

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('\Software\Microsoft\Internet Explorer\Main\',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('\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell 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 Settings\Administrator\Favorites  
  
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 и может вызвать у пользователей негативную реакцию.

Добавлено: 07 Августа 2018 07:51:04 Добавил: Андрей Ковальчук

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

Решил открыть эту тему и постепенно собрать воедино основные приемы работы с файлами.

Сегодня текстовые файлы.
Текстовый файл отличается тем что он разбит на разные по длине строки, отделенные символами #13#10. Есть 2 основных метода работы с текстовыми файлами - старый паскалевский способ и через файловые потоки. У обоих есть преимущества и недостатки. Через потоки способ проще поэтому начнем с него.

Итак у всех потомков класса TStrings (TStringList, memo.Lines и т.п. ) есть методы записи и чтения в файл - SaveToFile, LoadFromFile. Преимущество - простота использования и довольно высокая скорость, недостаток - читать и писать файл можно только целиком.

Примеры.
1) Загрузка текста из файла в Memo:

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

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...

Добавлено: 04 Августа 2018 14:42:37 Добавил: Андрей Ковальчук

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

Хотя я и не очень хороший "Делфер", но я очень люблю программировать в Delphi, делать маленькие полезные программки для себя и своего компьютера. Недавно я узнал как производить поиск файлов на компьютере, причем поиск файлов производится не в отдельном каталоге, а на всем винчестере и в процессе поиска возможно следить за поиском. Процедуре поиска я нашел очень широкое применение, например, у меня на компьютере имеется папка с исходниками по Delphi и в этой папки очень много лишних файлов, которые занимают место на винчестере и при помощи процедуры поиска я удаляю ненужные файлы (*.cfg; *.~dfm; *.~pas и др.).

Начнем с описания процедуры FindResursive( Const path: String; Const mask: String) где переменная Path - каталог в котором будет производится поиск ('c:\'), а Mask - название файла или его часть ('*.exe' или '*.*' или 'project.dpr').

В самой процедуре будем использовать только одну (не считая вложенные функции)переменную, которая будет носить полное название найденного файла. А найденные файлы будем записывать в ListBox. Данную процедуру будем вызывать при нажатии кнопки. Процедура FindRecursive выглядит следующим образом:


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;  

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

Добавлено: 04 Августа 2018 08:38:39 Добавил: Андрей Ковальчук

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

В этой статье мы познакомимся с функциями для поиска файлов на дисках Вашего (и не только :) компьютера. Для тех кто собирается писать вирусы или что-то подобное используя приведенный алгоритм, то предупреждаю: создание вредоносных программ карается по УК РФ!!! Так что думайте сами, а тем кому интересно как же найти файл на диске с помощью Дельфи, то читайте дальше...

Для поиска файлов на диске в Delphi существует две функции, первая из них - это FindFirst, ниже приведено ее описание:


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.  

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

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

Добавлено: 04 Августа 2018 08:37:56 Добавил: Андрей Ковальчук

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

В данной статье показаны некоторые методы копирования файлов. Существуют и готовые функции - CopyFile(), CopyFileEx(), но порой они неприменимы. Например, при использовании функции CopyFile() с большими файлами мы не имеем доступа к процессу копирования, т.е. программа на некоторое время просто "зависает". Из методов, приведённых ниже, только первый позволяет контроллировать процесс копирования - можно добавить прогресс-индикатор выполнения или отображать объём скопированных данных.

1. Копирование методом Pascal

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:\UTIL\ARJ.EXE', GetCurrentDir) then  
    ShowMessage('Copy Failed');  
end;  

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

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

Добавлено: 02 Августа 2018 08:10:49 Добавил: Андрей Ковальчук

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

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

В самом простом случае вопрос копирования файлов очень прост (хотя поступило много пожеланий рассказать именно об этом)! Для этого достаточно посмотреть в хелп по Delphi :))

Копирование файлов
В Delphi есть функция CopyFile. Вот ее описание из хелпа

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.

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

Добавлено: 02 Августа 2018 08:09:26 Добавил: Андрей Ковальчук

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

На самом деле, как это не кажется, прочитать ID3-теги из MP3-файла совсем не сложно и, более того, для этого не требуется никаких специальных компонентов. TMediaPlayer здесь также бессилен. Все ID3-теги хранятся в последних 128-ми байтах MP3-файла. Часть из них записана не в том виде, в каком мы привыкли их читать в Winamp или в другом проигрывателе... Итак, перейдём сразу к коду...


{   
  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 тегов.

Добавлено: 02 Августа 2018 08:02:06 Добавил: Андрей Ковальчук

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

Введение
CSV-файл – простейший по организации файл-таблица, который понимает Microsoft Excel. CSV – Como Separated Value – данные, разделенные запятой. Это обычный текстовый файл, в котором каждая строка олицетворяет ряд таблицы, а разделение этого ряда на колонки осуществляется путем разделения значений специальным разделителем. Обычно роль этого разделителя, судя из названия, играет запятая. Однако, встречается и другой разделитель – точка с запятой. Даже в Microsoft не определились, с каким разделителем должен работать Excel. При сохранении какой-либо таблицы в формате CSV, в качестве разделителя используется точка с запятой. Но, при открытии такого файла с помощью Microsoft Excel, нужно быть очень внимательным, так как, не знаю, шутка это или нет, существует, как Вы знаете два способа открытия файла:

В главном меню программы выбрать пункт «Открыть» из меню «файл».
Найти на жестком диске нужный файл и два раза кликнуть на нем мышкой.
Так вот, при открытии CSV файла первым способом, Excel использует точку с запятой в качестве разделителя, а при открытии вторым способом Excel использует запятую в качестве разделителя. Правда в Microsoft Excel XP эта проблема(?) решена, и используется только точка с запятой, не смотря на название файла.

Работа с CSV файлами в Delphi
Для работы с CSV-файлами в Delphi Вам не понадобятся различные сторонние компоненты. Как я уже говорил, CSV-файл – это обычный текстовый файл. Следовательно, для работы с ним мы будем использовать стандартный тип TextFile определенный в модуле system.

Давайте напишем процедуру для загрузки CSV файла в таблицу TStringGrid. Это стандартный компонент Delphi для работы со строковыми таблицами. Находится он на странице Additional в палитре компонентов 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;  

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

Добавлено: 02 Августа 2018 07:46:55 Добавил: Андрей Ковальчук

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

Среди стандартных диалогов Delphi 6 (вкладка Dialogs) диалог выбора папки, как это не прискорбно, отсутствует. Но ничего, сейчас мы исправим данное упущение, написав соответствующий компонент.

Чтобы создать новый компонент, в Delphi IDE выберите пункт File > New > Other и затем в появившемся окне нажмите New Component. Появится диалоговое окно, в котором:

Ancensor type (класс-предок нового компонента) - введите TComponent;
Class Name (имя нового класса) - TBrowseFolderDlg;
Palette Page (имя вкладки: поместим наш диалог вместе со стандартными дельфийскими) - Dialogs.
Остальное оставьте без изменений и нажмите OK. Наш мегадиалог будет вызываться функцией, продекларированной в Public Declarations компонента:


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;  

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

Добавлено: 02 Августа 2018 07:45:21 Добавил: Андрей Ковальчук

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

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

Копирование файлов в Delphi
За копирование файлов в Delphi отвечает функция CopyFile, она имеет следующий синтаксис:


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');  

Добавлено: 02 Августа 2018 07:38:41 Добавил: Андрей Ковальчук

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

Для понимания этой статьи вам будет достаточно базовых знаний о программировании баз данных в Delphi.

Основная форма проекта должна содержать компоненты TTable и TEdit (назовем его edtSearch). Заметим, что таблица, к которой прикреплен компонент TTable, должна быть проиндексирована по полю, в котором производится поиск.

Компонент TTable содержит несколько методов для поиска заданного значения в таблице. Это методы Goto, GoToKey, GoToNearest, Find, FindKey, Find Nearest и другие (описание этих методов смотрите в помощи). Добавим обработчик события OnChange для компонента TEdit:


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;   

Добавлено: 02 Августа 2018 07:31:42 Добавил: Андрей Ковальчук

Вставка 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;  

Добавлено: 01 Августа 2018 07:18:37 Добавил: Андрей Ковальчук

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

Привет сегодня я покажу тебе парочку способов копирования файлов в delphi, выбирать какой из них использовать в своих программах конечно же вам. Итак, поехали

Способ номер РАЗ

Для его реализации нам понадобиться создать небольшую процедуру, поэтому после ключевого слова private пишем вот такой код:


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:\1\1.html' );  

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

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


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

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

Добавлено: 01 Августа 2018 07:02:47 Добавил: Андрей Ковальчук

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

В следующем примере используется функция SHFileOperation для копирования группы файлов и показа анимированного диалога. Вы можете использовать также следующие флаги для копирования, удаления, переноса и переименования файлов. TO_COPY, FO_DELETE, FO_MOVE, FO_RENAME

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


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:\DownLoad\1.ZIP') + 1;   
  p := StrECopy(p, 'C:\DownLoad\2.ZIP') + 1;   
  p := StrECopy(p, 'C:\DownLoad\3.ZIP') + 1;   
  StrECopy(p, 'C:\DownLoad\4.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;  

Добавлено: 01 Августа 2018 06:54:12 Добавил: Андрей Ковальчук