⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 clob.pas

📁 Oracle Data Access Components Source Code ODAC v.6.70.0.45
💻 PAS
字号:
unit Clob;

interface

uses
{$IFDEF LINUX}
  SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs, QStdCtrls,
  QDBCtrls, QComCtrls, QExtCtrls, QGrids, QDBGrids, QButtons, OdacClx,
{$ELSE}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DBCtrls, ExtCtrls, Grids, DBGrids, StdCtrls, ToolWin, ComCtrls, Buttons,
  OdacVcl,
{$ENDIF}
{$IFDEF FPC}
  LResources,
{$ENDIF}
  DB, {$IFNDEF FPC}MemDS{$ELSE}MemDataSet{$ENDIF},
  Ora, DAScript, OraScript, DBAccess, MemData, OdacDemoFrame, OdacDemoForm;

type
  TClobFrame = class(TOdacDemoFrame)
    DBGrid: TDBGrid;
    dsData: TDataSource;
    ToolBar: TPanel;
    meComments: TDBMemo;
    quInsertRecord: TOraQuery;
    quCopyRecord: TOraQuery;
    quSelectRecord: TOraQuery;
    Splitter1: TSplitter;
    Query: TOraQuery;
    ToolBar1: TPanel;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    Panel2: TPanel;
    DBNavigator: TDBNavigator;
    btClose: TSpeedButton;
    btOpen: TSpeedButton;
    btCopyRecord2: TSpeedButton;
    btCopyRecord1: TSpeedButton;
    btCopyRecord: TSpeedButton;
    Panel1: TPanel;
    btClear: TSpeedButton;
    btSave: TSpeedButton;
    btLoad: TSpeedButton;
    Panel3: TPanel;
    Panel4: TPanel;
    cbDefLobRead: TCheckBox;
    cbCacheLobs: TCheckBox;
    Panel5: TPanel;
    cbTemporaryLobUpdate: TCheckBox;
    Panel6: TPanel;
    procedure btOpenClick(Sender: TObject);
    procedure btCloseClick(Sender: TObject);
    procedure btCopyRecordClick(Sender: TObject);
    procedure btCopyRecord1Click(Sender: TObject);
    procedure btCopyRecord2Click(Sender: TObject);
    procedure btLoadClick(Sender: TObject);
    procedure btSaveClick(Sender: TObject);
    procedure btLoad1Click(Sender: TObject);
    procedure btClearClick(Sender: TObject);
    procedure cbDefLobReadClick(Sender: TObject);
    procedure cbCacheLobsClick(Sender: TObject);
    procedure cbTemporaryLobUpdateClick(Sender: TObject);
  private
  public
    procedure Initialize; override;
    procedure SetDebug(Value: boolean); override;
  end;

implementation

{$IFNDEF FPC}
{$IFDEF CLR}
{$R *.nfm}
{$ENDIF}
{$IFDEF WIN32}
{$R *.dfm}
{$ENDIF}
{$IFDEF LINUX}
{$R *.xfm}
{$ENDIF}
{$ENDIF}

procedure TClobFrame.btOpenClick(Sender: TObject);
begin
  Query.Open;
end;

procedure TClobFrame.btCloseClick(Sender: TObject);
begin
  Query.Close;
end;

procedure TClobFrame.btCopyRecordClick(Sender: TObject);
begin
  if not Query.EOF then begin
    quInsertRecord.ParamByName('Code').AsInteger :=
      Query.FieldByName('Code').AsInteger;
    quInsertRecord.ParamByName('Title').AsString :=
      Query.FieldByName('Title').AsString;
    quInsertRecord.ParamByName('Value').DataType := ftOraClob;
    quInsertRecord.ParamByName('Value').AsString :=
      Query.FieldByName('Value').AsString;
    quInsertRecord.Execute;

    Query.Refresh;
  end;
end;

procedure TClobFrame.btCopyRecord1Click(Sender: TObject);
begin
  if not Query.EOF then begin
    quSelectRecord.ParamByName('RowId').AsString :=
      Query.FieldByName('RowId').AsString;
    quSelectRecord.ParamByName('Value').DataType := ftOraClob;
    quSelectRecord.Execute;

    quInsertRecord.ParamByName('Code').AsInteger :=
      quSelectRecord.ParamByName('Code').AsInteger;
    quInsertRecord.ParamByName('Title').AsString :=
      quSelectRecord.ParamByName('Title').AsString;
    quInsertRecord.ParamByName('Value').DataType := ftOraClob;
    quInsertRecord.ParamByName('Value').AsString :=
      quSelectRecord.ParamByName('Value').AsString;

    quInsertRecord.Execute;

    Query.Refresh;
  end;
end;

procedure TClobFrame.btCopyRecord2Click(Sender: TObject);
begin
  if not Query.EOF then begin
    quCopyRecord.ParamByName('RowId').AsString :=
      Query.FieldByName('RowId').AsString;
    quCopyRecord.Execute;

    Query.Refresh;
  end;
end;

procedure TClobFrame.Initialize;
begin
  inherited;

  Query.Connection := Connection;
  quSelectRecord.Connection := Connection;
  quInsertRecord.Connection := Connection;
  quCopyRecord.Connection := Connection;

  cbDefLobRead.Checked := Query.Options.DeferredLobRead;
  cbCacheLobs.Checked := Query.Options.CacheLobs;
  cbTemporaryLobUpdate.Checked := Query.Options.TemporaryLobUpdate;
end;

procedure TClobFrame.SetDebug(Value: boolean);
begin
  Query.Debug := Value;
  quSelectRecord.Debug := Value;
  quInsertRecord.Debug := Value;
  quCopyRecord.Debug := Value;
end;

procedure TClobFrame.btLoadClick(Sender: TObject);
begin
  if Query.Active and OpenDialog.Execute then begin
    if Query.State = dsBrowse then
      Query.Edit;
    TBlobField(Query.FieldByName('Value')).LoadFromFile(OpenDialog.FileName);
  end;
end;

procedure TClobFrame.btLoad1Click(Sender: TObject);
var
  Stream: TStream;
  BlobStream: TStream;
begin
  if Query.Active and OpenDialog.Execute then begin
    if Query.State = dsBrowse then
      Query.Edit;

    Stream := nil;
    BlobStream := nil;
    try
      Stream := TFileStream.Create(OpenDialog.FileName, fmOpenRead);
      BlobStream := Query.CreateBlobStream(
        Query.FieldByName('Value'), bmWrite);

      BlobStream.CopyFrom(Stream, 0);
    finally
      BlobStream.Free;
      Stream.Free;
    end;
  end;
end;

procedure TClobFrame.btSaveClick(Sender: TObject);
begin
  if not Query.EOF and SaveDialog.Execute then
    TBlobField(Query.FieldByName('Value')).SaveToFile(SaveDialog.FileName);
end;

procedure TClobFrame.btClearClick(Sender: TObject);
begin
  if Query.Active then begin
    if Query.State = dsBrowse then
      Query.Edit;
    Query.FieldByName('Value').AsString := '';
  end;
end;

procedure TClobFrame.cbDefLobReadClick(Sender: TObject);
begin
  Query.Options.DeferredLobRead := cbDefLobRead.Checked;
end;

procedure TClobFrame.cbCacheLobsClick(Sender: TObject);
begin
  try
    Query.Options.CacheLobs := cbCacheLobs.Checked;
  except
    cbCacheLobs.Checked := Query.Options.CacheLobs;
    raise;
  end;
end;

procedure TClobFrame.cbTemporaryLobUpdateClick(Sender: TObject);
begin
  Query.Options.TemporaryLobUpdate := cbTemporaryLobUpdate.Checked;
end;

initialization
{$IFDEF FPC}
{$I Clob.lrs}
{$ENDIF}

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -