unit1.pas

DELPHI 系统服务源码OpenService,OpenSCManager,QueryServiceStatus,CloseServiceHandle

{ FileName: Unit1.pas
  功用: 列举系统服务,停止和启动所选服务,设置服务启动类型
  最后更新: 2005-04-20
  日期: 2005-04-19
  作者: yanxizhen yanxizhen#163.com
 }
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,Winsvc, ComCtrls, ExtCtrls,Registry, Menus;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    LView1: TListView;
    Splitter2: TSplitter;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure LView1ColumnClick(Sender: TObject; Column: TListColumn);
    procedure LView1Compare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
   
    { 返回服务状态 }
    function GetServiceState( dwCurrentState: DWord): String;

    { 读取注册表中的服务信息 }
    function ReadFromRegistry( ServiceName: String;KeyName: String;IsInt:Integer=0): String;

    { 打开一个服务 }
    function MyOpenService(ServiceName: PChar):Boolean;

    { 控制服务的状态: 暂停,停止,继续 }
    function MyControlService(ServiceName: PChar;ControlCode: DWORD):Boolean;

    { 启动一个服务 }
    function MyStartService(NumServiceArgs: DWord=0;ServiceArgVectors: PChar=nil): Boolean;

    { 查询一个服务当前的运行状态 }
    function MyQueryServiceStatus(): DWord;

    { 写入一个值到注册表 }
    procedure WriteIntegerToRegistry( ServiceName: String;KeyName: String;KeyValue: Integer);

  public
    { Public declarations }
    { 定义本地服务数据库的句柄,定义服务查询返回信息结构 }
    hScm,hService: SC_HANDLE;
    RtnStatus: TServiceStatus;
  end;

var
  Form1: TForm1;
  ColumnToSort: Integer; // 指定要排序的列的index值

implementation

{$R *.dfm}


{ 打开一个服务 }
function TForm1.MyOpenService(ServiceName: PChar):Boolean;
begin
  Result := False;
  hService := OpenService(hScm,ServiceName,SERVICE_ALL_ACCESS);
  Result := (hService <> 0);

end;

{ 控制服务的状态: 暂停,停止,继续 }
function TForm1.MyControlService(ServiceName: PChar;ControlCode: DWORD):Boolean;
var
  ServiceStatus: TServiceStatus;
begin
     Result := ControlService(hService,ControlCode,ServiceStatus);
end;


{ 启动一个服务 }
function TForm1.MyStartService(NumServiceArgs: DWord=0;ServiceArgVectors: PChar=nil):Boolean;
begin
  Result := StartService(hService,NumServiceArgs,ServiceArgVectors);
end;

{ 查询一个服务当前的运行状态 }
function TForm1.MyQueryServiceStatus(): DWord;
var
  ServiceStatus: TServiceStatus;
begin
  Result := 0;
  QueryServiceStatus(hService,ServiceStatus); 
  Result := ServiceStatus.dwCurrentState;
end;


{ 读取注册表中的服务信息 }
function TForm1.ReadFromRegistry( ServiceName: String;KeyName: String;IsInt:Integer=0): String;
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;

  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    reg.OpenKey('SYSTEM\CurrentControlSet\Services\'+ServiceName,False);

    if IsInt<>0 then
    begin
      case reg.ReadInteger(KeyName) of
        2: Result := '自动';
        3: Result := '手动';
        4: Result := '禁用';
      end;
    end
    else
    Result := reg.ReadString(KeyName);

  finally
    reg.CloseKey;
    reg.Free;
  end;

end;


{ 写入一个整型值到注册表 }
procedure TForm1.WriteIntegerToRegistry( ServiceName: String;KeyName: String;KeyValue: Integer);
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;

  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    reg.OpenKey('SYSTEM\CurrentControlSet\Services\'+ServiceName,False);
    reg.WriteInteger(KeyName,KeyValue);

  finally
    reg.CloseKey;
    reg.Free;
  end;

end;


{ 返回服务状态 }
function TForm1.GetServiceState( dwCurrentState: DWord): String;
begin
  Result := '无效值';

  case dwCurrentState of
      SERVICE_STOPPED:
        Result := ('已停止');
      SERVICE_START_PENDING	:
        Result := ('正在启动...');
      SERVICE_STOP_PENDING	:
        Result := ('正在停止...');
      SERVICE_RUNNING	:
        Result := ('已启动');
      SERVICE_CONTINUE_PENDING	:
        Result := ('SERVICE_CONTINUE_PENDING');
      SERVICE_PAUSE_PENDING		:
        Result := ('正在暂停...');
      SERVICE_PAUSED		:
        Result := ('暂停');
  end;

end;


{ 列举当前系统的所有服务 }
procedure TForm1.Button1Click(Sender: TObject);
var
  ByteNeeded, SrvRtn, ResumeHandle: DWord;
  ServiceArr: Array[0..500] of TEnumServiceStatus;
  i: Dword;
  item: TListItem;
begin
  LView1.Clear;
  ResumeHandle := 0;



  EnumServicesStatus(hScm,SERVICE_WIN32,SERVICE_STATE_ALL,ServiceArr[0],
                                  SizeOf(ServiceArr),ByteNeeded,SrvRtn,ResumeHandle);


  for i := 0 to SrvRtn -1 do
  begin
    item := LView1.Items.Add();
    item.Caption := IntToStr(i+1);
    item.SubItems.Add(ServiceArr[i].lpServiceName); // 服务名
    item.SubItems.Add(ReadFromRegistry(ServiceArr[i].lpServiceName,'Description')); // 描述
    item.SubItems.Add(ReadFromRegistry(ServiceArr[i].lpServiceName,'Start',1)); // 启动类型
    item.SubItems.Add(GetServiceState(ServiceArr[i].ServiceStatus.dwCurrentState)); // 当前状态

  end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  { 打开Service Manager 数据库 }
  hScm := OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);
  if ( hScm < 0 ) then
  begin
     ShowMessage('打开SCM失败!');
  end;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  Panel1.Height := (Self.Height * 3) div 4;
end;

{ ListView的Column Header的单击事件
  里面的代码用来排序
 }
procedure TForm1.LView1ColumnClick(Sender: TObject; Column: TListColumn);
begin
  if LView1.Items.Count > 0 then
  begin
    ColumnToSort := Column.Index;
    (Sender as TCustomListView).AlphaSort;
  end;

end;

{ 对各列进行排序 }
procedure TForm1.LView1Compare(Sender: TObject; Item1, Item2: TListItem;
  Data: Integer; var Compare: Integer);
var
  ix: Integer;
begin
  if LView1.Items.Count >0 then
  begin
    if ColumnToSort = 0 then
      Compare := CompareText(Item1.Caption,Item2.Caption)
    else begin
      ix := ColumnToSort - 1;
      Compare := CompareText(Item1.SubItems[ix],Item2.SubItems[ix]);
    end;
  end;

end;

procedure TForm1.PopupMenu1Popup(Sender: TObject);
var
  i: integer;
  selItem: TListItem;
begin
  selItem := LView1.Selected;

  if selItem = nil then
  begin
    for i:=0 to popupmenu1.Items.Count-1 do
    begin
      popupmenu1.Items[i].Enabled := false;
    end;
    exit;
  end;


  
  if selItem <> nil then
  begin
    popupmenu1.Items[2].Enabled := True;

    if (selItem.SubItems.Strings[3] = '已启动') then
    begin
      popupmenu1.Items[0].Enabled := True;
      popupmenu1.Items[1].Enabled := False;
    end;
    if (selItem.SubItems.Strings[3] = '已停止') then
    begin
      popupmenu1.Items[1].Enabled := True;
      popupmenu1.Items[0].Enabled := False;

    end;
  end;

end;

{ 启动 菜单 }
procedure TForm1.N2Click(Sender: TObject);
var
  selItem: TListItem;
begin
  selItem := LView1.Selected;
  try

  if MyOpenService(PChar(selItem.SubItems.Strings[0])) then
  begin
    if MyStartService() then
      begin
        selItem.SubItems.Strings[3] := '已启动';
        ShowMessage('启动成功!')
      end
    else
      ShowMessage('MyStartService调用失败! 错误代码: '+IntToStr(GetLastError()));
  end
  else
    ShowMessage('MyOpenService调用失败! 错误代码: ' + IntToStr(GetLastError()));

  finally
    CloseServiceHandle(hService);
  end;


end;

{ 停止 服务 }
procedure TForm1.N1Click(Sender: TObject);
var
  selItem: TListItem;
begin
  selItem := LView1.Selected;
  try

  if MyOpenService(PChar(selItem.SubItems.Strings[0])) then
  begin
    if MyControlService(PChar(selItem.SubItems.Strings[0]),SERVICE_CONTROL_STOP) then
      begin
        selItem.SubItems.Strings[3] := '已停止';
        ShowMessage('停止服务成功!')
      end
    else
      ShowMessage('MyControlService调用失败! 错误代码: '+IntToStr(GetLastError()));
  end
  else
    ShowMessage('MyOpenService调用失败! 错误代码: ' + IntToStr(GetLastError()));

  finally
    CloseServiceHandle(hService);
  end;


end;

{ 设置为自动启动 }
procedure TForm1.N4Click(Sender: TObject);
var
  selItem: TListItem;
begin
  selItem := LView1.Selected;

  if selItem.SubItems.Strings[2] <> '自动' then
  begin
    WriteIntegerToRegistry(selItem.SubItems.Strings[0],'Start',2);
    selItem.SubItems.Strings[2] := ReadFromRegistry(selItem.SubItems.Strings[0],'Start',1);
  end;

end;

{ 设置为手动启动 }
procedure TForm1.N5Click(Sender: TObject);
var
  selItem: TListItem;
begin
  selItem := LView1.Selected;

  if selItem.SubItems.Strings[2] <> '手动' then
  begin
    WriteIntegerToRegistry(selItem.SubItems.Strings[0],'Start',3);
    selItem.SubItems.Strings[2] := ReadFromRegistry(selItem.SubItems.Strings[0],'Start',1);
  end;

end;

{ 设置为禁止启动 }
procedure TForm1.N6Click(Sender: TObject);
var
  selItem: TListItem;
begin
  selItem := LView1.Selected;

  if selItem.SubItems.Strings[2] <> '禁止' then
  begin
    WriteIntegerToRegistry(selItem.SubItems.Strings[0],'Start',4);
    selItem.SubItems.Strings[2] := ReadFromRegistry(selItem.SubItems.Strings[0],'Start',1);
  end;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CloseServiceHandle(hScm);
end;

end.