StorageProc+Blob+Odac

nrj · March 2006

Нужно вызвать из процедуры ДИАЛОГОВОЙ ФОРМЫ процедуру ORACLE.
Хотелось бы передать в нее параметры типа Blob и получить в выходном
параметре тоже Blob -значение. (Использую ODAC)
При использовании компоненты Query по выполнении команды OPEN
выдается сообщение - нет выбранных строк (логично, процедура не
возвращает записей), если-же использую EXECSQL - не работает передача
и возврат параметров.
Я думаю, что неправильно работать с Query,правильно было-бы работать
с StoredProc. Однако в стандартной поставке нет примера как создать
класс StoredProc, а знаний маловато.
Может кто-нибудь уже написал класс StoredProc для ODAC,
поделитесь плиз. Не обязательно для ODAC можно для ADO или
другой базы данных - был-бы пример.
P.S. С возможностью использования пользовательских функций знаком.

dimm · March 2006

вот, если подойдет:

{ Êîìïîíåíò-îáåðòêà íàä TADOStoredProc äëÿ FR3 }

unit frxADOStoredProc;

interface

uses frxCustomDB, frxClass, ADODB, Classes, frxDsgnIntf, frxADOComponents,
  frxEditADOStoredProcParams, Controls, SysUtils, frxUtils, fs_iinterpreter;

type TfrxADOStoredProc = class (TfrxCustomDataset)
  private
    FDatabase: TfrxADODatabase;
    FStoredProc: TADOStoredProc;
    FParams: TfrxParams;
    procedure SetDatabase(Value: TfrxADODatabase);
    procedure SetParams(Value: TfrxParams);
    function  GetProcName: WideString;
    procedure SetProcName(const Value: WideString);
    procedure ReadData(Reader: TReader);
    procedure WriteData(Writer: TWriter);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    class function GetDescription: String; override;
    procedure UpdateParams;
  protected
    procedure DefineProperties(Filer: TFiler); override;
  published
    property Database: TfrxADODatabase read FDatabase write SetDatabase;
    property ProcedureName: WideString read GetProcName write SetProcName;
    property Params: TfrxParams read FParams write SetParams;
  end;

     TfrxProcNameProperty = class(TfrxStringProperty)
  public
    function GetAttributes: TfrxPropertyAttributes; override;
    function GetExtraLBSize: Integer; override;
    procedure GetValues; override;
  end;

     TfrxADOStoredProcParamsProperty = class(TfrxClassProperty)
  public
    function GetAttributes: TfrxPropertyAttributes; override;
    function Edit: Boolean; override;
  end;

  TfrxADOStoredProcFunctions = class(TfsRTTIModule)
  private
    function CallMethod(Instance: TObject; ClassType: TClass;
                        const MethodName: String; Caller: TfsMethodHelper): Variant;
  public
    constructor Create(AScript: TfsScript); override;
  end;

implementation

{ TfrxADOStoredProcFunctions }

constructor TfrxADOStoredProcFunctions.Create(AScript: TfsScript);
begin
  inherited Create(AScript);
  with AScript do
  begin
    with AddClass(TfrxADOStoredProc, 'TfrxCustomDataset') do
      AddMethod('procedure UpdateParams', CallMethod);
  end;
end;

function TfrxADOStoredProcFunctions.CallMethod(Instance: TObject; ClassType: TClass;
  const MethodName: String; Caller: TfsMethodHelper): Variant;
begin
  Result := 0;

  if ClassType = TfrxADOStoredProc then
  begin
    if MethodName = 'UPDATEPARAMS' then
      TfrxADOStoredProc(Instance).UpdateParams;
  end
end;

{ TfrxADOStoredProc }

procedure TfrxADOStoredProc.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineProperty('Parameters', ReadData, WriteData, True);
end;

procedure TfrxADOStoredProc.ReadData(Reader: TReader);
begin
  frxReadCollection(FParams, Reader, Self);
  UpdateParams;
end;

procedure TfrxADOStoredProc.WriteData(Writer: TWriter);
begin
  frxWriteCollection(FParams, Writer, Self);
end;

procedure TfrxADOStoredProc.UpdateParams;
var
  i: Integer;
  Item: TfrxParamItem;
begin
  FStoredProc.Parameters.Clear;
  for i := 0 to Params.Count - 1 do begin
    Item := Params.Items[i];
    with FStoredProc.Parameters.AddParameter do begin
      Name := Item.Name;
      DataType := Item.DataType;
      Attributes := [paNullable];
      Value := Item.Value;
    end;
  end;
end;

function TfrxADOStoredProc.GetProcName: WideString;
begin
  Result := FStoredProc.ProcedureName;
end;

procedure TfrxADOStoredProc.SetProcName(const Value: WideString);
begin
  FStoredProc.ProcedureName:=Value;
end;

procedure TfrxADOStoredProc.SetParams(Value: TfrxParams);
begin
  FParams.Assign(Value);
end;

class function TfrxADOStoredProc.GetDescription: String;
begin
  Result := 'ADO Stored Proc';
end;

constructor TfrxADOStoredProc.Create(AOwner: TComponent);
begin
  FStoredProc := TADOStoredProc.Create(nil);
  Dataset := FStoredProc;
  SetDatabase(nil);
  FParams := TfrxParams.Create;
  inherited;
end;

destructor TfrxADOStoredProc.Destroy;
begin
  FParams.Free;
  inherited;
end;

procedure TfrxADOStoredProc.SetDatabase(Value: TfrxADODatabase);
begin
  FDatabase := Value;
  if Value <> nil then
    FStoredProc.Connection := Value.Database
  else if ADOComponents <> nil then
    FStoredProc.Connection := ADOComponents.DefaultDatabase
  else
    FStoredProc.Connection := nil;
  DBConnected := FStoredProc.Connection <> nil;
end;

{ TfrxProcNameProperty }
function TfrxProcNameProperty.GetExtraLBSize: Integer;
begin
Result := 0;
end;

function TfrxProcNameProperty.GetAttributes: TfrxPropertyAttributes;
begin
  Result := [paMultiSelect, paValueList, paSortList];
end;

procedure TfrxProcNameProperty.GetValues;
var t: TADOConnection;
begin
inherited;
if TfrxADOStoredProc(Component).Database <> nil then t := TfrxADOStoredProc(Component).Database.Database
                                                else t := nil;
if t <> nil then t.GetProcedureNames(Values);
end;

{ TfrxADOStoredProcParamsProperty }

function TfrxADOStoredProcParamsProperty.Edit: Boolean;
var
  q: TfrxADOStoredProc;
begin
  q := TfrxADOStoredProc(Component);
  with TfrxADOStoredProcParamsEditorForm.Create(Designer) do begin
    Params := q.Params;
    Result := ShowModal = mrOk;
    if Result then
      q.UpdateParams;
    Free;
  end;
end;

function TfrxADOStoredProcParamsProperty.GetAttributes: TfrxPropertyAttributes;
begin
  Result := [paDialog, paReadOnly];
end;

initialization
  frxObjects.RegisterObject1(TfrxADOStoredProc, nil, '', 'ADO', 0, 38);
  frxPropertyEditors.Register(TypeInfo(String), TfrxADOStoredProc, 'ProcedureName', TfrxProcNameProperty);
  frxPropertyEditors.Register(TypeInfo(TfrxParams), TfrxADOStoredProc, 'Params', TfrxADOStoredProcParamsProperty);
  fsRTTIModules.Add(TfrxADOStoredProcFunctions);

end.

unit frxEditADOStoredProcParams;

interface

{$I frx.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, Buttons, DB, frxCustomDB, frxCtrls, ExtCtrls
{$IFDEF Delphi6}
, Variants
{$ENDIF};


type
  TfrxADOStoredProcParamsEditorForm = class(TForm)
    ParamsLV: TListView;
    TypeCB: TComboBox;
    ValueE: TEdit;
    OkB: TButton;
    CancelB: TButton;
    ButtonPanel: TPanel;
    ExpressionB: TSpeedButton;
    AddBtn: TButton;
    procedure AddBtnClick(Sender: TObject);
    procedure ParamsLVSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure FormShow(Sender: TObject);
    procedure ParamsLVMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure OkBClick(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ValueEButtonClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    FParams: TfrxParams;
  public
    property Params: TfrxParams read FParams write FParams;
  end;

implementation

{$R *.DFM}

uses frxClass, frxRes;


{ TfrxParamEditorForm }

procedure TfrxADOStoredProcParamsEditorForm.FormShow(Sender: TObject);
var
  i: Integer;
  t: TFieldType;
  Item: TListItem;
begin
  for i := 0 to Params.Count - 1 do
  begin
    Item := ParamsLV.Items.Add;
    Item.Caption := Params[i].Name;
    Item.SubItems.Add(FieldTypeNames[Params[i].DataType]);
    Item.SubItems.Add(Params[i].Expression);
  end;

  for t := Low(TFieldType) to High(TFieldType) do
    TypeCB.Items.Add(FieldTypeNames[t]);

  ParamsLV.Selected := ParamsLV.Items[0];
  ValueE.Height := TypeCB.Height;
  ButtonPanel.Height := TypeCB.Height - 2;
  ExpressionB.Height := TypeCB.Height - 2;
end;

procedure TfrxADOStoredProcParamsEditorForm.FormHide(Sender: TObject);
var
  i: Integer;
  t: TFieldType;
  Item: TListItem;
begin
  if ModalResult <> mrOk then Exit;

  for i := 0 to ParamsLV.Items.Count - 1 do
  begin
    Item := ParamsLV.Items[i];
    Params[i].Name := Item.Caption;
    for t := Low(TFieldType) to High(TFieldType) do
      if Item.SubItems[0] = FieldTypeNames[t] then
        Params[i].DataType := t;
    Params[i].Expression := Item.SubItems[1];
  end;
end;

procedure TfrxADOStoredProcParamsEditorForm.ParamsLVSelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  if Selected then
  begin
    TypeCB.Top := ParamsLV.Top + Item.Top;
    ValueE.Top := TypeCB.Top;
    ButtonPanel.Top := TypeCB.Top;
    TypeCB.ItemIndex := TypeCB.Items.IndexOf(Item.SubItems[0]);
    ValueE.Text := Item.SubItems[1];
  end
  else
  begin
    Item.SubItems[0] := TypeCB.Text;
    Item.SubItems[1] := ValueE.Text;
  end;
end;

procedure TfrxADOStoredProcParamsEditorForm.ParamsLVMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ParamsLV.Selected := ParamsLV.GetItemAt(5, Y);
  ParamsLV.ItemFocused := ParamsLV.Selected;
end;

procedure TfrxADOStoredProcParamsEditorForm.OkBClick(Sender: TObject);
begin
  ParamsLV.Selected := ParamsLV.Items[0];
end;

procedure TfrxADOStoredProcParamsEditorForm.ValueEButtonClick(Sender: TObject);
var
  s: String;
begin
  s := TfrxCustomDesigner(Owner).InsertExpression(ValueE.Text);
  if s <> '' then
    ValueE.Text := s;
end;

procedure TfrxADOStoredProcParamsEditorForm.FormCreate(Sender: TObject);
begin
{$IFDEF FR_COM}
  Icon.Handle := LoadIcon(hInstance, 'SDESGNICON');
{$ENDIF}
  Caption := frxGet(3700);
  OkB.Caption := frxGet(1);
  CancelB.Caption := frxGet(2);
  ParamsLV.Columns[0].Caption := frxResources.Get('qpName');
  ParamsLV.Columns[1].Caption := frxResources.Get('qpDataType');
  ParamsLV.Columns[2].Caption := frxResources.Get('qpValue');
end;

procedure TfrxADOStoredProcParamsEditorForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_F1 then
    frxResources.Help(Self);
end;

procedure TfrxADOStoredProcParamsEditorForm.AddBtnClick(Sender: TObject);
var   Item: TListItem;
  Par: TfrxParamItem;
  x:TfrxParams;
begin
  Item := ParamsLV.Items.Add;
  Item.Caption := '<Name>';
  Item.SubItems.Add(FieldTypeNames[ftUnknown]);
  Item.SubItems.Add('');
  Par := Params.Add;
  Par.Name:='<Name>';
  Par.DataType:=ftUnknown;
  Par.Expression:='';
  Par.Value:='';
end;

end.

dimm · March 2006

object frxADOStoredProcParamsEditorForm: TfrxADOStoredProcParamsEditorForm
  Left = 186
  Top = 107
  ActiveControl = ParamsLV
  BorderStyle = bsDialog
  Caption = 'Parameters editor'
  ClientHeight = 381
  ClientWidth = 392
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  KeyPreview = True
  OldCreateOrder = True
  Position = poScreenCenter
  OnCreate = FormCreate
  OnHide = FormHide
  OnKeyDown = FormKeyDown
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object ParamsLV: TListView
    Left = 4
    Top = 4
    Width = 384
    Height = 337
    Columns = <
      item
        Caption = 'Name'
        MaxWidth = 100
        MinWidth = 100
        Width = 100
      end
      item
        Caption = 'Data type'
        MaxWidth = 80
        MinWidth = 80
        Width = 80
      end
      item
        Caption = 'Value'
        MaxWidth = 200
        MinWidth = 200
        Width = 200
      end>
    ColumnClick = False
    ParentShowHint = False
    ShowHint = False
    TabOrder = 0
    ViewStyle = vsReport
    OnMouseUp = ParamsLVMouseUp
    OnSelectItem = ParamsLVSelectItem
  end
  object TypeCB: TComboBox
    Left = 104
    Top = 23
    Width = 84
    Height = 19
    Style = csOwnerDrawFixed
    ItemHeight = 13
    TabOrder = 1
  end
  object ValueE: TEdit
    Left = 184
    Top = 23
    Width = 184
    Height = 21
    TabOrder = 2
  end
  object OkB: TButton
    Left = 232
    Top = 348
    Width = 75
    Height = 25
    Caption = 'OK'
    ModalResult = 1
    TabOrder = 3
    OnClick = OkBClick
  end
  object CancelB: TButton
    Left = 312
    Top = 348
    Width = 75
    Height = 25
    Cancel = True
    Caption = 'Cancel'
    ModalResult = 2
    TabOrder = 4
  end
  object ButtonPanel: TPanel
    Left = 368
    Top = 24
    Width = 17
    Height = 17
    BevelOuter = bvNone
    TabOrder = 5
    object ExpressionB: TSpeedButton
      Left = 0
      Top = 0
      Width = 17
      Height = 17
      Glyph.Data = {
        D6000000424DD60000000000000076000000280000000C0000000C0000000100
        0400000000006000000000000000000000001000000010000000000000000000
        80000080000000808000800000008000800080800000C0C0C000808080000000
        FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00707777777777
        0000770777777777000077087007007700007780778007770000778087700077
        0000777087007807000077780777777700007700000777770000777708777777
        0000777700780777000077777000777700007777777777770000}
      OnClick = ValueEButtonClick
    end
  end
  object AddBtn: TButton
    Left = 8
    Top = 352
    Width = 75
    Height = 25
    Caption = 'Add'
    TabOrder = 6
    OnClick = AddBtnClick
  end
end

Stalker4 · March 2006

nrj написал:

Нужно вызвать из процедуры ДИАЛОГОВОЙ ФОРМЫ процедуру ORACLE.
Хотелось бы передать в нее параметры типа Blob и получить в выходном
параметре тоже Blob -значение. (Использую ODAC)
При использовании компоненты Query по выполнении команды OPEN
выдается сообщение - нет выбранных строк (логично, процедура не
возвращает записей), если-же использую EXECSQL - не работает передача
и возврат параметров.

Я бы тебе посоветовал, не заморачиваться с TStoredProc, а просто немного поменять свою SP: сделай так, что бы она возвращала результат не в виде Output параметра, а в виде курсора (Result Set).

То что написал dimm в общем то правильно, за исключением одного важного момента: Он для работы с параметрами использовал класс TfrxParamItem, а этот класс имеет один недостаток - он не поддерживает свойство ParamType и соответственно нет возможности задать вид параметра ptUnknown, ptInput, ptOutput, ptInputOutput, ptResult. Так что боюсь компонент frxADOStoredProc тебе не поможет.

P.S. Я еще во время альфа-тестирования FR3 предлагал Александру добавить в класс TfrxParamItem свойство ParamType, но он по непонятным причинам не захотел этого сделать.

nrj · March 2006

Спасибо за информацию, буду пробывать писать.
Если у кого есть еще что сказать с удовольствием выслушаю.
To Stalker4: О RefCursor знаю, попробую использовать, но
это только выходные параметры, а как-же блоб на входе?

Stalker4 · March 2006

А какие у тебя проблеммы с блобом на входе ?

StorageProc+Blob+Odac

Комментарии

Оставить комментарий