StorageProc+Blob+Odac

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

Комментарии

  • отредактировано 14:39
    вот, если подойдет:
    { Êîìïîíåíò-îáåðòêà íàä 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.
    
  • отредактировано 14:39
    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
    
  • Stalker4Stalker4 123
    отредактировано 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, но он по непонятным причинам не захотел этого сделать. ;)
  • nrjnrj
    отредактировано 14:39
    Спасибо за информацию, буду пробывать писать.
    Если у кого есть еще что сказать с удовольствием выслушаю.
    To Stalker4: О RefCursor знаю, попробую использовать, но
    это только выходные параметры, а как-же блоб на входе?
  • Stalker4Stalker4 123
    отредактировано 14:39
    А какие у тебя проблеммы с блобом на входе ?


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

Многофункциональный текстовый редактор. Чтобы отредактировать стиль параграфа, нажмите TAB, чтобы перейти к меню абзаца. Там вы можете выбрать стиль. По умолчанию не выбран ни один стиль. Когда вы выберете текст, появится встроенное меню форматирования. Нажмите TAB, чтобы войти в него. Некоторые элементы, такие как многофункциональные вставки ссылок, картинок, индикаторов загрузки и сообщений об ошибок могут быть вставлены в редактор. Вы можете перемещаться по ним, используя стрелки внутри редактора и удалять с помощью клавиш delete или backspace.