проблема с сервисом...
Собственно вот сам сервис в урезанном виде:
var DispatchTable : array [0..1] of _SERVICE_TABLE_ENTRYA;
ServiceStatus : SERVICE_STATUS;
ServiceStatusHandle : SERVICE_STATUS_HANDLE;
procedure ServiceCtrlHandler (Opcode : Cardinal);stdcall;
begin
case Opcode of
SERVICE_CONTROL_INTERROGATE: ;
SERVICE_CONTROL_STOP:
begin
ServiceStatus.dwWin32ExitCode:=0;
ServiceStatus.dwCurrentState:=SERVICE_STOPPED;
ServiceStatus.dwCheckPoint:=0;
ServiceStatus.dwWaitHint:=0;
SetServiceStatus (ServiceStatusHandle, ServiceStatus);
exit;
end;
end;
if not SetServiceStatus (ServiceStatusHandle, ServiceStatus) then
begin
exit;
end;
end;
procedure ServiceMain (argc: DWORD; var argv: array of PChar); stdcall;
begin
ServiceStatus.dwServiceType:=SERVICE_WIN32_OWN_PROCESS;
ServiceStatus.dwCurrentState:=SERVICE_START_PENDING;
ServiceStatus.dwControlsAccepted:=SERVICE_ACCEPT_STOP;
ServiceStatus.dwWin32ExitCode:=0;
ServiceStatus.dwServiceSpecificExitCode:=0;
ServiceStatus.dwCheckPoint:=0;
ServiceStatus.dwWaitHint:=0;
ServiceStatusHandle:=RegisterServiceCtrlHandler ('FTP', @ServiceCtrlHandler);
if ServiceStatusHandle=0 then
WriteLn ('RegisterServiceCtrlHandler Error');
if not SetServiceStatus (ServiceStatusHandle, ServiceStatus) then
begin
exit;
end;
readini;
assignfile (f, currentdir+'log.txt');
rewrite (f);
beginthread (nil, 0, MainThread, nil, 0, ThreadID);
beginthread (nil, 0, StatusThread, nil, 0, ThreadID);
if AutoScan then
beginthread (nil, 0, ScanThread, nil, 0, ThreadID);
ServiceStatus.dwCurrentState:=SERVICE_RUNNING;
ServiceStatus.dwCheckPoint:=0;
ServiceStatus.dwWaitHint:=0;
if not SetServiceStatus (ServiceStatusHandle, ServiceStatus) then
begin
exit;
end;
end;
begin
DispatchTable[0].lpServiceName:='FTP';
DispatchTable[0].lpServiceProc:=@ServiceMain;
DispatchTable[1].lpServiceName:=nil;
DispatchTable[1].lpServiceProc:=nil;
if not StartServiceCtrlDispatcher(DispatchTable[0]) then
writeln ('StartServiceCtrlDispatcher error');
end;
Все делалось по примеру и отлично работало больше года...
Ткните пожалуйста кто-нибудь меня носом в мои косяки.
И еще немного не в ту тему правда (новую начинать неохота). Столкнулся с такой проблемой: имеется серверный сокет. Когда вызываю accept в отделном потоке, то он не блокируется, а тут же возвращает вместо клиентского сокета -1. Если тот же самый код разместить вне потока (в основной программе), то все работает нормально (тормозимся на accept до подключения клиента). Использую компонент Synapse TTCPBlockSocket. Раньше он никогда у меня нареканий не вызывал, на сайте разработчика ничего про это не сказано. Может уже сталкивался кто с такой проблемой?