The code of this module is written on the Internet. Here I spent a DLL with Delphi in the morning, I can expand various functions. [Code] {file name: Servicedll.dpr Overview: Replace by SVCHOST. A system service that Exe starts, the specific service is determined by the global variable serviceName.
After testing, the generated DLL file is completely normal. Test environment: Windows 2003 Server Delphi 7.0
The code only implements a framework, there is no actual action, just as a learning. If you use this code, any expansion and modification, I hope you can send me a code.
Date: 2005-04-01 Author: yanxizhen yanxizhen 163.com #}
Library servicedll;
Uses Sysutils, Classes, Winsvc, System, Windows
{Define global variable} var // service control information handle svcstatshandle: service_status_handle; // Storage Service status dwcurrstate: dword; // Service name serviceName: pchar = 'bits';
{Debug function, used to output debug text} Procedure OutputText (CH: PCHAR); var FileHandle: TextFile; f: integer; begin try if not fileexists ('zztestdll.txt') THEN F: = filecreate ('zztestdll.txt' Finally IF F> 0 THEN FILECLOSE (F); END;
Assignfile (FileHandle, 'zztestdll.txt'); append (filehandle); Writeln (FileHandle, CH); Flush (FileHandle); Closefile (FileHandle); END;
{DLL entry and export processing function} Procedure DLLENTRYPOINT (DWREASON: DWORD); Begin
Case dwreason of dll_process_attach:; dll_process_detach:; dll_thread_attach:; dll_thread_detach:;
Call Manager SCM and {} function TellSCM (dwState: DWORD; dwExitCode: DWORD; dwProgress: DWORD): LongBool; var srvStatus: service_status; BEGIN srvStatus.dwServiceType: = SERVICE_WIN32_SHARE_PROCESS; dwCurrState: = dwState; srvStatus.dwCurrentState: = dwState; srvStatus.dwControlsAccepted: = SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_PAUSE_CONTINUE or SERVICE_ACCEPT_SHUTDOWN; srvStatus.dwWin32ExitCode: = dwExitCode; srvStatus.dwServiceSpecificExitCode: = 0; srvStatus.dwCheckPoint: = dwProgress; srvStatus.dwWaitHint: = 3000; Result: = SetServiceStatus (SvcStatsHandle, srvStatus); END {Service Control Function} Procedure ServiceHandler (FDWControl: Integer); stdcall; begin
Case FDWControl of
Service_control_stop: Begin Tellscm (Service_stop_pending, 0, 1); Sleep (10); Tellscm (Service_Stopped, 0, 0); END;
Service_control_pause: begin tellscm (service_pause_pending, 0, 1); tellscm (service_paused, 0, 0);
Service_control_continue: Begin Tellscm (Service_Continue_pending, 0, 1); Tellscm (Service_Running, 0, 0); END;
Service_control_interrogate: tellscm (dwcurrstate, 0, 0); service_control_shutdown: tellscm (service_stopped, 0, 0);
END;
END;
{service main} Procedure ServiceMain (argc: pchar); stdcall; begin {tryness; begin {tryness; begin {tryness; begin {tryness; begin {tryness; begin {tryness; begin {tryness; begin {tryness; begin {tryness; begin {tryness; begin {tryness; begin {tryness; begin {tryness; begin {tryness; begin = strnew (pchampcname: = strnew (Pchamp (1))) Else Begin SVCName: = Stralloc (10 * sizeof (char)); svcname: = 'none'; end; outputtext (svccname); end finally strdispose; end;}
// Register Control Function SvcStatsHandle: = RegisterServiceCtrlHandler (ServiceName, @servicehandler); IF (SvcStatsHandle = 0) THEN BEGIN OutPutText ( 'Error in RegisterServiceCtrlHandler'); exit; END else begin FreeConsole (); end; // start service TellSCM ( Service_start_pending, 0, 1); Tellscm (Service_Running, 0, 0); OutputText ('Service is Running');
/ / Here you can perform our truly code while (DWCurrstate <> Service_Stop_pend) and (dwcurrstate <> service_stopped)) DO Begin Sleep (1000);
OutputText ('Service Exit'); END;
// Export function list exports servicemain;
{DLL entry point} begin dllproc: = @dllentrypoint; end.
[/ code]
