Delphi控件源码

开发平台：
Delphi

CWMIBase.pas：源码内容
							unit CWMIBase;
//=========================================================================
//
// I N T E R F A C E
//
//=========================================================================
interface
uses
  Windows, Messages, SysUtils, Classes, WbemScripting_TLB, FormAbout;
type
  TArrVariant = array of variant;
  TArrString = array of string;
  TArrInteger = array of Integer;
  TParamType = (ptIn, ptOut);
  TWMIGenericPropType = (gptString, gptStringArray, gptInteger, gptInteger64,
                         gptIntegerArray, gptReal, gptBoolean, gptDateTime,
                         gptChar, gptReference, gptObject);
  TWMIBase = class(TComponent)
  private
    aServices:ISWbemServices;
    FActive: Boolean;
    FAllProperties: TStrings;
    FObjectsCount: integer;
    FConnected: Boolean;
    FHost: string;
    FObjectIndex: integer;
    FAboutGLibWMI: TFAbout;
    FMSDNHelp: String;
    FComponentCaption: string;
    function GetAllProperties: TStrings;
    procedure SetObjectIndex(const Value: integer);
    function GetComponentCaption: string;
  protected
    procedure SetActive(const Value: Boolean); virtual;
    //: Clase para el componente
    function GetWMIClass():string; virtual; abstract;
    //: Obtener el root.
    function GetWMIRoot():string; virtual; abstract;
    //: Conectar al proveedor.
    procedure ConnectWMI();
    //: Lipiar las propiedades
    procedure ClearProps(); virtual;
    //: Rellenar las propiedades.
    procedure FillProperties(AIndex:integer); virtual;
  public
    // redefinidos
    constructor Create(AOwner: TComponent); override;
    //: destructor
    destructor Destroy; override;
    //: Conectado correctamente
    property Connected:Boolean read FConnected;
    //:
    property WMIServices:ISWbemServices read aServices;
    //: Propiedad con la clase del componente
    property WMIClass:string read GetWMIClass;
  published
    //: Caption del componente
    property ComponentCaption:string read GetComponentCaption write FComponentCaption stored False;
    //: Informaci髇 acerca del paquete de componentes
    property VersionGLib:TFAbout read FAboutGLibWMI stored false;
    //: Acceso a la p醙ina de documentaci髇 de MSDN
    property MSDNHelp:String read FMSDNHelp write FMSDNHelp stored false;
    //: Host al que nos queremos conectar
    property Host:string read FHost write FHost;
    //: Activar el componente.
    property Active:Boolean read FActive write SetActive;
    //: odas las propiedades como texto
    property AllProperties:TStrings read GetAllProperties write FAllProperties;
    //: Objetos encontrados para esa clase.
    property ObjectsCount:integer read FObjectsCount write FObjectsCount stored False;
    //: Objeto que estamos visualizando en las propiedades.
    property ObjectIndex:integer read FObjectIndex write SetObjectIndex stored False;
  end;
//=========================================================================
//
// I M P L E M E N T A T I O N
//
//=========================================================================
implementation
{ TWMIBase }
uses
  UProcedures, UConstantes, Dialogs, Variants;
destructor TWMIBase.Destroy();
begin
  // Asignado?
  if Assigned(Self.FAllProperties) then begin
    // Crear la lista
    FreeAndNil(Self.FAllProperties);
  end;
  // heredado
  inherited;
end;
constructor TWMIBase.Create(AOwner: TComponent);
begin
  inherited;
  // Ini
  Self.FObjectsCount := 0;
  Self.FObjectIndex := 0;
  Self.FConnected := False;
  Self.FActive := False;
  Self.FAllProperties := TStringList.Create();
  // ini Conexion
  Self.FHost := '.';
end;
procedure TWMIBase.SetActive(const Value: Boolean);
var
  b:Boolean;
  TS:TStrings;
begin
  // Guardar el valor
  Self.FActive := Value;
  // Desactivado? limpiar
  if not (Value) then begin
    Self.FObjectsCount := 0;
    Self.FObjectIndex := 0;
    Self.FAllProperties.Text := STR_EMPTY;
    ClearProps;     
    Exit;
  end;
  // ini
  Self.FAllProperties.Clear;  
  // Conectar
  Self.ConnectWMI;
  if not (Self.Connected) then begin
    raise Exception.Create('No se ha conectado.');
    Exit;
  end;
  // Activando?
  if (Value) then begin
    // Conectado?
    if (Self.Connected) then begin
      // Obtener las propiedades
      GetWMIProperties(0, aServices, GetWMIClass(), Self.FAllProperties);
  // Debug      FAllProperties.SaveToFile('r:all.txt');
      // Obtener el n鷐ero de objetos
      Self.ObjectsCount := Self.FAllProperties.Count;
      // Hay algun objeto?
      if (Self.ObjectsCount <= 0) then begin
        Exit;
      end
      else begin
        // Cargar el primero
        Self.FObjectIndex := 1;
        Self.FillProperties(Self.FObjectIndex);
//-- MessageDlg('Fill', mtInformation, [mbOK], 0);
      end;
//--MessageDlg('objetos: ' + IntToStr(Self.ObjectsCount), mtInformation, [mbOK], 0);
    end;
  end;
  Exit;
  
  // Obtener todas las propiedades
  if (Self.ObjectsCount > 0) then begin
    TS := TStringList.Create();
    // proteccion
    try
      // Obtener las propiedades
      GetWMIProperties(0, aServices, GetWMIClass(), TS);
      Self.FAllProperties.Text := TS.Text;
    finally
      FreeAndNil(TS);
    end;
  end;
//--MessageDlg(Format('%d  Objetos encontrados', [FObjectsCount]), mtInformation, [mbOK], 0);
end;
function TWMIBase.GetAllProperties(): TStrings;
begin
//  if not Assigned(Self.FAllProperties) then begin
//    MessageDlg('Self.FAllProperties  NULL', mtInformation, [mbOK], 0);
//    Exit;
//  end;
  // Result
  Result := Self.FAllProperties;
end;
//: Conectar al proveedor.
procedure TWMIBase.ConnectWMI();
var
  Locator:  ISWbemLocator;
begin
  try
    // Create the Location object
    Locator := CoSWbemLocator.Create();
    // Connect to the WMI service, with the rootcimv2 namespace
    aServices := Locator.ConnectServer(
        Self.FHost,      // Host
        GetWMIRoot(),    // root
        {user}STR_EMPTY, {password}STR_EMPTY,
        STR_EMPTY, STR_EMPTY, 0, nil);
    Self.FConnected := True;
//-MessageDlg('Conectado', mtInformation, [mbOK], 0);
  except
    Self.FConnected := False;
//-MessageDlg('No Conectado', mtInformation, [mbOK], 0);
    //+G  EXCEPCION PRPIA
    raise Exception.Create(GetLastErrorAsString());
  end;
end;
procedure TWMIBase.SetObjectIndex(const Value: integer);
begin
  if (csLoading in ComponentState) then begin
    Exit;
  end;
  // Si no ha cambiado, nada
  if (Self.FObjectIndex = Value) then begin
    Exit;
  end;
  // Modificar el 韓dice
  Self.FObjectIndex := Value;
  // no Conectado?
  if not (Self.Connected) then begin
    Self.FObjectIndex := 0;
    raise Exception.Create('Componente no conectado...  (crear tipo espec韋ico)');
    Exit;
  end;
  // Activando?
  if not (Self.FActive) then begin
    Self.FObjectIndex := 0;
    raise Exception.Create('Componente no activado...  (crear tipo espec韋ico)');
    Exit;
  end;
  // 韓dice incorecto?
  if (Value < 1) or (Value > Self.FObjectsCount) then begin
    Self.FObjectIndex := 0;
    raise Exception.Create('蚽dice fuera de l韒ites...  (crear tipo espec韋ico)');
    Exit;
  end;
  // Hay algun objeto?
  if (Self.ObjectsCount <= 0) then begin
    Self.FObjectIndex := 0;
    Exit;
  end;
  //.
  //.
  //.
  // si todo correcto rellenamos las propiedades
  // Rellenar las propiedades del objeto especificado
  Self.FillProperties(Self.FObjectIndex);
end;
//: Rellenar las propiedades.
procedure TWMIBase.FillProperties(AIndex: integer);
begin
  // limipar las actuales
  ClearProps();
  // El resto se rellenan en las hijas
  //...
end;
procedure TWMIBase.ClearProps;
begin
  // Limpiar la propiedad
  Self.FAllProperties.Clear;
end;
// Caption del componente
function TWMIBase.GetComponentCaption: string;
var
  v:Variant;
  vNull:boolean;  
begin
  try
    GetWMIPropertyValue(Self, 'Caption', v, vNull);
    Self.FComponentCaption := VariantStrValue(v, vNull);
  except
    Self.FComponentCaption := STR_EMPTY;
  end;
  Result := FComponentCaption;
end;
end.

						