打开Delphi编辑器,选择菜单中的File|New,在New Item中选择Service Application项,Delphi便自动为你建立一个基于TServiceApplication的新工程,TServiceApplication是一个封装NT服务程序的类,它包含一个TService1对象以及服务程序的装卸、注册、取消方法。
将TService1对象的属性做下列更改:
DisplayName与Name改为:DataBackup,ServiceStartName属性改为系统管理员用户(如DOMAIN\Administrator)和Password则输入用户密码
这样,服务程序运行时将自己以该用户的权限 *** 作NT。
这样,一个NT服务程序编写已经完成,在Delphi编辑器中选择菜单Run|Parameters,在Parameters中输入/install,程序编译运行后,一个名为DataBackup的NT服务程序已经安装好,你可以双击控制面板中的服务项目,将会看到此服务程序,只是此服务程序没有任何东西而已;在Delphi编辑器中选择菜单Run|Parameters,在Parameters中输入/uninstall,程序编译运行后,系统将会将此服务程序卸掉。
服务程序是通过控制一个线程的生成、暂停、继续、停止来达到服务目的的,因此我们必须加入一个TSession对象来编写文件自动备份代码,在Delphi编辑器中选择菜单中的File|New,在New Item中选择Thread Object项,Delphi会提示你为该TSession对象输入一个名称(输入DataCopy),Delphi便生成了一个基于TSession的DataCopy对象,并提供了一个Execute过程供重载,我们要Execute过程中输入以下程序:
var
Hour, Min, Sec, MSec: Word
TimeStamp, DirectoryEdit1, DirectoryEdit2: String
SearchRec: TSearchRec
Source, Temp, Dest: Pchar
F, F1: THandle
FF, FF1: WIN32_FIND_DATA
Begin
// 每次文件备份执行时间
TimeStamp:= '12:00'
// 文件备份源目录
DirectoryEdit1:= 'C:\temp'
// 文件备份目录
DirectoryEdit2:= 'C:\temp1'
While True do
Begin
DecodeTime(Time, Hour, Min, Sec, MSec)
IF Trim(TimeStamp) = Format('%-2.2d:%-2.2d',[Hour, Min]) then
Begin
GetMem(Source, 250)
GetMem(Dest, 250)
GetMem(Temp, 250)
StrPcopy(Dest, DirectoryEdit2 + '\' + FormatDateTime('YYYYMMDD', Date))
CreateDirectory(Dest, Nil)
IF FindFirst(DirectoryEdit1 + '\*.*', faAnyFile, SearchRec) = 0 then
Begin
Repeat
StrPcopy(Source, DirectoryEdit1 + '\' + SearchRec.Name)
StrPcopy(Dest, DirectoryEdit2+'\' + FormatDateTime('YYYYMMDD', Date) + '\' + SearchRec.Name)
CopyFile(Source, Dest, False)
Until FindNext(SearchRec) <>0
end
SysUtils.FindClose(SearchRec)
FindClose(F)
FreeMem(Source, 250)
FreeMem(Dest, 250)
FreeMem(Temp, 250)
end
Sleep(60000)
end
end
此线程执行时每隔一分钟将检查一次时间,看是否到了备份时间,如果是则将DirectoryEdit1中的所有文件拷到DirectoryEdit2目录中去。
现在编写服务控制DataCopy线程的代码,在TdataBackup对象中的OnStart、OnStop、OnPause、OnContinue事件中分别输入如下代码:
Procedure TDataBackup.DataBackupStart(Sender: TService
var Started: Boolean)
begin
DataThread:= TDataCopy.Create(False)
Started := True
end
procedure TDataBackup.DataBackupStop(Sender: TService
var Stopped: Boolean)
begin
DataThread.Terminate
Stopped := True
end
procedure TDataBackup.DataBackupPause(Sender: TService
var Paused: Boolean)
begin
DataThread.Suspend
Paused := True
end
procedure TDataBackup.DataBackupContinue(Sender: TService
var Continued: Boolean)
begin
DataThread.Resume
Continued := True
end
这样一个文件自动备份程序已经完成,编译好后,加上/install参数执行程序,系统会将此服务程序安装,由于服务程序中StartType属性为stAuto,NT每次启动时,此程序自动执行,你可以在控制面板中的服务项目来启动、暂停、恢复、停止它,也可以加上/uninstall参数执行程序来卸掉它。通过上述例子我们可以看到,用Delphi编写NT服务器程序十分方便,而且你也可以在TService对象上加许多非可视化控件来与数据库关联,实现很多复杂的功能。
试编写代码如下:
procedure TForm1.Button1Click(Sender: TObject)var total: Double
begin
total := StrToFloat(edtPrice1.Text) * StrToInt(edtNum1.Text) +
StrToFloat(edtPrice2.Text) * StrToInt(edtNum2.Text) +
StrToFloat(edtPrice3.Text) * StrToInt(edtNum3.Text)
ShowMessage('共计 ' + FloatToStr(total) + ' 元。')
end
procedure TForm1.edtPrice1KeyPress(Sender: TObject var Key: Char)
begin
if not (Key in ['0'..'9','.']) then
Key := #0
end
procedure TForm1.edtNum1KeyPress(Sender: TObject var Key: Char)
begin
if not (Key in ['0'..'9']) then
Key := #0
end
运行效果截图如下:
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)