博超简谈 發表於 2020-12-3 14:54:00

【Delphi】Utils.Generics.ADODB

<pre><code class="language-delphi">unit Utils.Generics.ADODB;

interface

uses
    System.Classes, System.TypInfo, System.Win.ComObj, System.Generics.Collections,
    Winapi.ActiveX, Data.DB, Data.Win.ADODB;

type

    {
      TMPropList class type
    }

    TMPropList = class(TObject)
    private
      FPropCount: Integer;
      FPropList: PPropList;
    protected
      function GetPropName(x: Integer): ShortString;
      function GetProp(x: Integer): PPropInfo;
    public
      constructor Create(aObj: TPersistent);
      destructor Destroy; override;
      property PropCount: Integer read FPropCount;
      property PropNames: ShortString read GetPropName;
      property Props: PPropInfo read GetProp;
    end;

////////////////////////////////////////////////////////////////////////////////

    {
      TDbSetProxy class type
    }

    TDbSetProxy = class(TPersistent)
    private
      FDataSet: TDataSet;
      FPropList: TMPropList;
      FIsLoop: Boolean;
    protected
      procedure BeginEdit;
      procedure EndEdit;
      function GetInteger(x: Integer): Integer; virtual;
      function GetFloat(x: Integer): Double; virtual;
      function GetString(x: Integer): string; virtual;
      function GetVariant(x: Integer): Variant; virtual;
      procedure SetInteger(x: Integer; aValue: Integer); virtual;
      procedure SetFloat(x: Integer; aValue: Double); virtual;
      procedure SetString(x: Integer; aValue: string); virtual;
      procedure SetVariant(x: Integer; aValue: Variant); virtual;
    public
      destructor Destroy; override;
      procedure AfterConstruction; override;
      procedure Init(ds: TDataSet);
      function HasNext: Boolean;
      function RecordCount: Integer;
      property DataSet: TDataSet read FDataSet;
    end;

////////////////////////////////////////////////////////////////////////////////

    {
      TDbParameter class type
    }

    TDbParameter = class(TObject)
    private
      thisKey: string;
      thisValue: Variant;
      thisDataType: TDataType;
      thisSize: Integer;
    public
      constructor Create(key: string; value: Variant); overload;
      constructor Create(key: string; value: Variant; dataType: TFieldType; size: Integer); overload;
      function GetKey: string;
      procedure SetKey(key: string);
      function GetValue: Variant;
      procedure SetValue(value: Variant);
      function GetDataType: TDataType;
      procedure SetDataType(dataType: TDataType);
      function GetSize: Integer;
      procedure SetSize(size: Integer);
    published
      property key: string read GetKey write SetKey;
      property value: Variant read GetValue write SetValue;
      property dataType: TDataType read GetDataType write SetDataType;
      property size: Integer read GetSize write SetSize;
    end;

////////////////////////////////////////////////////////////////////////////////

    {
      TDbOperation class type
    }

    TDbOperation = class(TObject)
    private
                { 连接字符串 }
      thisConnectionString: string;
                { 关闭Command }
      procedure CloseCommand(cmd: TADOCommand);
    public
                { ctor }
      constructor Create(connstr: string); overload;
                { 获取一个连接 }
      function GetConnection(): TADOConnection;
                { 执行单条CUD }
      function ExecSQL(sql: string): Boolean; overload;
                { 执行单条CUD, 参数化 }
      function ExecSQL(sql: string; parms: TObjectList&lt;TDbParameter&gt;): Boolean; overload;
                { 批量执行CUD }
      function BatchExecSQL(sqls: TList&lt;string&gt;): Boolean;
                { 获取单个值的R }
      function GetSingle(sql: string): Variant; overload;
                { 获取单个值的R,参数化 }
      function GetSingle(sql: string; parms: TObjectList&lt;TDbParameter&gt;): Variant; overload;
                { 获取一个Query对象 }
      function GetQuery(sql: string): TADOQuery; overload;
                { 获取一个Query对象, 参数化 }
      function GetQuery(sql: string; parms: TObjectList&lt;TDbParameter&gt;): TADOQuery; overload;
      { 获取一个 DbSetProxy 对象 }
      function GetDbSet&lt;T: TDbSetProxy, constructor&gt;(sql: string): T; overload;
                { 获取一个 DbSetProxy 对象, 参数化 }
      function GetDbSet&lt;T: TDbSetProxy, constructor&gt;(sql: string; parms: TObjectList&lt;TDbParameter&gt;): T; overload;
                { 关闭Query }
      procedure CloseQuery(query: TADOQuery);
                { 关闭连接 }
      procedure CloseConnection(connection: TADOConnection);
                { 关闭Query及连接 }
      procedure Close(query: TADOQuery; connection: TADOConnection);
    end;

implementation


{
    TMPropList Class implementation
}

constructor TMPropList.Create(aObj: TPersistent);
begin
    FPropCount := GetTypeData(aObj.ClassInfo)^.PropCount;
    FPropList := Nil;
    if FPropCount &gt; 0 then begin
      GetMem(FPropList, FPropCount * SizeOf(Pointer));
      GetPropInfos(aObj.ClassInfo, FPropList);
    end;
end;

destructor TMPropList.Destroy;
begin
    if Assigned(FPropList) then
      FreeMem(FPropList);
    inherited;
end;

function TMPropList.GetProp(x: Integer): PPropInfo;
begin
    Result := Nil;
    if (Assigned(FPropList)) then
      Result := FPropList;
end;

function TMPropList.GetPropName(x: Integer): ShortString;
begin
    Result := GetProp(x)^.Name;
end;


////////////////////////////////////////////////////////////////////////////////

{
    TDbSetProxy Class implementation
}

procedure TDbSetProxy.Init(ds: TDataSet);
begin
    FDataSet := ds;
    FDataSet.Open;
    FIsLoop := false;
end;

destructor TDbSetProxy.Destroy;
var
    conn: TADOConnection;
begin
    FPropList.Free;
    if Assigned(FDataSet) then begin
      if FDataSet is TADOQuery then begin
            conn := TADOQuery(FDataSet).connection;
            conn.Close;
            conn.Free;
            conn := nil;
      end;
      FDataSet.Close;
      FDataSet.Free;
      FDataSet := nil;
    end;
    inherited;
end;

procedure TDbSetProxy.AfterConstruction;
begin
    inherited;
    FPropList := TMPropList.Create(Self);
end;

procedure TDbSetProxy.BeginEdit;
begin
    if (FDataSet.State &lt;&gt; dsEdit) and (FDataSet.State &lt;&gt; dsInsert) then
      FDataSet.Edit;
end;

procedure TDbSetProxy.EndEdit;
begin
    if (FDataSet.State = dsEdit) or (FDataSet.State = dsInsert) then
      FDataSet.Post;
end;

function TDbSetProxy.GetInteger(x: Integer): Integer;
begin
    Result := FDataSet.FieldByName(FPropList.PropNames).AsInteger;
end;

function TDbSetProxy.GetFloat(x: Integer): Double;
begin
    Result := FDataSet.FieldByName(FPropList.PropNames).AsFloat;
end;

function TDbSetProxy.GetString(x: Integer): string;
begin
    Result := FDataSet.FieldByName(FPropList.PropNames).AsString;
end;

function TDbSetProxy.GetVariant(x: Integer): Variant;
begin
    Result := FDataSet.FieldByName(FPropList.PropNames).value;
end;

procedure TDbSetProxy.SetInteger(x, aValue: Integer);
begin
    BeginEdit;
    FDataSet.FieldByName(FPropList.PropNames).AsInteger := aValue;
end;

procedure TDbSetProxy.SetFloat(x: Integer; aValue: Double);
begin
    BeginEdit;
    FDataSet.FieldByName(FPropList.PropNames).AsFloat := aValue;
end;

procedure TDbSetProxy.SetString(x: Integer; aValue: string);
begin
    BeginEdit;
    FDataSet.FieldByName(FPropList.PropNames).AsString := aValue;
end;

procedure TDbSetProxy.SetVariant(x: Integer; aValue: Variant);
begin
    BeginEdit;
    FDataSet.FieldByName(FPropList.PropNames).value := aValue;
end;

function TDbSetProxy.HasNext: Boolean;
begin
    Result := not FDataSet.Eof;
    if FIsLoop then begin
      EndEdit;
      FDataSet.Next;
      Result := not FDataSet.Eof;
      if not Result then begin
            FDataSet.First;
            FIsLoop := false;
      end;
    end
    else if Result then begin
      FIsLoop := true;
    end;
end;

function TDbSetProxy.RecordCount: Integer;
begin
    Result := FDataSet.RecordCount;
end;


////////////////////////////////////////////////////////////////////////////////

{
    TDbParameter Class implementation
}

function TDbParameter.GetKey;
begin
    Result := thisKey;
end;

procedure TDbParameter.SetKey(key: string);
begin
    thisKey := key;
end;

function TDbParameter.GetValue;
begin
    Result := thisValue;
end;

procedure TDbParameter.SetValue(value: Variant);
begin
    thisValue := value;
end;

function TDbParameter.GetDataType;
begin
    Result := thisDataType;
end;

procedure TDbParameter.SetDataType(dataType: TFieldType);
begin
    thisDataType := dataType;
end;

function TDbParameter.GetSize;
begin
    Result := thisSize;
end;

procedure TDbParameter.SetSize(size: Integer);
begin
    thisSize := size;
end;

constructor TDbParameter.Create(key: string; value: Variant);
begin
    thisKey := key;
    thisValue := value;
    thisDataType := ftUnknown;
    thisSize := -1;
end;

constructor TDbParameter.Create(key: string; value: Variant; dataType: TFieldType; size: Integer);
begin
    thisKey := key;
    thisValue := value;
    thisDataType := dataType;
    thisSize := size;
end;


////////////////////////////////////////////////////////////////////////////////

{
    TDbOperation Class implementation
}

{ 获取一个连接 }
function TDbOperation.GetConnection: TADOConnection;
var
    conn: TADOConnection;
begin
    conn := TADOConnection.Create(nil);
    conn.ConnectionString := thisConnectionString;
    conn.LoginPrompt := False;
    conn.Open();
    Result := conn;
end;

{ 执行单条CUD }
function TDbOperation.ExecSQL(sql: string): Boolean;
var
    args: TObjectList&lt;TDbParameter&gt;;
begin
    args := nil;
    Result := ExecSQL(sql, args);
end;

{ 执行单条CUD, 参数化 }
function TDbOperation.ExecSQL(sql: string; parms: TObjectList&lt;TDbParameter&gt;): Boolean;
var
    command: TADOCommand;
    conn: TADOConnection;
    parm: TDbParameter;
    i: Integer;
begin
    try
      conn := GetConnection;
      command := TADOCommand.Create(nil);
      with command do begin
            Connection := conn;
            CommandText := sql;
            if Assigned(parms) then begin
                for parm in parms do begin
                  Parameters.ParamByName(parm.key).value := parm.value;
                  if (parm.dataType &lt;&gt; ftUnknown) then begin
                        Parameters.ParamByName(parm.key).dataType := parm.dataType;
                  end;
                  if (parm.size &lt;&gt; -1) then begin
                        Parameters.ParamByName(parm.key).size := parm.size;
                  end;
                end;
            end;
            Execute;
            Result := True;
      end;
    finally
      CloseCommand(command);
      CloseConnection(conn);
    end;
end;

{ 批量执行CUD }
function TDbOperation.BatchExecSQL(sqls: TList&lt;string&gt;): Boolean;
var
    conn: TADOConnection;
    command: TADOCommand;
    sql: string;
    i: Integer;
begin
    try
      conn := GetConnection;
      command := TADOCommand.Create(nil);
      conn.BeginTrans;
      try
            with command do begin
                Connection := conn;
                for sql in sqls do begin
                  if sql &lt;&gt; '' then begin
                        CommandText := sql;
                        Execute;
                  end;
                end;
            end;
            conn.CommitTrans;
            Result := True;
      except
            on ex: EOleException do begin
                conn.RollbackTrans;
                Result := False;
            end;
      end;
    finally
      CloseCommand(command);
      CloseConnection(conn);
    end;
end;

{ 获取单个值的R }
function TDbOperation.GetSingle(sql: string): Variant;
var
    args: TObjectList&lt;TDbParameter&gt;;
begin
    args := nil;
    Result := GetSingle(sql, args);
end;

{ 获取单个值的R, 参数化 }
function TDbOperation.GetSingle(sql: string; parms: TObjectList&lt;TDbParameter&gt;): Variant;
var
    query: TADOQuery;
    conn: TADOConnection;
begin
    try
      conn := GetConnection;
      query := GetQuery(sql, parms);
      if query.RecordCount &lt; 0 then begin
            Result := '';
      end;
      query.First;
      Result := query.Fields.Fields.AsVariant;
    finally
      Close(query, conn);
    end;
end;

{ 获取一个Query对象 }
function TDbOperation.GetQuery(sql: string): TADOQuery;
var
    args: TObjectList&lt;TDbParameter&gt;;
begin
    args := nil;
    Result := GetQuery(sql, args);
end;

{ 获取一个Query对象, 参数化 }
function TDbOperation.GetQuery(sql: string; parms: TObjectList&lt;TDbParameter&gt;): TADOQuery;
var
    query: TADOQuery;
    parm: TDbParameter;
    i: Integer;
begin
    query := TADOQuery.Create(nil);
    query.Connection := GetConnection;
    query.SQL.Add(sql);
    if Assigned(parms) then begin
      for parm in parms do begin
            query.Parameters.ParamByName(parm.key).value := parm.value;
            if (parm.dataType &lt;&gt; ftUnknown) then begin
                query.Parameters.ParamByName(parm.key).dataType := parm.dataType;
            end;
            if (parm.size &lt;&gt; -1) then begin
                query.Parameters.ParamByName(parm.key).size := parm.size;
            end;
      end;
    end;
    query.Open;
    Result := query;
end;

{ 获取一个 DbSetProxy 对象 }
function TDbOperation.GetDbSet&lt;T&gt;(sql: string): T;
var
    FT: T;
begin
    FT := T.Create;
    FT.Init(GetQuery(sql));
    Result := FT;
end;

{ 获取一个 DbSetProxy 对象, 参数化 }
function TDbOperation.GetDbSet&lt;T&gt;(sql: string; parms: TObjectList&lt;TDbParameter&gt;): T;
var
    FT: T;
begin
    FT := T.Create;
    FT.Init(GetQuery(sql, parms));
    Result := FT;
end;

{ 关闭Query }
procedure TDbOperation.CloseQuery(query: TADOQuery);
begin
    if Assigned(query) then begin
      query.Close;
      query.Free;
      query := nil;
    end;
end;

{ 关闭连接 }
procedure TDbOperation.CloseConnection(connection: TADOConnection);
begin
    if Assigned(connection) then begin
      connection.Close;
      connection.Free;
      connection := nil;
    end;
end;

{ 关闭Query及连接 }
procedure TDbOperation.Close(query: TADOQuery; connection: TADOConnection);
begin
    CloseQuery(query);
    CloseConnection(connection);
end;

{ 关闭Command }
procedure TDbOperation.CloseCommand(cmd: TADOCommand);
begin
    if Assigned(cmd) then begin
      cmd.Cancel;
      cmd.Free;
      cmd := nil;
    end;
end;

{ ctor }
constructor TDbOperation.Create(connstr: string);
begin
    thisConnectionString := connstr;
end;

////////////////////////////////////////////////////////////////////////////////

initialization
    CoInitialize(nil);

finalization
    CoUnInitialize;

end.

</code></pre><br><br>
来源：https://www.cnblogs.com/zhuzhongxing/p/14147079.html
頁: [1]
查看完整版本: 【Delphi】Utils.Generics.ADODB