Форум: "Начинающим";
Текущий архив: 2006.01.01;
Скачать: [xml.tar.bz2];

Вниз

services   Найти похожие ветки 

← →
oleggar ©   (2005-12-12 16:42) [0]

Как показать в  Delphi под Windows NT на форме список всех процессов ,как по ctrl-alt-del или Администрирование/службы ?интересуют только службы , а не exe .сразу скажу ,многие известные примеры не показывают служебные процессы или вообще не работают .Так что пример должен быть хорош ,то есть показать службы server и telnet (хоть если они запущены) ,а то у меня показывает только Messenger и MS SQL

---

← →
Игорь Шевченко ©   (2005-12-12 17:18) [1]

unit main;

interface

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

type
 TServiceItem = class
 private
   FStatus : Integer;
   FStartupType : Integer;
   FDisplayName: string;
   FDescription: string;
   FUserName: string;
   FName: string;
   function GetStartupType: string;
   function GetStatus: string;
 public
   constructor Create (AStatus: Integer; AStartupType: Integer);
   property Name: string read FName write FName;
   property DisplayName: string read FDisplayName write FDisplayName;
   property Description: string read FDescription write FDescription;
   property Status: string read GetStatus;
   property StartupType: string read GetStartupType;
   property UserName: string read FUserName write FUserName;
 end;

 TServiceList = class(THSObjectList)
 private
   function GetItems(I: Integer): TServiceItem;
 public
   procedure EnumServices;
   property Items[I: Integer]: TServiceItem read GetItems; default;
 end;

 THSSCMHelper = class
 private
   FSCM: THandle;
 public
   constructor Create (AHScm : THandle);
   function GetServiceDescription (const ServiceName: string): string;
 end;

 TfMain = class(TForm)
   MainMenu1: TMainMenu;
   File1: TMenuItem;
   Savereport1: TMenuItem;
   N1: TMenuItem;
   Exit1: TMenuItem;
   SaveDialog: TSaveDialog;
   PanelClient: TPanel;
   ShapeTop: TShape;
   MemoDescription: TMemo;
   ListView: TListView;
   Label1: TLabel;
   Label2: TLabel;
   Shape1: TShape;
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure ListViewSelectItem(Sender: TObject; Item: TListItem;
     Selected: Boolean);
   procedure Exit1Click(Sender: TObject);
 private
   FServiceList: TServiceList;
   procedure DisplayServices;
 end;

var
 fMain: TfMain;

implementation
uses
 WinSvc, HsAdvApi;

{$R *.dfm}

{ TServiceItem }

constructor TServiceItem.Create(AStatus, AStartupType: Integer);
begin
 FStatus := AStatus;
 FStartupType := AStartupType;
end;

function TServiceItem.GetStartupType: string;
begin
 Result := IntToStr(FStartupType);
end;

function TServiceItem.GetStatus: string;
begin
 if FStatus = SERVICE_RUNNING then
   Result := "Running"
 else if FStatus = SERVICE_STOPPED then
   Result := "Stopped"
 else
   Result := IntToStr(FStatus);
end;

{ TServiceList }

procedure TServiceList.EnumServices;
var
 hSCM: THandle;
 rc: Boolean;
 ResumeHandle: DWORD;
 Buffer: Pointer;
 BufferSize: DWORD;
 BytesNeeded: DWORD;
 NumberOfServices: DWORD;
 Error: DWORD;
 ServicesData: PEnumServiceStatusProcessArrayA;
 I: Integer;
 Item: TServiceItem;
 SCMHelper: THSSCMHelper;
begin
 Clear;
 hSCM := OpenSCManager(nil, nil,
   SC_MANAGER_CONNECT or SC_MANAGER_ENUMERATE_SERVICE);
 if hSCM = 0 then
   RaiseLastOSError;
 SCMHelper:= THSSCMHelper.Create(hSCM);
 ResumeHandle := 0;
 try
   EnumServicesStatusExA(hSCM, SC_ENUM_PROCESS_INFO, SERVICE_WIN32,
       SERVICE_STATE_ALL, nil, 0, BytesNeeded, NumberOfServices,
       ResumeHandle, nil);
   Error := GetLastError;
   if (Error <> ERROR_INSUFFICIENT_BUFFER) and
      (Error <> ERROR_MORE_DATA) then
     RaiseLastOSError;
   BufferSize := BytesNeeded;
   GetMem(Buffer, BufferSize);
   try
     rc := EnumServicesStatusExA(hSCM, SC_ENUM_PROCESS_INFO, SERVICE_WIN32,
       SERVICE_STATE_ALL, Buffer, BufferSize, BytesNeeded, NumberOfServices,
       ResumeHandle, nil);
     if not rc then
       RaiseLastOSError;
     ServicesData := Buffer;
     for I:=0 to Pred(NumberOfServices) do begin
       Item := TServiceItem.Create(
         ServicesData^[I].ServiceStatusProcess.dwCurrentState,
         0);
       Item.Name := ServicesData^[I].lpServiceName;
       Item.DisplayName := ServicesData^[I].lpDisplayName;
       Item.Description := SCMHelper.GetServiceDescription(Item.Name);
       Add(Item);
     end;
   finally
     FreeMem(Buffer);
   end;
 finally
   SCMHelper.Free;
   CloseServiceHandle(hSCM)
 end;
end;

function TServiceList.GetItems(I: Integer): TServiceItem;
begin
 Result := TServiceItem(inherited Items[I]);
end;

procedure TfMain.DisplayServices;
var
 I: Integer;
begin
 ListView.Items.Clear;
 for I:=0 to Pred(FServiceList.Count) do
   if FServiceList[I].Status = "Running" then
     with ListView.Items.Add do begin
       Data := FServiceList[I];
       Caption := FServiceList[I].Name;
       SubItems.Add (FServiceList[I].DisplayName);
       SubItems.Add (FServiceList[I].Status);
     end;
end;

procedure TfMain.FormCreate(Sender: TObject);
begin
 FServiceList := TServiceList.Create;
 FServiceList.EnumServices;
 DisplayServices;
end;

procedure TfMain.FormDestroy(Sender: TObject);
begin
 FServiceList.Free;
end;

{ THSSCMHelper }

constructor THSSCMHelper.Create(AHScm: THandle);
begin
 FSCM:= AHScm;
end;

function THSSCMHelper.GetServiceDescription(
 const ServiceName: string): string;
var
 hService: THandle;
 BytesNeeded: DWORD;
 Buffer: Pointer;
 BufferSize: DWORD;
 Error: DWORD;
 rc: Boolean;
begin
 Result := "";
 hService := OpenService(FSCM, PChar(ServiceName), SERVICE_QUERY_CONFIG);
 if hService = 0 then
   RaiseLastOSError;
 try
   QueryServiceConfig2A(hService, SERVICE_CONFIG_DESCRIPTION, nil, 0,
     BytesNeeded);
   Error := GetLastError;
   if (Error <> ERROR_INSUFFICIENT_BUFFER) and
      (Error <> ERROR_MORE_DATA) then
     RaiseLastOSError;
   BufferSize := BytesNeeded;
   GetMem(Buffer, BufferSize);
   try
     rc := QueryServiceConfig2A(hService, SERVICE_CONFIG_DESCRIPTION,
       Buffer, BufferSize, BytesNeeded);
     if not rc then
       RaiseLastOSError;
     Result := PServiceDescriptionA(Buffer).lpDescription;
   finally
     FreeMem(Buffer);
   end;
 finally
   CloseServiceHandle(hService);
 end;
end;

procedure TfMain.ListViewSelectItem(Sender: TObject; Item: TListItem;
 Selected: Boolean);
begin
 if Assigned(ListView.Selected) and Assigned(ListView.Selected.Data) then
   with TServiceItem(ListView.Selected.Data) do
     MemoDescription.Text := Description;
end;

procedure TfMain.Exit1Click(Sender: TObject);
begin
 Close;
end;



---

← →
oleggar ©   (2005-12-12 17:46) [2]

a THSObjectList.pas где взять ?без него не работает .да и пример использования модуля  можно найти ?

---

← →
Игорь Шевченко ©   (2005-12-12 17:56) [3]

oleggar ©   (12.12.05 17:46) [2]

Ты спросил - как вывести. Я показал. Ты не просил - дайте мне готовую программу, которая будет компилироваться у меня. Практически весь код, который я выкладываю, является основой для творческой переработки. Удачи.

---

← →
Digitman ©   (2005-12-12 18:06) [4]

> интересуют только службы , а не exe


галиматья.
в огороде бузина, а в Киеве дядька.

---

← →
Leonid Troyanovsky ©   (2005-12-12 18:34) [5]

> Digitman ©   (12.12.05 18:06) [4]

> > интересуют только службы , а не exe

> галиматья.


Чего-то ты сегодня не в духе :)

Нонче службы могут быть и в dll, только MS не спешит радовать
своих поклонников, видимо, подозревая некоторые негативные
последствия от публикования интерфейсов того ж svchost.

--
Regards, LVT.

---

← →
VirEx ©   (2005-12-12 18:53) [6]

CreateToolhelp32Snapshot
Heap32First
Heap32ListFirst
Heap32ListNext
Heap32Next
Module32First
Module32Next
Process32First
Process32Next
Thread32First
Thread32Next
Toolhelp32ReadProcessMemory

---

← →
VirEx ©   (2005-12-12 18:56) [7]

в Delphi: меню Help -> Windows SDK

---

← →
Leonid Troyanovsky ©   (2005-12-12 19:13) [8]

> VirEx ©   (12.12.05 18:56) [7]
> в Delphi: меню Help -> Windows SDK


Как там было про Дзержинского?
- Душевный человек, мог бы и расстрелять.

--
Regards, LVT.

---

← →
kami ©   (2005-12-12 22:44) [9]

http://www.kladovka.net.ru/index.cgi?pid=board&rid=289

---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2006.01.01;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.48 MB
Время: 0.01 c