uado.pas

中式财务栏 表格式录入 运行时设置可显示列、列名、列宽

{*******************************************************}
{                                                       }
{       原生ADO                                         }
{                                                       }
{       版权所有 (C) 2008 咏南工作室(陈新光)            }
{                                                       }
{*******************************************************}

unit uADO;

interface

uses
  Variants,ComObj;

const
  adOpenDynamic = $00000002;
  adOpenStatic = $00000003;

  adLockOptimistic = $00000003;
  adLockBatchOptimistic = $00000004;

  adStateClosed = $00000000;
  adStateOpen = $00000001;
  adStateConnecting = $00000002;
  adStateExecuting = $00000004;
  adStateFetching = $00000008;

  adUseServer = $00000002;
  adUseClient = $00000003;

  adModeReadWrite = $00000003;

  adXactCursorStability = $00001000;

  adCmdText = $00000001;
  adCmdTable = $00000002;
  adCmdStoredProc = $00000004;
  adCmdFile = $00000100;

  adAffectCurrent = $00000001;
  adAffectGroup = $00000002;
  adAffectAll = $00000003;
  adAffectAllChapters = $00000004;

//创建 Connection 对象
function CreateConnection: OleVariant;
//释放 Connection 对象
procedure FreeConnection(var cnn: OleVariant);
//创建 Recordset 对象
function CreateRecordset: OleVariant;
//释放 Recordset 对象
procedure FreeRecordset(var rst: OleVariant);
//创建 Command 对象
function CreateCommand: OleVariant;
//释放 Command 对象；
procedure FreeCommand(var cmd: OleVariant);
//用 Connection 连接到 SQLServer 数据库；
//cnn 为 Connection 对象，db 数据库名，host 主机名，usr 用户名，pwd 密码
function ConnectToDB(cnn: OleVariant; const db, host, usr, pwd: string): Boolean;
//执行 SQL 语句，有返回行，无事务处理；
//cnn 为 Connection 对象，rst 为 Recordset 对象，sql 为 SQL 语句（可以是存储过程）
function ExecSQL(cnn, rst: OleVariant; const sql: string): Boolean;
//执行 SQL 语句，无返回行，有事务处理；
//cnn 为 Connection 对象，cmd 为 Command 对象，sql 为 SQL 语句（可以是存储过程）
function ExecSQLA(cnn, cmd: OleVariant; const sql: string): Boolean;

implementation

function CreateConnection: OleVariant;
begin
  try
    Result := CreateOleObject('ADODB.Connection');
    Result.CursorLocation := adUseServer;
    Result.IsolationLevel := adXactCursorStability;
    Result.Mode := adModeReadWrite;
    Result.Provider := 'SQLOLEDB.1';
  except
    if not VarIsEmpty(Result) then Result := Unassigned;
  end;
end;

procedure FreeConnection(var cnn: OleVariant);
begin
  if not VarIsEmpty(cnn) then
  begin
    if cnn.State <> adStateClosed then cnn.Close;
    cnn := Unassigned;
  end;
end;

function CreateRecordset: OleVariant;
begin
  try
    Result := CreateOleObject('ADODB.Recordset');
    Result.CacheSize := 1000;
    Result.CursorType := adOpenStatic;
    Result.CursorLocation := adUseServer;
    Result.LockType := adLockOptimistic;
  except
    if not VarIsEmpty(Result) then Result := Unassigned;
  end;
end;

procedure FreeRecordset(var rst: OleVariant);
begin
  FreeConnection(rst);
end;

function CreateCommand: OleVariant;
begin
  try
    Result := CreateOleObject('ADODB.Command');
    Result.CommandType := adCmdText;
    Result.CommandTimeout := 5;
  except
    if not VarIsEmpty(Result) then Result := Unassigned;
  end;
end;

procedure FreeCommand(var cmd: OleVariant);
begin
  if not VarIsEmpty(cmd) then cmd := Unassigned;
end;

function ConnectToDB(cnn: OleVariant; const db, host, usr, pwd: string): Boolean;
begin
  Result := not VarIsEmpty(cnn);
  if Result then
  begin
    if cnn.State <> adStateClosed then cnn.Close;
    cnn.ConnectionString :=
      'Provider=SQLOLEDB.1;Persist Security Info=True;Initial Catalog=' +
      db + ';Data Source=' + host + ';Connect Timeout=5;' +
      'Use Procedure for Prepare=1';
    try
      cnn.Open(cnn.ConnectionString, usr, pwd, -1);
    except
      Result := False;
    end;
  end;
end;

function ExecSQL(cnn, rst: OleVariant; const sql: string): Boolean;
begin
  Result := not (VarIsEmpty(cnn) or VarIsEmpty(rst)) and (cnn.State = adStateOpen);
  if Result then
  begin
    if rst.State <> adStateClosed then rst.Close;
    try
      rst.Open(sql, cnn, adOpenStatic, adLockOptimistic, adCmdText);
    except
      Result := False;
    end;
  end;
end;

function ExecSQLA(cnn, cmd: OleVariant; const sql: string): Boolean;
begin
  Result := not (VarIsEmpty(cnn) or VarIsEmpty(cmd)) and (cnn.State = adStateOpen);
  if Result then
  begin
    cnn.BeginTrans;
    try
      cmd.ActiveConnection := cnn;
      cmd.CommandText := sql;
      cmd.Prepared := True;
      cmd.Execute;
      cnn.CommitTrans;
    except
      cnn.RollbackTrans;
      Result := False;
    end;
  end;
end;

end.