Chip 2002 March/Chip_2002-03_cd1.bin/zkuste/delphi/kompon/d5/ADO.ZIP/src/AdoCommand.pas

Pascal/Delphi Source File | 2001-12-23 | 15.5 KB | 456 lines

unit AdoCommand;

interface

{$I Ado25.inc}

uses
  ActiveX, Classes, Graphics, OleServer, StdVCL,  Dialogs,
  AdoConnection, Ado21Int, AdoConsts;


type

  TParameterItems = class;

  TCommand = class(TOleServer)
  private
    FIntf:        ICommand;
    FConnection: TConnection;
    FParameterItems: TParameterItems;
    function      GetCommand: ICommand;
    function Get_CommandText: WideString;
    function Get_CommandTimeout: Integer;
    function Get_CommandType: CommandTypeEnum;
    function Get_Parameters: IParameters;
    function Get_Prepared: WordBool;
    function GetActiveConnection: IConnection;
    procedure Set_CommandText(const Value: WideString);
    procedure Set_CommandTimeout(const Value: Integer);
    procedure Set_CommandType(const Value: CommandTypeEnum);
    procedure Set_Prepared(const Value: WordBool);
    procedure SetActiveConnection(const Value: IConnection);
    procedure SetConnection(const Value: TConnection);
    function GetParameterItems: TParameterItems;
    procedure SetParameterItems(const Value: TParameterItems);
    procedure UpdateParameterItems;
    procedure CheckActtiveConnection;
    procedure CheckCommandText;
  protected
    procedure InitServerData; override;
    function  Get_State: Integer;
    procedure SetName(const NewName: TComponentName); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure Connect; override;
    procedure ConnectTo(svrIntf: ICommand);
    procedure Disconnect; override;
    procedure Cancel;
    property  Command: ICommand read GetCommand;
    property State: Integer read Get_State;
    //function  Execute: IRecordset; overload;
    function  Execute(var RecordsAffected: integer; var Parameters: OleVariant; Options: Integer): IRecordset; overload;
    function  CreateParameter(const Name: WideString; Type_: DataTypeEnum;
                              Direction: ParameterDirectionEnum; Size: Integer; Value: OleVariant): IParameter;
    property Parameters: IParameters read Get_Parameters;
    //property ActiveConnection: IConnection read GetActiveConnection write SetActiveConnection;
  published
    property CommandText: WideString read Get_CommandText write Set_CommandText;
    property CommandTimeout: Integer read Get_CommandTimeout write Set_CommandTimeout;
    property Prepared: WordBool read Get_Prepared write Set_Prepared;
    property CommandType: CommandTypeEnum read Get_CommandType write Set_CommandType;

    //property ParameterItems: TParameterItems read GetParameterItems write SetParameterItems;
    property Connection: TConnection read FConnection write SetConnection;
  end;

  TParameterItem = class(TCollectionItem)
  private
    FName: WideString;
    FValue: OleVariant;
    FType_: DataTypeEnum;
    FDirection: ParameterDirectionEnum;
    FPrecision: Byte;
    FNumericScale: Byte;
    FSize: Integer;
    FAttributes: Integer;
    procedure SetType_(const Value: DataTypeEnum);
    procedure SetValue(const Value: OleVariant);
  protected
    function GetDisplayName: string; override;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property Name: WideString read FName write FName;
    property Value: OleVariant read FValue write SetValue;
    property Type_: DataTypeEnum read FType_ write SetType_;
    property Direction: ParameterDirectionEnum read FDirection write FDirection;
    property Precision: Byte read FPrecision write FPrecision;
    property NumericScale: Byte read FNumericScale write FNumericScale;
    property Size: Integer read FSize write FSize;
    property Attributes: Integer read FAttributes write FAttributes;
  end;

  TParameterItems = class(TCollection)
  private
    FCommand: TCommand;
    procedure AddParameter(Parameter: IParameter);
    procedure AddParamteters(Parameters: IParameters);
    function GetParametersArray: OleVariant;
    function GetParameters(index: integer): IParameter;
  public
    constructor Create(Command: TCommand);
    function Add: TParameterItem;
    function GetItem(Index: Integer): TParameterItem;
    procedure SetItem(Index: Integer; Value: TParameterItem);
    property Items[Index: Integer]: TParameterItem read GetItem write SetItem; default;
    property ParametersArray: OleVariant read GetParametersArray;
    property Parameters[index: integer]: IParameter read GetParameters;
  end;


implementation

uses ComObj;

procedure TCommand.InitServerData;
const
  CServerData: TServerData = (
    ClassID:   '{00000507-0000-0010-8000-00AA006D2EA4}';
    IntfIID:   '{0000054E-0000-0010-8000-00AA006D2EA4}';
    EventIID:  '';
    LicenseKey: nil;
    Version: 500);
begin
  ServerData := @CServerData;
end;

procedure TCommand.Connect;
var
  punk: IUnknown;
begin
  if FIntf = nil then
  begin
    punk := GetServer;
    Fintf:= punk as ICommand;
  end;
end;

procedure TCommand.ConnectTo(svrIntf: ICommand);
begin
  Disconnect;
  FIntf := svrIntf;
end;

procedure TCommand.DisConnect;
begin
  if Fintf <> nil then
  begin
    FIntf := nil;
  end;
end;

function TCommand.GetCommand: ICommand;
begin
  if FIntf = nil then
    Connect;
  Assert(FIntf <> nil, 'Command is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
  Result := FIntf;
end;
//------------------------------------------------------------------------------
constructor TCommand.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FParameterItems:= TParameterItems.Create(self);
end;
//------------------------------------------------------------------------------
destructor TCommand.Destroy;
begin
  inherited Destroy;
  FParameterItems.Free;
end;
//------------------------------------------------------------------------------
procedure TCommand.CheckCommandText;
begin
  if CommandText = '' then
    DoAdoError(emNoCommandText);
  CommandText:= CommandText;
end;
//------------------------------------------------------------------------------
procedure TCommand.CheckActtiveConnection;
begin
  if not Assigned(Connection) then
    DoAdoError(emNoConnection);
  if not Connection.Active then
    DoAdoError(emNoConnectionActive);
  Command.Set_ActiveConnection(Connection.Connection);
end;
//------------------------------------------------------------------------------
function  TCommand.Get_State: Integer;
begin
  Result := Command.State;
end;
//------------------------------------------------------------------------------
procedure TCommand.Cancel;
begin
  Command.Cancel;
end;
//------------------------------------------------------------------------------
{function TCommand.Execute: IRecordset;
var Params: OleVariant;
begin
  CheckExecute;
  Params:= EmptyParam; //ParameterItems.GetParametersArray;
  result:= Command.Execute(EmptyParam, EmptyParam, adCmdText) as IRecordset;
  UpdateParameterItems;
end;  }
//------------------------------------------------------------------------------
function TCommand.Execute(var RecordsAffected: integer;
  var Parameters: OleVariant; Options: Integer): IRecordset;
var RecsAffected: OleVariant;
begin
  CheckActtiveConnection;
  CheckCommandText;
  //UpdateParameterItems;
  RecsAffected:= RecordsAffected;
  result:= Command.Execute(RecsAffected, Parameters, Options) as IRecordset;
  RecordsAffected:= RecsAffected;
end;
//------------------------------------------------------------------------------
procedure TCommand.UpdateParameterItems;
begin
  FParameterItems.Clear;
  FParameterItems.AddParamteters(Parameters);
end;
//------------------------------------------------------------------------------
function TCommand.CreateParameter(const Name: WideString;
  Type_: DataTypeEnum; Direction: ParameterDirectionEnum; Size: Integer;
  Value: OleVariant): IParameter;
begin
  CheckActtiveConnection;
  result:= Command.CreateParameter(Name, Type_, Direction, Size, Value);
end;
//------------------------------------------------------------------------------
function TCommand.GetParameterItems: TParameterItems;
begin
  UpdateParameterItems;
  result:= FParameterItems;
end;
//------------------------------------------------------------------------------
procedure TCommand.SetParameterItems(const Value: TParameterItems);
begin
  FParameterItems:= Value;
end;
//------------------------------------------------------------------------------
function TCommand.Get_Parameters: IParameters;
begin
  result:= Command.Parameters as IParameters;
end;
//------------------------------------------------------------------------------
function TCommand.Get_CommandText: WideString;
begin
  result:= Command.CommandText;
end;
//------------------------------------------------------------------------------
procedure TCommand.Set_CommandText(const Value: WideString);
begin
  Command.Set_CommandText(Value);
end;
//------------------------------------------------------------------------------
function TCommand.Get_CommandTimeout: Integer;
begin
  result:= Command.CommandTimeout;
end;
//------------------------------------------------------------------------------
procedure TCommand.Set_CommandTimeout(const Value: Integer);
begin
  Command.Set_CommandTimeout(Value);
end;
//------------------------------------------------------------------------------
function TCommand.Get_CommandType: CommandTypeEnum;
begin
  result:= Command.Get_CommandType;
end;
//------------------------------------------------------------------------------
procedure TCommand.Set_CommandType(const Value: CommandTypeEnum);
begin
  if (Value = adCmdFile) or (Value = adCmdTableDirect) then
    DoAdoError(emCommandType);
  Command.CommandType:= Value;
end;
//------------------------------------------------------------------------------
function TCommand.Get_Prepared: WordBool;
begin
  result:= Command.Prepared;
end;
//------------------------------------------------------------------------------
procedure TCommand.Set_Prepared(const Value: WordBool);
begin
  Command.Set_Prepared(Value);
end;
//------------------------------------------------------------------------------
function TCommand.GetActiveConnection: IConnection;
begin
  result:= Command.Get_ActiveConnection as IConnection;
end;
//------------------------------------------------------------------------------
procedure TCommand.SetActiveConnection(const Value: IConnection);
begin
  Command._Set_ActiveConnection(Value as Connection15);
end;
//------------------------------------------------------------------------------
procedure TCommand.SetName(const NewName: TComponentName);
begin
  inherited;
  Command.Set_Name(NewName);
end;
//------------------------------------------------------------------------------
procedure TCommand.SetConnection(const Value: TConnection);
begin
  if Value<>Connection then begin
    if Assigned(Value) then
      Value.FreeNotification(self);
    FConnection := Value;
  end;
end;
//------------------------------------------------------------------------------
procedure TCommand.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove)  then begin
    if (AComponent = FConnection) then begin
      FConnection:= nil;
    end;
  end;
end;
//------------------------------------------------------------------------------
{ TParameterItem }
//------------------------------------------------------------------------------
constructor TParameterItem.Create(Collection: TCollection);
begin
  inherited;
  Name:= 'ParameterName';
  Value:= Null;
  Type_:= adEmpty;
  Direction:= adParamInput;
  Precision:= 0;
  NumericScale:= 0;
  Attributes:= adParamSigned;
  Size:= 0;
end;
//------------------------------------------------------------------------------
destructor TParameterItem.Destroy;
begin
  inherited;
end;
//------------------------------------------------------------------------------
procedure TParameterItem.Assign(Source: TPersistent);
var src: TParameterItem;
begin
  inherited Assign(Source);
  if Source is TParameterItem then begin
    src:= TParameterItem(Source);
    Name:= src.Name;
    Value:= src.Value;
    Type_:= src.Type_;
    Direction:= src.Direction;
    Precision:= src.Precision;
    NumericScale:= src.NumericScale;
    Attributes:= src.Attributes;
    Size:= src.Size;
  end;
end;
//------------------------------------------------------------------------------
function TParameterItem.GetDisplayName: string;
begin
    result:= Name;
  if result='' then
    result:= inherited GetDisplayName;
end;
//------------------------------------------------------------------------------
procedure TParameterItems.AddParameter(Parameter: IParameter);
begin
  with Add do begin
    Name:= Parameter.Name;
    Value:= Parameter.Value;
    Type_:= Parameter.Type_;
    Direction:= Parameter.Get_Direction;
    Precision:= Parameter.Get_Precision;
    NumericScale:= Parameter.Get_NumericScale;
    Attributes:= Parameter.Get_Attributes;
    Size:= Parameter.Get_Size;
  end;
end;
//------------------------------------------------------------------------------
procedure TParameterItems.AddParamteters(Parameters: IParameters);
var i: integer;
begin
  for i:= 0 to Parameters.Count-1 do
    AddParameter(Parameters[i] as IParameter);
end;
//------------------------------------------------------------------------------
procedure TParameterItem.SetType_(const Value: DataTypeEnum);
begin
  FType_ := Value;
end;
//------------------------------------------------------------------------------
procedure TParameterItem.SetValue(const Value: OleVariant);
begin
  FValue := Value;
  FType_:= VarType(FValue);
end;
//------------------------------------------------------------------------------
{ TParameterItems }
//------------------------------------------------------------------------------
constructor TParameterItems.Create(Command: TCommand);
begin
  inherited Create(TParameterItem);
  FCommand:= Command;
end;
//------------------------------------------------------------------------------
function TParameterItems.Add: TParameterItem;
begin
  result:= inherited Add as TParameterItem;
end;
//------------------------------------------------------------------------------
function TParameterItems.GetItem(Index: Integer): TParameterItem;
begin
  result:= inherited GetItem(Index) as TParameterItem;
end;
//------------------------------------------------------------------------------
procedure TParameterItems.SetItem(Index: Integer; Value: TParameterItem);
begin
  inherited SetItem(Index, Value);
end;
//------------------------------------------------------------------------------
function TParameterItems.GetParametersArray: OleVariant;
var i: integer;
begin
  if Count = 0 then
    result:= EmptyParam
  else begin
  result:= VarArrayCreate([0, Count-1], varDispatch);
    for i:= 0 to Count-1 do
      result:= Parameters[i];
  end;
end;

function TParameterItems.GetParameters(index: integer): IParameter;
begin
  with Items[index] do begin
    result:= FCommand.CreateParameter(Name, Type_, Direction, Size, Value);
    if not Assigned(result) then
      DoAdoError(emCreateParameter);
    result.Precision:= Precision;
    result.NumericScale:= NumericScale;
    result.Set_Attributes(Attributes);
  end;
end;

end.