svchost服务的编写

ActiveX   DLL不行，要写成标准的API   DLL才行，要导出一个函数ServiceMain;

以下为一段DELPHI的代码
{   文件名:   ServiceDll.dpr
    概述:       替换由svchost.exe启动的某个系统服务,具体服务由全局变量   ServiceName   决定.

                    经测试,生成的DLL文件运行完全正常.
                    测试环境:   Windows   2003   Server   +   Delphi   7.0}

library   ServiceDll;

uses
    SysUtils,
    Classes,
    winsvc,
    System,
    Windows;

{   定义全局变量   }
var
    SvcStatsHandle:   SERVICE_STATUS_HANDLE;   //   服务控制信息句柄
    dwCurrState:   DWORD;   //   存储服务状态
    ServiceName:   PChar   =   'BITS ';   //   服务名称

{   调试函数,用于输出调试文本   }
procedure   OutPutText(CH:   PChar);
var
    FileHandle:   TextFile;
    FF:   Integer;
begin
    try
        if   not   FileExists( 'zztestdll.txt ')   then
            FF   :=   FileCreate( 'zztestdll.txt ');
    finally
        if   FF   >   0   then   FileClose(FF);
    end;

    AssignFile(FileHandle,   'zztestdll.txt ');
    Append(FileHandle);
    Writeln(FileHandle,   CH);
    Flush(FileHandle);
    CloseFile(FileHandle);
end;


{   dll入口和出口处理函数   }
procedure   DLLEntryPoint(dwReason:   DWORD);
begin
    case   dwReason   of
        DLL_PROCESS_ATTACH:
            ;
        DLL_PROCESS_DETACH:
            ;
        DLL_THREAD_ATTACH:
            ;
        DLL_THREAD_DETACH:
            ;
    end;
end;

{   与SCM管理器通话   }
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   控制函数   }
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);
            end;

        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:   Integer;   var   argv:   PChar);   stdcall;
begin
    //   注册控制函数
    SvcStatsHandle   :=   RegisterServiceCtrlHandler(ServiceName,   @servicehandler);
    if   (SvcStatsHandle   =   0)   then
    begin
        OutPutText( 'Error   in   RegisterServiceCtrlHandler ');
        Exit;
    end   else   FreeConsole();

    //   启动服务
    TellSCM(SERVICE_START_PENDING,   0,   1);
    TellSCM(SERVICE_RUNNING,   0,   0);
    OutPutText( 'Service   is   Running ');

    //   这里可以执行我们真正要作的代码
    while   ((dwCurrState   <>   SERVICE_STOP_PENDING)   and   (dwCurrState   <>   SERVICE_STOPPED))   do
    begin
        Sleep(1000);
    end;

    OutPutText( 'Service   Exit ');

end;


//   导出函数列表
exports
    ServiceMain;

{   dll入口点   }
begin
    DllProc   :=   @DLLEntryPoint;
end.