Новичок
Профиль
Группа: Участник
Сообщений: 3
Регистрация: 8.9.2010
Репутация: нет
Всего: нет
|
Здравствуйте! Помогите пожалуйста разобраться с проблемой. Написал службу, которая данные от подключенных клиентов и записывает эти данные в файл. Пример службы взял http://bugtraq.ru/forum/faq/programming/services.html. Служба запускается, работает, но не останавливается. При остановке из оснастки "Управление компьютером" - "Службы" долго пытается остановиться и в итоге выдается сообщение: "Не удалось остановить службу.... Ошибка 1053: Служба не ответила на запрос своевременно" В чем проблема никак не могу понять. Ниже привожу код: | Код |
program gps_srv_api;
{$APPTYPE CONSOLE}
uses
Windows,
WinSvc,
WinSock,
SysUtils;
const
ServicesCount = 1;
ServiceName = 'SimpleReceiver';
DisplayName = 'Simple Receiver';
ServiceType = SERVICE_WIN32_OWN_PROCESS;
ServiceDescription = 'Simple Receiver Description';
DefaultPort: Cardinal = 11135;
log_file: string = 'C:\gps_log.txt';
var
ServThrHndl: THandle = 0;
StopEvent: THandle = 0;
aServHndl: DWORD = 0;
aServStatus: SERVICE_STATUS;
crit: RTL_CRITICAL_SECTION;
wsadat: TWSAData;
Socket: TSocket;
local_addr: sockaddr_in;
ClientsCount: Integer = 0;
function SysErrorMessage(ErrorCode: Integer): string;
var
Len: Integer;
Buffer: array[0..255] of Char;
begin
Len := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY,
nil, ErrorCode, 0, Buffer, SizeOf(Buffer), nil);
while (Len > 0) and (Buffer[Len - 1] in [#0..#32]) do Dec(Len);
SetString(Result, Buffer, Len);
UniqueString(Result);
AnsiToOem(PChar(Result), PChar(Result));
if Result <> '' then
Result := IntToStr(ErrorCode) + ' ' + Result;
end;
procedure ShowInfo;
begin
Writeln;
WriteLn('Simple Receiver');
end;
procedure ProcessStartupParams; // реакция на install/uninstall
//устанавливает описание службы
function SetServiceDescription(ASHndl: THandle; aDesc: string): BOOL;
const SERVICE_CONFIG_DESCRIPTION: DWORD = 1;
var
DynChangeServiceConfig2: function(hService: SC_HANDLE;
dwInfoLevel: DWORD;
lpInfo: Pointer): BOOL; stdcall;
aLibHndl: THandle;
TempP: PChar;
begin
aLibHndl := GetModuleHandle(advapi32);
Result := aLibHndl <> 0;
if not Result then Exit;
DynChangeServiceConfig2 := GetProcAddress(aLibHndl, 'ChangeServiceConfig2A');
Result := @DynChangeServiceConfig2 <> nil;
if not Result then Exit;
TempP := PChar(aDesc);
Result := DynChangeServiceConfig2(ASHndl, SERVICE_CONFIG_DESCRIPTION, @TempP);
end;
type
TToDo = (tdError, tdInstall, tdUninstall);
TToDo_s = set of TToDo;
const
ParamStrings: array[tdInstall..tdUninstall] of string = ('install', 'uninstall');
//------------------------------------------------------------------------------
function MapParam(aParam: string): TToDo; // узнаем что надо
var
J: TToDo;
TempStr: string;
begin
Result := tdError;
TempStr := aParam;
if TempStr[1] in ['/', '-'] then
TempStr := Copy(TempStr, 2, Length(TempStr) - 1);
UniqueString(TempStr);
CharLower(PChar(TempStr));
for J := Low(ParamStrings) to High(ParamStrings) do
if ParamStrings[j] = TempStr then begin
Result := J;
Exit;
end;
end;
var
J: Integer;
scHndl, sHndl: THandle;
aStatus: TServiceStatus;
toDo: TToDo_s;
begin
toDo := [];
for J := 1 to ParamCount do begin
Include(toDo, MapParam(ParamStr(J)));
if tdError in toDo then begin
ExitCode := ERROR_INVALID_PARAMETER;
writeLN('Unknown parametr - ' + ParamStr(J) + '. RTFM, please ...');
Exit;
end;
end;
if [tdInstall, tdUninstall] <= toDo then begin
ExitCode := ERROR_INVALID_PARAMETER;
Writeln('Error: you can not install and uninstall service simultaniosly. Check params.');
Exit;
end;
if tdInstall in toDo then begin // устанавливаем сервис
write('Connecting to Service Control Manager ...');
scHndl := OpenSCManager(nil, nil, SC_MANAGER_CREATE_SERVICE);
if scHndl = 0 then begin
ExitCode := GetLastError;
writeln('Fail!');
Writeln('Error: ', SysErrorMessage(ExitCode));
Exit;
end;
try
Writeln('OK');
write('Creating service database record ...');
sHndl := CreateService(scHndl, ServiceName, DisplayName,
SERVICE_QUERY_CONFIG or SERVICE_CHANGE_CONFIG,
ServiceType, SERVICE_DEMAND_START,
SERVICE_ERROR_NORMAL, PChar(ParamStr(0)),
nil, nil, nil,nil,nil);
if sHndl = 0 then begin
ExitCode := GetLastError;
Writeln('Failed!');
Writeln('Error: ', SysErrorMessage(ExitCode));
Exit;
end;
try
Writeln('Ok');
if ServiceDescription <> '' then begin
write('Setting service description...');
if not SetServiceDescription(sHndl, ServiceDescription) then begin
writeln('Failed!');
Writeln('Warning: ', SysErrorMessage(GetLastError));
WriteLn('Warning: SetServiceDesc() failed, but service is installed!');
end else
Writeln('OK');
end;
finally
CloseServiceHandle(sHndl);
end;
finally
CloseServiceHandle(scHndl);
end;
Writeln('Service "', DisplayName, '" install success.');
end;
if tdUninstall in toDo then begin // удаляем
write ('Connecting Service Control Manager...');
scHndl := OpenSCManager(nil, nil, GENERIC_EXECUTE);
if scHndl= 0 then begin
ExitCode := GetLastError;
WriteLn('Failed!');
WriteLn('Error: ', SysErrorMessage(ExitCode));
Exit;
end;
try
Writeln('OK');
Write('Opening and Quering Service...');
sHndl := OpenService(SCHndl, ServiceName,
STANDARD_RIGHTS_REQUIRED Or
SERVICE_QUERY_STATUS Or SERVICE_STOP);
if sHndl = 0 then begin
ExitCode := GetLastError;
WriteLn('Failed!');
WriteLn('Error: ', SysErrorMessage(ExitCode));
Exit;
end;
try
if not QueryServiceStatus(sHndl, aStatus) then begin
ExitCode := GetLastError;
WriteLn('Failed!'); WriteLn('Error: ', SysErrorMessage(ExitCode));
Exit;
end;
Writeln('OK');
if aStatus.dwCurrentState <> SERVICE_STOPPED then begin
write('Service is running, wait until stopped ...');
if not ControlService(sHndl, SERVICE_CONTROL_STOP, aStatus) then begin
ExitCode := GetLastError;
WriteLn('Failed!');
WriteLn('Error: ', SysErrorMessage(ExitCode));
Exit;
end;
while aStatus.dwCurrentState <> SERVICE_STOPPED do begin
Sleep(250);
write('.');
if not QueryServiceStatus(sHndl, aStatus) then begin
ExitCode := GetLastError;
WriteLn('Failed!');
WriteLn('Error: ', SysErrorMessage(ExitCode));
Exit;
end;
end;
Writeln('Stopped');
end;
write('Deleting service...');
if not DeleteService(sHndl) then begin
ExitCode := GetLastError;
WriteLn('Failed!');
WriteLn('Error: ', SysErrorMessage(ExitCode));
Exit;
end;
Writeln('OK');
finally
CloseServiceHandle(sHndl);
end;
finally
CloseServiceHandle(scHndl);
end;
Writeln('Service uninstall success.');
end;
end;
//------------------------------------------------------------------------------
function SetState(aState: DWORD): DWORD;
begin
aServStatus.dwCurrentState := aState;
if aServHndl <> 0 then
SetServiceStatus(aServHndl, aServStatus);
Result := aServStatus.dwCurrentState;
end;
//------------------------------------------------------------------------------
procedure ServiceHandler(fdwControl: DWORD); stdcall;
begin
case fdwControl of
SERVICE_CONTROL_STOP:
begin
SetState(SERVICE_STOP_PENDING);
SetEvent(StopEvent);
//Если сервис был в паузе, то рабочий поток надо возобновить
ResumeThread(ServThrHndl);
end;
SERVICE_CONTROL_PAUSE:
begin
SetState(SERVICE_PAUSE_PENDING);
SuspendThread(ServThrHndl);
SetState(SERVICE_PAUSED);
end;
SERVICE_CONTROL_CONTINUE:
begin
SetState(SERVICE_CONTINUE_PENDING);
ResumeThread(ServThrHndl);
SetState(SERVICE_RUNNING);
end;
SERVICE_INTERROGATE:
begin
//Говорим SCM о том, в каком состоянии находится наша служба
SetState(aServStatus.dwCurrentState);
end;
129..255:
begin
SuspendThread(ServThrHndl);
Windows.Beep(1000, 500);
//Возвращать результаты можно вызовом SetServiceStatus().
aServStatus.dwWin32ExitCode := ERROR_SUCCESS;
SetState(aServStatus.dwCurrentState);
ResumeThread(ServThrHndl);
end;
end; {case}
end;
procedure PutDataToFile(_data: string);
var
F: TextFile;
begin
if Trim(_data) <> EmptyStr then begin
EnterCriticalSection(crit);
AssignFile(F, log_file);
Append(F);
WriteLn(F, _data);
CloseFile(F);
LeaveCriticalSection(crit);
end;
end;
function ClientThread(client_socket: TSocket): DWord; stdcall;
var
sock: TSocket;
buff: array[0..1024] of Char;
bytes_resv: Integer;
log_message: string;
D: TClientData;
begin
sock := client_socket;
repeat
bytes_resv := recv(sock, buff, 1024, 0);
log_message := IntToStr(sock) + ' -> ' + buff;
PutDataToFile(log_message);
if bytes_resv = 0 then Break;
until False;
log_message := IntToStr(sock) + ' -> Disconnect';
PutDataToFile(log_message);
closesocket(sock);
ExitThread(0);
end;
function StartServer: Boolean;
var
lm: string;
begin
Result := False;
PutDataToFile('GPS Server running');
if WSAStartup($0202, wsadat) <> 0 then begin
lm := 'WSAStartup Error #' + IntToStr(WSAGetLastError);
PutDataToFile(lm);
Exit;
end;
PutDataToFile('WSAStartup - OK');
//создание сокета
Socket := WinSock.socket(AF_INET, SOCK_STREAM, 0); // IPPROTO_TCP);
if Socket < 0 then begin
lm := 'socket error #' + IntToStr(WSAGetLastError);
PutDataToFile(lm);
Exit;
end;
PutDataToFile('Socket Init - OK');
// связывание сокета с локальным адресом
local_addr.sin_family := AF_INET;
local_addr.sin_port := htons(DefaultPort);
local_addr.sin_addr.S_addr := INADDR_ANY; // 0;
if Bind(Socket, local_addr, SizeOf(local_addr)) <> 0 then begin
lm := 'Bind error #' + IntToStr(WSAGetLastError);
PutDataToFile(lm);
Exit;
end;
PutDataToFile('Socket binding - OK');
// ожидание подключений
if listen(Socket, $100) <> 0 then begin
lm := 'Socket error #' + IntToStr(WSAGetLastError);
PutDataToFile(lm);
Exit;
end;
PutDataToFile('Waiting for connection ...');
Result := True;
end;
procedure MainServiceProc(dwArgc: DWORD; lpszArgv: Pointer); stdcall;
var
client_socket: TSocket;
client_addr: sockaddr_in;
client_addr_size: Integer;
client_ip: PChar;
thId: DWORD;
begin
aServHndl := RegisterServiceCtrlHandler(ServiceName, @ServiceHandler);
if aServHndl = 0 then begin
ExitCode := GetLastError;
Exit;
end;
ZeroMemory(@aServStatus, SizeOf(aServStatus));
aServStatus.dwServiceType := ServiceType;
aServStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP or
SERVICE_ACCEPT_PAUSE_CONTINUE;
//подсказка для небыстрых служб о том, как долго она реагирует на команды
//aServStatus.dwWaitHint := 500;
//Сообщаем SCM, что начинается старт службы...
SetState(SERVICE_START_PENDING);
//Пошла процедура инициализации...
// получаем реальный дескриптор потока службы
if not DuplicateHandle(GetCurrentProcess,
GetCurrentThread,
GetCurrentProcess,
@ServThrHndl, 0, False, DUPLICATE_SAME_ACCESS) then begin
aServStatus.dwWin32ExitCode := GetLastError;
SetState(SERVICE_STOPPED);
Exit;
end;
// создаем unnamed event для остановки службы по сигналу из Handler...
StopEvent := CreateEvent(nil, True, False,nil);
if StopEvent = 0 then begin
aServStatus.dwWin32ExitCode := GetLastError;
SetState(SERVICE_STOPPED);
Exit;
end;
if StartServer then begin // создаем сервер
SetState(SERVICE_RUNNING); // все ОК работаем
client_addr_size := SizeOf(client_addr);
//Крутим цикл, если срабатывает event - выходим...
while WaitForSingleObject(StopEvent, 500) = WAIT_TIMEOUT do begin
client_socket := accept(Socket, @client_addr, @client_addr_size);
if client_socket <> INVALID_SOCKET then begin
Inc(ClientsCount);
client_ip := inet_ntoa(client_addr.sin_addr);
PutDataToFile('Client connect. IP: ' + client_ip);
thId := CreateThread(nil, 0, @ClientThread, Pointer(client_socket), 0, thId);
CloseHandle(thId);
end;
end;
end;
// останавливаем сервер
PutDataToFile('Sock close');
closesocket(Socket);
PutDataToFile('cleanup');
WSACleanup;
PutDataToFile('gps server terminate');
//Выполняем остановку сервиса, вычищаемся...
CloseHandle(ServThrHndl);
ServThrHndl := 0;
CloseHandle(StopEvent);
StopEvent := 0;
SetState(SERVICE_STOPPED); //Извещаем, SCM, что работа службы остановлена...
//Поток ЭТОЙ службы завершил свою работу.
end;
var
ServTableEntryArray: array[0..ServicesCount] of TServiceTableEntryA;
FHndl: Integer;
begin
// старт проги
if ParamCount > 0 then begin // что то надо делать
ShowInfo;
ProcessStartupParams; // получаем что надо и делаем
Exit;
end;
ZeroMemory(@ServTableEntryArray, SizeOf(ServTableEntryArray));
ServTableEntryArray[0].lpServiceName := ServiceName;
ServTableEntryArray[0].lpServiceProc := @MainServiceProc;
InitializeCriticalSection(crit);
// создаем файл
if not FileExists(log_file) then begin
FHndl := FileCreate(log_file);
FileClose(FHndl);
end;
if not StartServiceCtrlDispatcher(ServTableEntryArray[0]) then begin
ExitCode := GetLastError;
ShowInfo;
WriteLn('Error: ', SysErrorMessage(ExitCode));
WriteLn('This program is Windows NT Service, so it CAN NOT be run from command prompt.');
WriteLn('You can install it with "/install" parameter.');
WriteLn('If this service is already installed, you can run it with "net start" command.');
end;
DeleteCriticalSection(crit);
//Процесс службы завершает работу, всем до свидания...
//Если вы разместили в своём *.exe несколько служб, то здесь
//вы окажетесь только после остановки ВСЕХ служб процесса.
end.
|
Бубу рад любой помощи. Спасибо за помощь. Это сообщение отредактировал(а) mbegma - 25.10.2010, 15:57 |
Winsock server в виде службы Windows, Помогите разобраться 
Загрузка ...
