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 , 看看問題在哪
單靠眼力 和 腦力 除錯很累 *********************
如果您滿意答案,請結案
*********************
------
能力不足，求助於人；有能力時，幫幫別人；如果您滿意答覆，請適時結案！ 子曰：問有三種，不懂則問，雖懂有疑則問，雖懂而想知更多則問！ |
發表時間：2005-05-30 16:29:34
IP:218.28.xxx.xxx 未訂閱
系統時間：2024-05-17 20:08:10
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |