[?]使用CreateService函数出现的问题，谁能解答一下？！(100分)

piaosiy · 2006-03-24

// uses winSvc procedure TForm1.Button1Click(Sender: TObject); var  svc,svcmgr:SC_HANDLE; begin  svcmgr:=OpenSCManager('',nil,SC_MANAGER_CREATE_SERVICE);  if(svcmgr>0) then  begin    svc:=CreateService(                       svcmgr,                               Pchar('TEST8'),             Pchar('TEST8'),         SERVICE_ALL_ACCESS,                 SERVICE_WIN32_OWN_PROCESS,     SERVICE_AUTO_START,                 SERVICE_ERROR_IGNORE,               Pchar('D:/FileMove/SFMS.exe'),         nil,                               nil,                          nil,                               nil,                               nil);                         caption :=format('返回信息: %s [%d]',[SysErrorMessage(GetLastError),GetLastError]);  end;  CloseServiceHandle(svc);  CloseServiceHandle(svcmgr); end; ‘D:/FileMove/SFMS.exe’此文件是一个已写好的服务程序，执行上面的Button1Click事件后，将成功创建一个服务，但是Caption显示为“返回信息：重叠的I/O操作在进行中 [997]”，而且不管是在DOS状态下用 net start TEST8 命令还是在管理工具中服务里去启动该服务，均无法启动此服务，提示“在本地计算机无法启动TEST8服务  错误1053  服务并未及时响应启动或控制请求”，我在大富翁里搜了一下，有过此类甚至是同样的问题，但没有找到正确的解决办法，有谁有解决过这个问题的还请指点一下！

piaosiy · 2006-03-27

人呢，就没人能帮我解决吗？

超级牛X · 2006-03-27

scm := OpenSCManager( Nil, Nil, SC_MANAGER_CONNECT ); svc := OpenService( scm, PChar( aServiceName ), SERVICE_ALL_ACCESS );   svc:=CreateService(                       svcmgr,                               Pchar('TEST8'),             Pchar('TEST8'),         SERVICE_ALL_ACCESS,                 SERVICE_WIN32_OWN_PROCESS,     SERVICE_AUTO_START,                 SERVICE_ERROR_IGNORE,               Pchar('D:/FileMove/SFMS.exe'),         nil,                               nil,                          nil,                               nil,                               nil);                       CloseServiceHandle( svc ); CloseServiceHandle( scm );

piaosiy · 2006-03-27

超级牛X:    svc := OpenService( scm, PChar( aServiceName ), SERVICE_ALL_ACCESS ); 这一句里的aServiceName是什么？服务名？这个服务还没有创建啊。 那个CreateService函数后第一个参数是SCM吧？ 我把PChar( aServiceName )改成PChar( 'TEST8' )后运行连服务都没有创建出来了啊？我开始的那个还能创建，只是没法启动。这是什么原因，或者我哪里错了？？

hsgrass · 2006-03-28

參考: C:/Program Files/Borland/Delphi7/Source/Vcl/ScktSrvr.dpr 它可以通過命令行啟動和刪除服務(service)

piaosiy · 2006-03-28

看过了,我现在的问题是用CREATESERVICE创建的服务没办法启动,前面我也说过"不管是在DOS状态下用 net start TEST8 命令还是在管理工具中服务里去启动该服务，均无法启动此服务",在程序中用STARTSERVICE也同样启动不了.

hsgrass · 2006-03-28

我用你的過程將程序名称改为scktsrvr.exe,错误提示也是I/O... 再通服务管理器,启动该服务正常, 所以,我觉得 1.服务程序可能有问题 2.这个创建服务的代码也不正确. // 這是afxrootkit的代碼, delphibox procedure InstallService(ServiceName, DisplayName: pchar; FileName: string); var  SCManager: SC_HANDLE;  Service: SC_HANDLE;  Args: pchar; begin  SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);  if SCManager = 0 then Exit;  try    Service := CreateService(SCManager, ServiceName, DisplayName, SERVICE_ALL_ACCESS, SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS, SERVICE_AUTO_START, SERVICE_ERROR_IGNORE, pchar(FileName), nil, nil, nil, nil, nil);    Args := nil;    StartService(Service, 0, Args);    CloseServiceHandle(Service);  finally    CloseServiceHandle(SCManager);  end; end;

piaosiy · 2006-03-28

hsgrass:    你确定通过服务管理器,启动该服务正常吗?我这里不管通过什么方式启动都是启动不了,通过服务管理器启动该服务会出错,状态显示为"启动中"然后无法启动,停止,暂停,继续,四个按钮全变成了灰色. 我用你给的程序试了一下,还是不行,以下是我的调用事件. procedure TForm1.Button3Click(Sender: TObject); var  SN,DN,FN:string; begin  SN:='Test';  DN:='Test';  FN:='E:/lhw/FileMove/FileMoveServer.exe';  InstallService(Pchar(SN),Pchar(DN),FN); end; 可以确定的是,我的服务程序没有问题,刚刚我还用FileMoveServer /install 和net start FileMoveServer试过了,然后也可以正常启动,停止,暂停,继续.

hsgrass · 2006-03-28

// 下面的代碼可以增加服務,刪除服務,在我的w2k+sp4 // 在DELPHI運行程式,安裝服務後,程式沒反應, 要退出那個scktsrvr.exe才可以使主界面有反应. var  status: TServiceStatus;  Stopped, Paused: boolean;  StatusHandle: thandle; procedure InstallService(ServiceName, DisplayName: pchar; FileName: string); var  SCManager: SC_HANDLE;  Service: SC_HANDLE;  Args: pchar; begin  SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);  if SCManager = 0 then Exit;  try    Service := CreateService(SCManager, ServiceName, DisplayName, SERVICE_ALL_ACCESS, SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS, SERVICE_AUTO_START, SERVICE_ERROR_IGNORE, pchar(FileName), nil, nil, nil, nil, nil);    Args := nil;    StartService(Service, 0, Args);    CloseServiceHandle(Service);  finally    CloseServiceHandle(SCManager);  end; end; procedure UninstallService(ServiceName: pchar); var  SCManager: SC_HANDLE;  Service: SC_HANDLE; begin  SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);  if SCManager = 0 then Exit;  try    Service := OpenService(SCManager, ServiceName, SERVICE_ALL_ACCESS);    ControlService(Service, SERVICE_CONTROL_STOP, Status);    DeleteService(Service);    CloseServiceHandle(Service);  finally    CloseServiceHandle(SCManager);  end; end; procedure ServiceCtrlHandler(Control: dword); stdcall; begin  case Control of    SERVICE_CONTROL_STOP:      begin        Stopped := True;        Status.dwCurrentState := SERVICE_STOP_PENDING;        SetServiceStatus(StatusHandle, Status);      end;    SERVICE_CONTROL_PAUSE:      begin        Paused := True;        Status.dwcurrentstate := SERVICE_PAUSED;        SetServiceStatus(StatusHandle, Status);      end;    SERVICE_CONTROL_CONTINUE:      begin        Paused := False;        Status.dwCurrentState := SERVICE_RUNNING;        SetServiceStatus(StatusHandle, Status);      end;    SERVICE_CONTROL_INTERROGATE: SetServiceStatus(StatusHandle, Status);    SERVICE_CONTROL_SHUTDOWN: Stopped := True;  end; end; procedure TForm1.btn1Click(Sender: TObject); const  srv = 'c:/Program Files/Borland/Delphi7/Source/vcl/scktsrvr.exe'; begin //  UninstallService('test1'); //  UninstallService('test8');  UninstallService('test2');  InstallService('test2', 'test22', srv); end;

piaosiy · 2006-03-29

hsgrass:    我系统也是w2k+sp4    不过安裝服務後,程序可以关掉,关掉后scktsrvr.exe这个服务也会自动关闭.    不知道你安装服务后有没有打开“管理工具”中的“服务”查看过这个服务的状态？我查看了一下，它的状态为“启动”而正常启动的服务为“已启动”，也就是说这个服务没有启动成功，你安装完服务后（就用你说的这个scktsrvr.exe），你等上几分钟，再把鼠标移动到它在托盘区上它的托盘上面，它会自动消失，当然，它的进程也没有了。请指教！

hsgrass · 2006-03-30

// 如果從delphi的工程裏面新建一個服務prj編譯後,可以在命令行直接啟動的. C:/Program Files/Borland/Delphi7/Projects>project2.exe /install C:/Program Files/Borland/Delphi7/Projects>net start service2 Service2 服務正在啟動 . Service2 服務已經啟動成功。 C:/Program Files/Borland/Delphi7/Projects>net stop service2 Service2 服務已經成功停止。 C:/Program Files/Borland/Delphi7/Projects>project2.exe /uninstall SvcMgr.pas /////////////這是它的安裝與刪除代碼 procedure TServiceApplication.Run;  function FindSwitch(const Switch: string): Boolean;  begin    Result := FindCmdLineSwitch(Switch, ['-', '/'], True);  end; var  ServiceStartTable: TServiceTableEntryArray;  ServiceCount, i, J: Integer;  StartThread: TServiceStartThread; begin  AddExitProc(DoneServiceApplication);  if FindSwitch('INSTALL') then    RegisterServices(True, FindSwitch('SILENT'))  else if FindSwitch('UNINSTALL') then    RegisterServices(False, FindSwitch('SILENT')) ------------------------------ procedure TServiceApplication.RegisterServices(Install, Silent: Boolean);  procedure InstallService(Service: TService; SvcMgr: Integer);  procedure UninstallService(Service: TService; SvcMgr: Integer); begin ... end; 所以有兩種方式可以選擇, 1, 從命令行啟動, 2.使用api 下星期看看有沒有時間再搞啦, 明天開會,還有事沒做完, 不好意思.

piaosiy · 2006-03-30

命令行方式操作我也知道，我之所以要用程序来实现是因为命令行方式安装/反安装服务时会弹出一个Messagebox，如果有多个安装/反安装时会比较烦，所以才需要用程序实现。  先谢谢你了，你有事的话你先忙吧，有空了麻烦你再帮我看看。

hsgrass · 2006-03-30

'SILENT' 參數是不顯示提示框

piaosiy · 2006-03-30

嗯，好的，谢谢，我试试

piaosiy · 2006-04-04

先把贴结了吧，这两天暂时没时间搞这个东西了，hsgrass你能给我留个EMail或其它联系方式么？

hsgrass · 2006-04-04

msn/email: hsgrass#hotmail.com 上班時間

[?]使用CreateService函数出现的问题，谁能解答一下？！(100分)

piaosiy

Unregistered / Unconfirmed

piaosiy

Unregistered / Unconfirmed

超级牛X

Unregistered / Unconfirmed

piaosiy

Unregistered / Unconfirmed

hsgrass

Unregistered / Unconfirmed

piaosiy

Unregistered / Unconfirmed

hsgrass

Unregistered / Unconfirmed

piaosiy

Unregistered / Unconfirmed

hsgrass

Unregistered / Unconfirmed

piaosiy

Unregistered / Unconfirmed

hsgrass

Unregistered / Unconfirmed

piaosiy

Unregistered / Unconfirmed

hsgrass

Unregistered / Unconfirmed

piaosiy

Unregistered / Unconfirmed

piaosiy

Unregistered / Unconfirmed

hsgrass

Unregistered / Unconfirmed

Similar threads