Спочатку я написав програмку, яка виконувала резервне копіювання файлів конфігурації і помістив її в автозавантаження. Та ця програма виконувала свої функції лише тоді, коли користувач заходив в систему. Це мене не влаштовувало, адже не кожен день я заходив не цей сервер.
В результаті я вирішив написати сервіс для вирішення цієї проблеми.
Опис ділиться на декілька кроків
Крок 1. Створення сервісу
Спочатку я створював Service Application і з меню File-New-Other.
Далі присвоїв сервісу ім’я, як видно на скріні нижче copyconfig. Оскільки мій сервіс примітивний, який виконує всього лиш декілька дій – пошук в директорії файлів з маскою *.cfg і наступне їх копіювання в потрібну мені директорію, то я описував лише подію OnExecute.
OnExecute – служба стартує, виконує певні дії і завершує свою роботу.
Нижче приведений код всієї служби з коментарями.
unit Serv;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,Inifiles;
type
Tcopyconfig = class(TService)
procedure ServiceExecute(Sender: TService);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;
var
copyconfig: Tcopyconfig;
listfile: array[0..20] of string; // масив для збереження імен файлів з потрібним нам розширенням
i:integer;
implementation
{$R *.DFM}
{Процедура пошуку по директорії потрібних нам файлів
В процедуру передається 2 параметри:
mask – маска фалів, які ми шукатимемо
path – щлях до директорії в якій буде проводитися пошук файлів заданої маски }
procedure FileFind(mask:string;path:string);
var sr:Tsearchrec;// Опис структури, яку використовує для пошуку система
found:integer; // знайдено чи ні
attr:integer;
begin
i:=0;
attr:=0;
attr:=Faanyfile;
found:=FindFirst(path + mask,attr, sr);
{по команді FindFirst програма створює структуру наступного типу
TsearchRec = record
Time: Integer; // час створення
Size: Integer; // розмір файлу
Attr: Integer;// атрибутиы
Name:TFileName // = TString; ім’я файлу
ExcludeAttr: Integer; знайдені атрибути
FindHandle: THandle; // !!! вказівник на структуру пошуку, яку створює ситсема, а не сервіс. В зв’язку з цим в кінці пошуку необхідно обов’язково писати FindClose – це звільняє паам’ять
FindData: TWin32FindData; // власне ця структура
end;}
while (found = 0) do // якщо хоч щось знайдено
begin
if (sr.name <> '.') and (sr.name <> '..') then
begin // якщо не вказували на корневі каталоги, то щось знайшли
listfile[i]:=sr.Name;
inc(i);
end;
found:=findnext(sr); // шукаємо далі, якщо ще є файли і каталоги
end;
FindClose(sr); // пошук завершений – вивільняємо пам’ять
end;
{Наступні два методи згенеровані автоматично}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
copyconfig.Controller(CtrlCode);
end;
function Tcopyconfig.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
{В цьому методі описується тіло служби, ті дії які буде вона виконувати після запуску}
procedure Tcopyconfig.ServiceExecute(Sender: TService);
var
mask,srcF,srcM,dstF,dstM:string //змінні для запису параметрів з ini файлу
dat:string; // в цю змінну ми внесемо дату потрібного нам формату
j:integer // змінна, яка потрібна при копіюванні файлів
inst:integer; // для визначення, файли конфігурації якого з продуктів Kerio копіювати
Ini:tinifile; // визначаємо змінну для файлу конфігурації сервісу
Begin
// Визначення ini файлу з якого будуть братися параметри
Ini:=Tinifile.Create('C:\BackupConfig.ini');
// зчитування параметрів з ini файлу
mask:=ini.ReadString('main','mask','*.cfg');
srcF:=ini.ReadString('source','firewall','C:\Program Files\Kerio\WinRoute FireWall');
srcM:=ini.ReadString('source','MailServer','C:\Program Files\Kerio\MailServer');
dstF:=ini.ReadString('dest','firewall','C:\Program Files\Kerio\WinRoute FireWall');
DstM:=ini.ReadString('dest','MailServer','C:\Program Files\Kerio\MailServer');
inst:=strtoint(ini.ReadString('main','inst','2'));
// після зчитування параметрів звільняємо ini файл
ini.Free;
// перетворюємо дату в потрібний формат
dateTimetostring(dat,'yyyy.mm.dd', Date);
// умовна конструкція, в якій визначається що і звідки копіювати
case inst of
// якщо 1, то відбувається копіювання файлів конфігурації тільки для MailServer
1:
Begin
// перевірка існування директорії в яку будуть копіюватися файли
if directoryexists(dstM+'\\Backup config MailServer') then
begin
//якщо не має в директорії каталогу з датою то створюємо такий
if not directoryexists (dstM+'\\Backup config MailServer\'+dat) then
mkdir(dstM+'\\Backup config MailServer\'+dat);
end
// якщо директорії немає, то створюємо таку
else
begin
mkdir(dstM+'\\Backup config MailServer');
mkdir(dstM+'\\Backup config MailServer\'+dat);
end;
// пошук файлу
Filefind(mask,srcM);
//копіювання файлу/файлів
for j:=0 to i do
begin
Copyfile(pchar(srcM+'\'+listfile[j]),pchar(dstM+'\Backup config MailServer\'+dat+'\'+listfile[j]),true);
end;
end;
// якщо 0, то відбувається копіювання файлів конфігурації тільки для FireWall
0:
begin
if directoryexists(dstF+'\'+'\Backup config Firewall') then
begin
if not directoryexists (dstF+'\'+'\Backup config Firewall\'+dat) then
mkdir(dstf+'\'+'\Backup config Firewall\'+dat);
end
else
begin
mkdir(dstF+'\'+'\Backup config Firewall');
mkdir(dstf+'\'+'\Backup config Firewall\'+dat);
end;
Filefind(mask,srcF);
for j:=0 to i do
begin
Copyfile(pchar(srcF+'\'+listfile[j]),pchar(dstF+'\Backup config FireWall\'+dat+'\'+listfile[j]),true);
end;
end;
//якщо 2, то відбувається копіювання файлів конфігурації для MailServer і FireWall
2:
begin
if directoryexists(dstF+'\'+'\Backup config Firewall') then
begin
if not directoryexists (dstF+'\'+'\Backup config Firewall\'+dat) then
mkdir(dstf+'\'+'\Backup config Firewall\'+dat);
end
else
begin
//edit1.Text:='File not exists';
mkdir(dstF+'\'+'\Backup config Firewall');
mkdir(dstf+'\'+'\Backup config Firewall\'+dat);
end;
if directoryexists(dstM+'\'+'\Backup config MailServer') then
begin
if not directoryexists (dstM+'\'+'\Backup config MailServer\'+dat) then
mkdir(dstM+'\'+'\Backup config MailServer\'+dat);
end
else
begin
mkdir(dstM+'\'+'\'+'Backup config MailServer');
mkdir(dstM+'\'+'\Backup config MailServer\'+dat);
end;
Filefind(mask,srcF);
for j:=0 to i do
begin
Copyfile(pchar(srcF+'\'+listfile[j]),pchar(dstF+'\Backup config FireWall\'+dat+'\'+listfile[j]),true);
end;
Filefind(mask,srcM);
for j:=0 to i do
begin
Copyfile(pchar(srcM+'\'+listfile[j]),pchar(dstM+'\Backup config MailServer\'+dat+'\'+listfile[j]),true);
end;
end;
end;
end;
end.
Для створення сервісу потрібно проект скомпілювати (Project-Compile або Ctrl+F9)Файл конфігурації BackupConfig.ini такого змісту:
[Main] ' 0 - Firewall ' 1 - MailServer ' 2 - Firewall and Mailserver inst=2 mask=*.cfg [Source] Firewall=C:\Program Files\Kerio\WinRoute FireWall\ Mailserver=C:\Program Files\Kerio\MailServer\ [Dest] Firewall=g:\Kerio backup\ Mailserver=g:\Kerio backup\
Крок 2. Встановлення сервісу
Є 2 способи як встановити, так і деінсталювати сервіс:
А) Ручками
Перед інсталяцією таким способом потрібно обов’язково помістити файл конфігурації в корінь диску С.
Далі Пуск-Виконати або Win+R вписати шлях до exe файлу сервісу і задати параметр install.
Натиснути ОК і в результаті ви отримаєте повідомлення про те, що сервіс встановлений. Щоб повідомлення не з’являлося потрібно дописати ще параметр /silent.
Для деінсталяції потрібно виконати ті ж самі дії тільки з параметром /uninstall.Б) Програмно
Потрібно створити новий проект, кинути на форму дві кнопки, підписати їх і заповнити обробники подій цих кнопок, плюс дописати функції інсталяції і деінсталяції сервісу.
Нижче лістинг програми з коментарями.
unit ServInst;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,shellapi,Winsvc;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{Функція інсталяції сервісу
Передаються два параметри:
ExecutablePath - шлях до exe файлу сервісу
ServiceName - ім’я сервісу, яке буде відображатись}
function CreateNTService(ExecutablePath,ServiceName: String):boolean;
var
hNewService,hSCMgr: SC_HANDLE;
// Rights: DWORD;
FuncRetVal: Boolean;
begin
FuncRetVal := False;
hSCMgr := OpenSCManager(nil,nil,SC_MANAGER_CREATE_SERVICE);
if (hSCMgr <> 0 ) then
begin
//Власні права доступу можуть описуватись тут
//використовується GENERIC_EXECUTE, що є комбінацією
//STANDARD_RIGHTS_EXECUTE, SERVICE_START, SERVICE_STOP,
//SERVICE_PAUSE_CONTINUE, and SERVICE_USER_DEFINED_CONTROL
//Можна створювати власні права і використовувати їх як показано в закоментованих рядках нижче
//Rights := STANDARD_RIGHTS_REQUIRED or SERVICE_START or SERVICE_STOP
// or SERVICE_QUERY_STATUS or SERVICE_PAUSE_CONTINUE or
// SERVICE_INTERROGATE;
// SERVICE_AUTO_START – відповідає за тип запуску сервісу Авто
hNewService := CreateService(hSCMgr,PChar(ServiceName),PChar(ServiceName),
STANDARD_RIGHTS_REQUIRED,SERVICE_WIN32_OWN_PROCESS,
SERVICE_AUTO_START,SERVICE_ERROR_NORMAL,
PChar(ExecutablePath),nil,nil,nil,nil,nil);
CloseServiceHandle(hSCMgr);
if (hNewService <> 0) then
FuncRetVal := true
else
FuncRetVal := false;
end;
CreateNTService := FuncRetVal;
end;
// ***
{Функцыя для видалення сервісу
// ServiceName – ім’я сервісу для видалення
//Результат:
// true – якщо операція завершена вдало
// false - якщо видалення не було виконано}
function DeleteNTService(ServiceName: String):boolean;
var
hServiceToDelete,hSCMgr: SC_HANDLE;
RetVal: LongBool;
FunctRetVal: Boolean;
begin
FunctRetVal := false;
hSCMgr := OpenSCManager(nil,nil,SC_MANAGER_CREATE_SERVICE);
if (hSCMgr <> 0 ) then
begin
hServiceToDelete := OpenService(hSCMgr, PChar(ServiceName), SERVICE_ALL_ACCESS);
RetVal := DeleteService(hServiceToDelete);
CloseServiceHandle(hSCMgr);
FunctRetVal := RetVal;
end;
DeleteNTService := FunctRetVal;
end;
{Інсталяція сервісу}
procedure TForm1.Button1Click(Sender: TObject);
var
tmps:string;
begin
// присвоєння імені сервісу
tmpS := 'CopyConfig';
// власне інсталяція з виводом повідомлення про успішність чи ні.
if (CreateNTService(GetCurrentdir+'\Service\Copycon.exe',tmpS)) then
MessageDlg('Service '+tmpS+' has been successfully created!',mtInformation,[mbOK],0)
else
MessageDlg('Unable to create service '+tmpS+' Win32 Error code: '+IntToStr(GetLastError),mtWarning,[mbOK],0);
// копіювання фалу конфігурації сервісу в корінь диску С
CopyFile(pchar(GetCurrentdir+'\Service\BackupConfig.ini'),'C:\BackupConfig.ini',true);
end;
{Деінсталяція сервісу}
procedure TForm1.Button2Click(Sender: TObject);
var
tmpS: String;
begin
tmpS := 'CopyConfig';
// деінсталяція сервісу з виводом повідомлення про результат
if (DeleteNTService(tmpS)) then
MessageDlg('Service '+tmpS+' has been successfully deleted!',mtInformation,[mbOK],0)
else
MessageDlg('Unable to delete service '+tmpS+' Win32 Error code: '+IntToStr(GetLastError),mtWarning,[mbOK],0);
//видалення файлу конфігурації сервісу з кореню диску С
if fileexists('C:\BackupConfig.ini') then
DeleteFile('C:\BackupConfig.ini');
end;
end.
Якщо використовувати мій код в тому вигляді в якому він є, то розміщення файлів має мати такий вигляд:
При обох варіантах інсталяції, після завершення сервіс буде не запущений. Для запуску потрібно або перезавантажитись, або через оснастку Service його запустити.
В принципі цей сервіс можна використовувати не тільки для копіювання файлів конфігурації Kerio, а й інших, потрібно просто задати відповідні настройки в BackupConfig.ini і при необхідності змінити розмірність масиву listfile, якщо файлів більше ніж 20.
При написанні сервісу я використовував матеріали розміщені на DelphiKingdom, HelloWorld.ru і в DRKB Explorer – домашня сторінка.
Початковий код, сервіс і його інсталятор можна взяти тут.
Немає коментарів:
Дописати коментар