【Delphi】Utils.Generics.ADODB

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[x: Integer]: ShortString read GetPropName;
        property Props[x: Integer]: 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<TDbParameter>): Boolean; overload;
		{ 批量執行CUD }
        function BatchExecSQL(sqls: TList<string>): Boolean;
		{ 獲取單個值的R }
        function GetSingle(sql: string): Variant; overload;
		{ 獲取單個值的R,  參數化 }
        function GetSingle(sql: string; parms: TObjectList<TDbParameter>): Variant; overload;
		{ 獲取一個Query對象 }
        function GetQuery(sql: string): TADOQuery; overload;
		{ 獲取一個Query對象, 參數化 }
        function GetQuery(sql: string; parms: TObjectList<TDbParameter>): TADOQuery; overload;
        { 獲取一個 DbSetProxy 對象 }
        function GetDbSet<T: TDbSetProxy, constructor>(sql: string): T; overload;
		{ 獲取一個 DbSetProxy 對象, 參數化 }
        function GetDbSet<T: TDbSetProxy, constructor>(sql: string; parms: TObjectList<TDbParameter>): 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 > 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[x];
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 <> dsEdit) and (FDataSet.State <> 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[x]).AsInteger;
end;

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

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

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

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

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

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

procedure TDbSetProxy.SetVariant(x: Integer; aValue: Variant);
begin
    BeginEdit;
    FDataSet.FieldByName(FPropList.PropNames[x]).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<TDbParameter>;
begin
    args := nil;
    Result := ExecSQL(sql, args);
end;

{ 執行單條CUD, 參數化 }
function TDbOperation.ExecSQL(sql: string; parms: TObjectList<TDbParameter>): 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 <> ftUnknown) then begin
                        Parameters.ParamByName(parm.key).dataType := parm.dataType;
                    end;
                    if (parm.size <> -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<string>): 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 <> '' 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<TDbParameter>;
begin
    args := nil;
    Result := GetSingle(sql, args);
end;

{ 獲取單個值的R, 參數化 }
function TDbOperation.GetSingle(sql: string; parms: TObjectList<TDbParameter>): Variant;
var
    query: TADOQuery;
    conn: TADOConnection;
begin
    try
        conn := GetConnection;
        query := GetQuery(sql, parms);
        if query.RecordCount < 0 then begin
            Result := '';
        end;
        query.First;
        Result := query.Fields.Fields[0].AsVariant;
    finally
        Close(query, conn);
    end;
end;

{ 獲取一個Query對象 }
function TDbOperation.GetQuery(sql: string): TADOQuery;
var
    args: TObjectList<TDbParameter>;
begin
    args := nil;
    Result := GetQuery(sql, args);
end;

{ 獲取一個Query對象, 參數化 }
function TDbOperation.GetQuery(sql: string; parms: TObjectList<TDbParameter>): 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 <> ftUnknown) then begin
                query.Parameters.ParamByName(parm.key).dataType := parm.dataType;
            end;
            if (parm.size <> -1) then begin
                query.Parameters.ParamByName(parm.key).size := parm.size;
            end;
        end;
    end;
    query.Open;
    Result := query;
end;

{ 獲取一個 DbSetProxy 對象 }
function TDbOperation.GetDbSet<T>(sql: string): T;
var
    FT: T;
begin
    FT := T.Create;
    FT.Init(GetQuery(sql));
    Result := FT;
end;

{ 獲取一個 DbSetProxy 對象, 參數化 }
function TDbOperation.GetDbSet<T>(sql: string; parms: TObjectList<TDbParameter>): 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.