Исходный текст программы
unit u1;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, VCLZip, VCLUnZip, ComCtrls, ShellCtrls, FileCtrl, Registry, StrUtils, ExtCtrls, XPMan;
type TForm1 = class(TForm) GroupBox1: TGroupBox; OpenDialog1: TOpenDialog; BnPack: TButton; Label1: TLabel; CBRemSrc: TCheckBox; GroupBox2: TGroupBox; TrackBar1: TTrackBar; Label2: TLabel; Label3: TLabel; Label4: TLabel; GroupBox3: TGroupBox; CBComm: TCheckBox; BnUnPack: TButton; SaveDialog1: TSaveDialog; Edit1: TEdit; BnUp: TButton; Panel1: TPanel; XPManifest1: TXPManifest; procedure BnPackClick(Sender: TObject); procedure CBCommClick(Sender: TObject); procedure BnUnPackClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure BnUpClick(Sender: TObject); procedure Panel1Click(Sender: TObject); procedure Label2Click(Sender: TObject); procedure GroupBox2Click(Sender: TObject); private procedure CompressFile; procedure UnZipFile; procedure SaveSettings; procedure LoadSettings; public end;
var Form1: TForm1; //Переменная формы hmutex: THandle; //Идентификатор мьютекса flog: Text; //Переменная файла-лога ошибок implementation
{$R *.DFM}
//Процедура записи ошибок в лог и вывода сообщений о них
procedure Error(e: string); //Текст сообщения передаём через параметр begin try // Начало блока с обрабатываемыми исключениями //Связываем переменную с файлом, который должен находиться в той же директории AssignFile(flog,ExtractFilePath(Application.ExeName)+'\errors.log'); //Проверяем, существует ли файл, если да - дополняем, если нет - создаём if FileExists(ExtractFilePath(Application.ExeName)+'\errors.log') then Append(flog) else Rewrite(flog); //Запись в файл строки с датой-временем и сообщением WriteLn(flog,DateTimeToStr(Date+Time)+' '+e); //Закрываем файл CloseFile(flog); except //Если в файл записать не удалось, игнорируем это end; //Вывод сообщения об ошибке MessageBox(Application.Handle,PChar(e),'Ошибка',MB_ICONERROR); end;
//Процедура распаковки архива, если он передан в качестве параметра //командной строки
procedure UnZipFileCmd; var UZip:TVCLUnZip; //Переменная класса для работы с архивами begin if not FileExists(ParamStr(1)) then //Если файл не существует, begin //посылаем ошибку в процедуру Error(ParamStr(1)+' - указанный файл не найден!'); halt; //Завершаем работу приложения end; try //Начало блока с обрабатываемыми исключениями UZip:= TVCLUnZip.Create (nil); //Создаём объект распаковщика try //Начало вложенного блока с обработкой исключений with UZip do //Работаем с объектом begin ZipName:=ParamStr(1); //В поле имени архива пишем переданный параметр ReadZip; //Читаем файл архива DestDir:=ExtractFilePath(ParamStr(1)); //Извлекаем в ту же папку FilesList.Add('*'); //Список извлекаемых файлов - все UnZip; //Распаковка end; finally //Даже если и были ошибки, UZip.Free;//освобождаем ресурсы, занятые объектом halt; //Завершаем работу приложения end; except //Блок обработки исключений (в данном случае при работе с файлами) on E: EFCreateError do Error(E.Message); //Передаём ошибки в процедуру лога on E: EFOpenError do Error(E.Message); on E: EReadError do Error(E.Message); on E: EWriteError do Error(E.Message); end; end;
//Процедура сохранения настроек в реестре
procedure TForm1.SaveSettings; var r: TRegistry; //Переменная класса реестра begin r:= TRegistry.Create; //Создаём объект реестра r.OpenKey('Software\ZIPArchiver',true); //Открываем ключ, если нету - создаём r.WriteInteger('Level',TrackBar1.Position); //Сохраняем степень сжатия r.WriteString('SavePath',ExtractFilePath(SaveDialog1.FileName)); //и пути, //по которым открывали и сохраняли архивы r.WriteString('OpenPath',ExtractFilePath(OpenDialog1.FileName)); r.Free; //Овобождаем ресурсы, занятые объектом end;
//Процедура загрузки настроек из реестра
procedure TForm1.LoadSettings; var r: TRegistry; //Переменная класса реестра begin r:= TRegistry.Create; //Создаём объект реестра if r.OpenKey('Software\ZIPArchiver',false) then //Открываем ключ begin //Если он есть, читаем TrackBar1.Position:= r.ReadInteger('Level'); //настройки OpenDialog1.InitialDir:= r.ReadString('OpenPath'); SaveDialog1.InitialDir:= r.ReadString('SavePath'); end; r.Free; //Овобождаем ресурсы, занятые объектом end;
procedure TForm1.UnZipFile; var UZip:TVCLUnZip; //Переменная класса для работы с архивами dst:string; //Переменная для пути назначения распакованных файлов begin try //Начало блока с обрабатываемыми исключениями if not OpenDialog1.Execute then exit; //Если в диалоге файл не выбран, выходим UZip:= TVCLUnZip.Create (nil); //Создаём объект распаковщика try //Начало вложенного блока с обрабатываемыми исключениями with UZip do //Работаем с объектом begin ZipName:=OpenDialog1.FileName; //Имя архива из диалога ReadZip; //Считываем архив if not SelectDirectory('Выбор папки для распакованных файлов','',dst) then exit; //Если папка назначения не выбрана - выходим DestDir:=dst; //Путь назначения из диалогового окна FilesList.Add('*'); //Список извлекаемых файлов - все GroupBox1.Hide; Panel1.Show; //Вывод таблички "Подождите..." Form1.Cursor:= crHourGlass; //Курсор-часы UnZip; //Распаковка end; finally //Даже если и были ошибки, UZip.Free; //освобождаем ресурсы Panel1.Hide; GroupBox1.Show; //Скрытие таблички "Подождите..." Form1.Cursor:= crDefault; //Обычный курсор end; except //Блок обработки исключений (в данном случае при работе с файлами) on E: EFCreateError do Error(E.Message); //Передаём ошибки в процедуру лога on E: EFOpenError do Error(E.Message); on E: EReadError do Error(E.Message); on E: EWriteError do Error(E.Message); end; end;
//Процедура создания архива
procedure TForm1.CompressFile; var Zip:TVCLZip; //Объявляем переменную класса для работы с архивами i:integer; //Счётчик msg:string; //Строка для помещения текста сообщения о размере архива begin try //Начало блока с обрабатываемыми исключениями if not SaveDialog1.Execute then exit; //Если в диалоге файл не указан, выходим Zip:= TVCLZip.Create (nil); //Создаём объект для работы с архивами with Zip do //Работаем с объектом begin ZipName:= SaveDialog1.FileName; //Имя файла архива берём из диалога if not (UpperCase(RightStr(SaveDialog1.FileName,4))='.ZIP') then ZipName:= ZipName + '.zip'; //Если нет расширения - добавляем for i:= 0 to ShellListView1.Items.Count-1 do //Заполняем список на сжатие из if (ShellListView1.Items[i].Selected) and //выделенных файлов, (not ShellListView1.Folders[i].IsFolder) then //папки игнорируем FilesList.Add(ShellListView1.Folders[i].PathName); PackLevel:= TrackBar1.Position; //Степень сжатия берём из ползунка GroupBox1.Hide; Panel1.Show; //Вывод таблички "Подождите..." Form1.Cursor:= crHourGlass; //Курсор-часы end; try //Начало вложенного блока с обрабатываемыми исключениями Zip.Zip; //Сжимаем if CBRemSrc.Checked then //Если стоит флажок на удаление исходных файлов, for i:= 0 to Zip.FilesList.Count-1 do //берём очередной путь из списка DeleteFile(Zip.FilesList[i]); //и вызываем функцию удаления if CBComm.Checked then //Если стоит флажок добавления комментария, begin Zip.ZipComment:= Edit1.Text; //берём его текст из формы Zip.SaveModifiedZipFile; end; //и сохраняем изменения в архив msg:= 'Размер полученного архива: '+IntToStr(Zip.ZipSize div 1024)+' Кбайт.'; MessageBox(Form1.Handle,PChar(msg),'Готово',64); //Сообщение о размере архива finally //Даже если и были ошибки, Zip.Free; //освобождаем ресурсы ShellListView1.Refresh; //Обновляем список файлов открытого каталога Panel1.Hide; GroupBox1.Show; //Скрытие таблички "Подождите..." Form1.Cursor:= crDefault; //Обычный курсор end; except //Блок обработки исключений (в данном случае при работе с файлами) on E: EFCreateError do Error(E.Message); //Передаём ошибки в процедуру лога on E: EFOpenError do Error(E.Message); on E: EReadError do Error(E.Message); on E: EWriteError do Error(E.Message); end; end;
//Процедура обработки клика по кнопке "Архивировать..."
procedure TForm1.BnPackClick(Sender: TObject); begin if ShellListView1.SelCount>0 then CompressFile; //Если есть выделенные //элементы, вызываем процедуру упаковки end;
//Процедура обработки клика по флажку комментария
procedure TForm1.CBCommClick(Sender: TObject); begin Edit1.Enabled:=CBComm.Checked; //Поле ввода активно при включенном флажке if Edit1.Enabled then Edit1.SetFocus; //Если активно, фокусируем для ввода end;
//Процедура обработки клика по кнопке "Распаковать архив..."
procedure TForm1.BnUnPackClick(Sender: TObject); begin UnZipFile; //Запускаем процедуру, реализующую распаковку end;
//Процедура, выполняемая при создании формы
procedure TForm1.FormCreate(Sender: TObject); begin LoadSettings; //Вызываем процедуру загрузки настроек из реестра end;
//Процедура, выполняемая при закрытии формы
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin SaveSettings; //Вызываем процедуру сохранения настроек в реестр end;
procedure TForm1.BnUpClick(Sender: TObject); begin ShellListView1.Back; //Кнопка "вверх" end;
//Действия при запуске (инициализации) приложения initialization if ParamStr(1)<>'' then UnZipFileCmd; //Если передан параметр, вызываем распаковку
hmutex:= CreateMutex(nil, false, 'xWgZlf3jt6gR9kO0'); //Создаём мьютекс if (hmutex = 0) or (GetLastError = ERROR_ALREADY_EXISTS) then //Если не получилось begin //или уже существует, Error('Приложение уже запущено!'); //посылаем ошибку в процедуру halt; //Завершаем работу приложения end;
finalization if hmutex <> 0 then CloseHandle(hmutex); //При завершении работы закрываем мьютекс end.
|
