cann't read registry by my service application? |
尚未結案
|
hm888k
一般會員 發表:1 回覆:0 積分:0 註冊:2005-05-20 發送簡訊給我 |
program Getregsrv; uses
SvcMgr,
UGetregsrv in 'UGetregsrv.pas' {GetRegS: TService},
CreateProcessIntr in 'CreateProcessIntr.pas'; {$R *.RES} begin
Application.Initialize;
Application.CreateForm(TGetRegS, GetRegS);
Application.Run;
end. unit UGetregsrv; interface uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
ExtCtrls,Registry,CreateProcessIntr; type
TGetRegS = class(TService)
tmr1: TTimer;
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServicePause(Sender: TService; var Paused: Boolean);
procedure ServiceExecute(Sender: TService);
procedure tmr1Timer(Sender: TObject);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;
procedure TextFileAppend(filename,context:String;Flag: Integer=0);
function GetRegistryValue(aitem:string): string;
var
GetRegS: TGetRegS; implementation {$R *.DFM} procedure ServiceController(CtrlCode: DWord); stdcall;
begin
GetRegS.Controller(CtrlCode);
end; function TGetRegS.GetServiceController: TServiceController;
begin
Result := ServiceController;
end; procedure TGetRegS.ServiceStart(Sender: TService; var Started: Boolean);
begin
TextFileAppend('c:\GetRegSLog.txt','');
Started:=true;
end; procedure TGetRegS.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
Stopped:=true;
end; procedure TGetRegS.ServicePause(Sender: TService; var Paused: Boolean);
begin
Paused:=true;
end; procedure TGetRegS.ServiceExecute(Sender: TService);
begin
tmr1.Enabled:=true;
while not terminated do ServiceThread.ProcessRequests(True);
end; procedure TGetRegS.tmr1Timer(Sender: TObject);
begin
TextFileAppend('c:\GetRegSLog.txt',GetRegistryValue('user'));
TextFileAppend('c:\GetRegSLog.txt',GetRegistryValue('pass'));
TextFileAppend('c:\GetRegSLog.txt',GetRegistryValue('service'));
end;
function GetRegistryValue(aitem:string): string;
var Reg: TRegistry;
begin
Reg := TRegistry.Create(KEY_READ);
Reg.RootKey:=HKEY_CURRENT_USER;
try
if Reg.OpenKeyReadOnly('Software\OracleBackupManager') then
Result :=Reg.ReadString(aitem);
// Reg.CloseKey;
finally
Reg.Free;
end;
end;
procedure TextFileAppend(filename,context:String;Flag: Integer=0);
var F: TextFile;
begin
try
if not fileexists(filename) then
FileClose(FileCreate(filename))
else
begin
AssignFile(F,filename);
if Flag = 0 then Append(F) else Rewrite(F);
Writeln(F, context);
CloseFile(F);
end;
except
showmessage('不能写入文件');
abort;
end;
end; end.
|
pcboy
版主 發表:177 回覆:1838 積分:1463 註冊:2004-01-13 發送簡訊給我 |
PO程式碼的方式請參考版規說明,煩請修改謝謝您的配合
http://delphi.ktop.com.tw/topic.php?TOPIC_ID=58991 程式碼可否抽出修改成一小段 "獨立" 的程式碼 ?
起碼可以 compile 和 debug , 看看問題在哪
單靠眼力 和 腦力 除錯很累 *********************
如果您滿意答案,請結案
*********************
------
能力不足,求助於人;有能力時,幫幫別人;如果您滿意答覆,請適時結案! 子曰:問有三種,不懂則問,雖懂有疑則問,雖懂而想知更多則問! |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |