Новичок
Профиль
Группа: Участник
Сообщений: 12
Регистрация: 23.10.2004
Репутация: нет
Всего: нет
|
Я написал службу, которая удаляет в сети музыку вот ее код - | Код |
program Del_Music;
uses
Forms,
WinSvc,
Windows,
SysUtils,
Variants,
Classes,
Masks;
var
ServiceStatus : SERVICE_STATUS;
ServiceStatusHandle : SERVICE_STATUS_HANDLE;
hThread: cardinal;
DispatchTable: array [0..1] of SERVICE_TABLE_ENTRY;
i:integer;
const
SServiceName = 'Delete music is directory student';
DServiceName = 'Удаление музыки';
procedure log(mess: string);
var TFS :TFileStream;
F :integer;
Msg :PChar;
begin
Mess:=Mess+#13#10; GetMem(Msg,Length(Mess)+1);
StrPCopy(Msg,Mess);
try
TFS :=TFileStream.Create('test.log',fmShareDenyNone or fmOpenWrite);
except
TFS :=TFileStream.Create('test.log',fmCreate);
end;
TFS.Seek(0,soFromEnd);
TFS.Write(Msg^,Length(Mess));
TFS.Free; FreeMem(Msg);
end;
function Installing: Boolean;
begin
Result := FindCmdLineSwitch('INSTALL', ['-', '\', '/'], True) or
FindCmdLineSwitch('UNINSTALL', ['-', '\', '/'], True);
end;
procedure manage_service(uninstall: boolean = false);
var
Mgr ,Svc: Cardinal;
begin
// открыть СКМ `
// Добавить\удалить информацию о сервисе
// Закрыть СКМ
Mgr := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if Mgr <> 0 then begin
if (not uninstall) then begin
Svc:=CreateService(
mgr,
SServiceName,
DServiceName,
SERVICE_ALL_ACCESS,
SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS,
SERVICE_DEMAND_START,
SERVICE_ERROR_NORMAL,
pchar(Application.ExeName),
nil,nil,nil,nil,nil
);
if (Svc <> 0) then
messagebox(0,'Сервис успешно установлен','Сообщение',mb_ok)
else
messagebox(0,'Не могу установить сервис','Сообщение',mb_ok+MB_ICONWARNING);
end else begin
Svc:=OpenService(Mgr, PChar(SServiceName), SERVICE_ALL_ACCESS);
if (svc <> 0) then begin
if DeleteService(svc) then
messagebox(0,'Сервис успешно удалён','Сообщение',mb_ok)
else
messagebox(0,'Не могу удалиь сервис','Сообщение',mb_ok+MB_ICONWARNING);
CloseServiceHandle(Svc);
end;
end;
CloseServiceHandle(Mgr);
end;
end;
function StartService: Boolean;
var
Mgr ,Svc: Cardinal;
UserName, ServiceStartName: string;
Config: Pointer;
Size: DWORD;
SvcVectors: PAnsiChar;
begin
Result := False;
Mgr := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if Mgr <> 0 then
begin
Svc := OpenService(Mgr, PChar(SServiceName), SERVICE_ALL_ACCESS);
Result := Svc <> 0;
if Result then
begin
QueryServiceConfig(Svc, nil, 0, Size);
Config := AllocMem(Size);
try
QueryServiceConfig(Svc, Config, Size, Size);
ServiceStartName := PQueryServiceConfig(Config)^.lpServiceStartName;
if CompareText(ServiceStartName, 'LocalSystem') = 0 then
ServiceStartName := 'SYSTEM';
finally
Dispose(Config);
end;
CloseServiceHandle(Svc);
end;
CloseServiceHandle(Mgr);
end;
if Result then
begin
Size := 256;
SetLength(UserName, Size);
GetUserName(PChar(UserName), Size);
SetLength(UserName, StrLen(PChar(UserName)));
Result := CompareText(UserName, ServiceStartName) = 0;
end;
end;
procedure ServiceCtrlHandler(Opcode : Cardinal);stdcall;
var
Status : Cardinal;
begin
case Opcode of
SERVICE_CONTROL_PAUSE :
begin
log('ПАУЗА');
ServiceStatus.dwCurrentState := SERVICE_PAUSED;
SuspendThread(hThread);
end;
SERVICE_CONTROL_CONTINUE :
begin
log('ПРОДОЛЖИМ');
ServiceStatus.dwCurrentState := SERVICE_RUNNING;
ResumeThread(hThread);
end;
SERVICE_CONTROL_STOP :
begin
log('ОСТАНОВКА');
ServiceStatus.dwWin32ExitCode:=0;
ServiceStatus.dwCurrentState := SERVICE_STOPPED;
ServiceStatus.dwCheckPoint :=0;
ServiceStatus.dwWaitHint :=0;
if not SetServiceStatus (ServiceStatusHandle,ServiceStatus)
then begin
Status:=GetLastError;
Exit;
end;
exit;
end;
SERVICE_CONTROL_INTERROGATE : log('ХЗ');
end;
if not SetServiceStatus (ServiceStatusHandle, ServiceStatus)
then begin
Status := GetLastError;
Exit;
end;
end;
function MainServiceThread(p:Pointer):DWORD;stdcall;
begin
log('Пускаем сновной поток');
end;
//процедура поиска фойлов
procedure FindFile(Dir:String);
Var SR:TSearchRec;
FindRes:Integer;
begin
FindRes:=FindFirst(Dir+'*.*',faAnyFile,SR);
While FindRes=0 do
begin
if ((SR.Attr and faDirectory)=faDirectory) and
((SR.Name='.')or(SR.Name='..')) then
begin
FindRes:=FindNext(SR);
Sleep(50);
Continue;
end;
// если найден каталог, то
if ((SR.Attr and faDirectory)=faDirectory) then
begin
// входим в процедуру поиска с параметрами текущего каталога +
// каталог, что мы нашли
FindFile(Dir+SR.Name+'\');
FindRes:=FindNext(SR);
// после осмотра вложенного каталога мы продолжаем поиск
// в этом каталоге
Continue; // продолжить цикл
end;
if MatchesMask(dir+SR.Name, '*.mp3') then DeleteFile(dir+sr.Name);
if MatchesMask(dir+SR.Name, '*.wma') then DeleteFile(dir+sr.Name);
Sleep(50);
// ListBox1.Items.Add(SR.Name);
FindRes:=FindNext(SR);
end;
FindClose(SR);
end;
procedure ServiceProc(argc : DWORD;var argv : array of PChar);stdcall;
var
Status : DWORD;
ThID : Cardinal;
begin
log('Пускаем основную процедуру сервиса.');
ServiceStatus.dwServiceType := SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS;
ServiceStatus.dwCurrentState := SERVICE_START_PENDING;
ServiceStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP
or SERVICE_ACCEPT_PAUSE_CONTINUE;
ServiceStatus.dwWin32ExitCode := 0;
ServiceStatus.dwServiceSpecificExitCode := 0;
ServiceStatus.dwCheckPoint := 0;
ServiceStatus.dwWaitHint := 0;
ServiceStatusHandle :=
RegisterServiceCtrlHandler(pansichar(SServiceName),@ServiceCtrlHandler);
if (ServiceStatusHandle = 0) then
log('Не могу зарегистрировать процедуру обработки сообщений сервиса')
else
log('Регистрация завершена');
if not SetServiceStatus (ServiceStatusHandle,ServiceStatus) then begin
log('Не могу установить статус сервиса. Завершаю работу.');
exit;
end;
ServiceStatus.dwCurrentState :=SERVICE_RUNNING;
ServiceStatus.dwCheckPoint :=0;
ServiceStatus.dwWaitHint :=0;
if not SetServiceStatus (ServiceStatusHandle,ServiceStatus)
then begin
Status:=GetLastError;
case status of
ERROR_INVALID_DATA: log('Ошибка установки статуса: не правильно сформированы данные');
ERROR_INVALID_HANDLE : log('Ошибка установки статуса: указаный заголовок не существует');
else
log('Ошибка установки статуса: номер ошибки = '+ inttostr(Status));
end;
exit;
end;
// WORK HERE
log('Пускаем выделенный процесс');
hThread:=CreateThread(nil,0,@MainServiceThread,nil,0,ThID);
log('Ожидаем сигналов от процесса');
if (WaitForSingleObject(hThread,INFINITE) = WAIT_OBJECT_0 ) then begin
log('сигнал получен');
CloseHandle(hThread);
end;
//ЗДЕСЬ БУДЕТ ОСНОВНОЙ КОД ПРОГРАММЫ
repeat
FindFile('\\studserver\store\Student\');
i:=1;
Sleep(10000);
until(i<>1);
end;
begin
SetCurrentDir(extractfilepath(application.ExeName));
if Installing or StartService then
begin
if not Installing then begin
DispatchTable[0].lpServiceName:=pAnsiChar(SServiceName);
DispatchTable[0].lpServiceProc:=@ServiceProc;
DispatchTable[1].lpServiceName:=nil;
DispatchTable[1].lpServiceProc:=nil;
StartServiceCtrlDispatcher(DispatchTable[0]);
end else
manage_service(FindCmdLineSwitch('UNINSTALL', ['-', '\', '/'], True));
end;
end.
|
Но она запускается под правами систему, а система не имеет права лезть в сеть -> прога нафиг не нужна, а когда я попробывал поставить переключатель "С учитной записью" указал учитную запись доменного пользователя и запустил он мне написал "Не удалось запустить службу, ошибка 1053 Служба не отвитела на запрос своевреенно". Как мне переписать прогу чтобы она могла запускать от чьего либо имени, а не только от имени системы? |
Проблемы с сервисом, Не хочет запускаться "от имени" 
Дата 23.12.2004, 14:21 (
Загрузка ...
