Libreria Técnica

Ejemplo-Creación de un objeto COM

El siguiente ejemplo a desarrollar es un control de usuarios. Dependiendo del usuario se permitara acceso o no a un campo de una base de datos, para ello crearemos un método dentro del objeto que realice el control. Además de esto crearemos otro método que dependiendo del usuario entrado nos dará derecho de lectura o de lectura/escritura sobre una tabla. Los métodos se llaman busqueda y sololectura. A continuación se incluye el código asociado:

1º.- Biblioteca de tipos:


 unit Pserver1_TLB;

 interface

 uses Windows, ActiveX, Classes, Graphics, OleCtrls, StdVCL;

 const
   LIBID_Pserver1: TGUID = '{DBD49CA0-0399-11D3-9629-0000E85E7443}';
   IID_Icontrolusu: TGUID = '{DBD49CA1-0399-11D3-9629-0000E85E7443}';
   CLASS_controlusu: TGUID = '{DBD49CA3-0399-11D3-9629-0000E85E7443}';
   IID_Iddd: TGUID = '{DBD49CCE-0399-11D3-9629-0000E85E7443}';
   CLASS_ddd: TGUID = '{DBD49CD0-0399-11D3-9629-0000E85E7443}';
 type
   Icontrolusu = interface;
   IcontrolusuDisp = dispinterface;
   Iddd = interface;
   IdddDisp = dispinterface;
   controlusu = Icontrolusu;
   ddd = Iddd;
   Icontrolusu = interface(IDispatch)
     ['{DBD49CA1-0399-11D3-9629-0000E85E7443}']
     function busqueda(const cadena: WideString): Integer; safecall;
     function sololectura(const cadena: WideString): Integer; safecall;
   end;
   IcontrolusuDisp = dispinterface
     ['{DBD49CA1-0399-11D3-9629-0000E85E7443}']
     function busqueda(const cadena: WideString): Integer; dispid 1;
     function sololectura(const cadena: WideString): Integer; dispid 2;
   end;
   Iddd = interface(IDispatch)
     ['{DBD49CCE-0399-11D3-9629-0000E85E7443}']
   end;
   IdddDisp = dispinterface
     ['{DBD49CCE-0399-11D3-9629-0000E85E7443}']
   end;
   Cocontrolusu = class
     class function Create: Icontrolusu;
     class function CreateRemote(const MachineName: string): Icontrolusu;
   end;
   Coddd = class
     class function Create: Iddd;
     class function CreateRemote(const MachineName: string): Iddd;
   end;

 implementation

 uses ComObj;

 class function Cocontrolusu.Create: Icontrolusu;
 begin
   Result := CreateComObject(CLASS_controlusu) as Icontrolusu;
 end;

 class function Cocontrolusu.CreateRemote(const MachineName: string): Icontrolusu;
 begin
   Result := CreateRemoteComObject(MachineName, CLASS_controlusu) as Icontrolusu;
 end;

 class function Coddd.Create: Iddd;
 begin
   Result := CreateComObject(CLASS_ddd) as Iddd;
 end;

 class function Coddd.CreateRemote(const MachineName: string): Iddd;
 begin
   Result := CreateRemoteComObject(MachineName, CLASS_ddd) as Iddd;
 end;

 end.

2º.- El proyecto:


 program Pserver1;

 uses
   Forms,
   serv1 in 'serv1.pas' {Form1},
   Pserver1_TLB in 'Pserver1_TLB.pas',
   Unit1 in 'Unit1.pas' {controlusu: CoClass};

 {$R *.TLB}

 {$R *.RES}

 begin
   Application.Initialize;
   Application.CreateForm(TForm1, Form1);
   Application.Run;
 end.

3.- Unit donde creamos el objeto:


 unit Unit1;

 interface

 uses
   ComObj, ActiveX, Pserver1_TLB,classes,dialogs;

 type
   Tcontrolusu = class(TAutoObject, Icontrolusu)
   protected
     function busqueda(const cadena: WideString): Integer; safecall;
     function sololectura(const cadena: WideString): Integer; safecall;
     {function sololectura(const cadena: WideString): Integer; safecall;}
     { Protected declarations }
   end;
 var
   Flista:TStringList;
   FAcceso:TStringList;

 implementation

 uses ComServ;

 function Tcontrolusu.busqueda(const cadena: WideString): Integer;
 begin
  //si es distinto de -1 significa que el valor esta
  //en la lista
  if flista.indexof(cadena) <> -1 then
     result:=1
  else
     result:=0;
 end;

 function Tcontrolusu.sololectura(const cadena: WideString): Integer;
 begin
    result:=0;
    if facceso.indexof(cadena) <> -1 then
            result:=1
 end;

 initialization
   Flista:=TStringlist.create;
   flista.sorted:=True;
   //si tecleamos en la aplicación cliente cualquiera
   //de estos nombres no veremos el campo continent ni
   //el gráfico.
   flista.add('Pepe');
   flista.add('Luis');
   flista.add('Ana');
   //la lista facceso contiene el nombre de ususarios que solamente tendrán acceso de lectura sobre la tabla.
   facceso:=TStringList.create;
   facceso.sorted:=true;
   facceso.add('Antonio');
   TAutoObjectFactory.Create(ComServer, Tcontrolusu, Class_controlusu,
   ciMultiInstance, tmApartment);
 finalization
   flista.free;
 end.

NOTA: El ejemplo se encuentra en el CD en:
. \ejemplos\controlusu