zdirsql.pas

控件名称：WINZEOS.ZIP 2002年08月03日 作者：CapellaDevelopment Zeos系列构件套件包含一组可直接存取Linux知名的免费数据库MySQL、Postgre

{********************************************************}
{                                                        }
{                 Zeos Database Objects                  }
{              Abstract direct class API                 }
{                                                        }
{       Copyright (c) 1999-2001 Sergey Seroukhov         }
{    Copyright (c) 1999-2001 Zeos Development Group      }
{                                                        }
{********************************************************}

unit ZDirSql;

interface

uses SysUtils, Classes, DB, ZToken, ZSqlTypes, DbTables;

type
  { Database status }
  TDirStatus = (csNone, csOk, csFail, csNotImplemented);

  { Abstract class for direct database connection }
  TDirConnect = class
  private
    FHost: ShortString;
    FPort: ShortString;
    FDatabase: ShortString;
    FLogin: ShortString;
    FPasswd: ShortString;
    FActive: Boolean;
    FStatus: TDirStatus;
  protected
    function  GetErrorMsg: ShortString; virtual;
    procedure SetActive(Value: Boolean);
    procedure SetStatus(Value: TDirStatus);
  public
    constructor Create;
    destructor  Destroy; override;

    procedure Connect; virtual;
    procedure Disconnect; virtual;
    procedure CreateDatabase(Params: string); virtual;
    procedure DropDatabase; virtual;

    property  HostName: ShortString read FHost write FHost;
    property  Port: ShortString read FPort write FPort;
    property  Database: ShortString read FDatabase write FDatabase;
    property  Login: ShortString read FLogin write FLogin;
    property  Passwd: ShortString read FPasswd write FPasswd;

    property  Active: Boolean read FActive;
    property  Error: ShortString read GetErrorMsg;
    property  Status: TDirStatus read FStatus;
  end;

  { Abstract class for database transaction }
  TDirTransact = class
  private
    FStatus: TDirStatus;
    FConnect: TDirConnect;
    FActive: Boolean;
    FTransactSafe: Boolean;
  protected
    function  GetErrorMsg: ShortString; virtual;
    function  GetStatus: TDirStatus; virtual;
    procedure SetStatus(Value: TDirStatus); virtual;
    procedure SetActive(Value: Boolean);
  public
    constructor Create;
    destructor Destroy; override;

    procedure Open; virtual;
    procedure Close; virtual;
    procedure StartTransaction; virtual;
    procedure EndTransaction; virtual;
    procedure Commit; virtual;
    procedure Rollback; virtual;

    property Connect: TDirConnect read FConnect write FConnect;
    property TransactSafe: Boolean read FTransactSafe write FTransactSafe;

    property Active: Boolean read FActive;
    property Error: ShortString read GetErrorMsg;
    property Status: TDirStatus read GetStatus;
 end;

  { Query status }
  TDirQueryStatus = (qsNone, qsTuplesOk, qsCommandOk, qsFail, qsNotImplemented);

  TDirBlob = class;

  { Abstract class for database query }
  TDirQuery = class
  private
    FLocFields: TStringList;
    FLocValues: TStringList;
    FUseCursor: Boolean;
    FConnect: TDirConnect;
    FTransact: TDirTransact;
    FStatus: TDirQueryStatus;

    FActive: Boolean;
    FRecno: LongInt;
    FAffectedRows: LongInt;
    FBof: Boolean;
    FEof: Boolean;
    FSql: string;
  protected
    function GetBof: Boolean; virtual;
    procedure SetBof(Value: Boolean);
    function GetEof: Boolean; virtual;
    procedure SetEof(Value: Boolean);
    procedure SetRecNo(Value: LongInt);
    procedure SetActive(Value: Boolean);
    procedure SetStatus(Value: TDirQueryStatus);
    procedure SetAffectedRows(Value: LongInt);
    function GetErrorMsg: ShortString; virtual;
  public
    constructor Create;
    destructor Destroy; override;

    function  ExecuteParams(Params: TVarRecArray;
      ParamCount: Integer): LongInt; virtual;
    function Execute: LongInt; virtual;
    procedure Open; virtual;
    procedure Close; virtual;
    function CreateBlobObject: TDirBlob; virtual;

    procedure ShowDatabases(DatabaseName: ShortString); virtual;
    procedure ShowTables(TableName: ShortString); virtual;
    procedure ShowColumns(TableName, ColumnName: ShortString); virtual;
    procedure ShowIndexes(TableName: ShortString); virtual;

    procedure First; virtual;
    procedure Last; virtual;
    procedure Prev; virtual;
    procedure Next; virtual;
    procedure Go(Num: Integer); virtual;
    function Locate(Params: string): Boolean;
    function FindNext: Boolean;

    function FieldCount: Integer; virtual;
    function RecordCount: Integer; virtual;

    function FieldName(FieldNum: Integer): ShortString; virtual;
    function FieldAlias(FieldNum: Integer): ShortString; virtual;
    function FieldIndex(FieldName: ShortString): Integer; virtual;
    function FieldSize(FieldNum: Integer): Integer; virtual;
    function FieldMaxSize(FieldNum: Integer): Integer; virtual;
    function FieldDecimals(FieldNum: Integer): Integer; virtual;
    function FieldType(FieldNum: Integer): Integer; virtual;
    function FieldDataType(FieldNum: Integer): TFieldType; virtual;
    function FieldIsNull(FieldNum: Integer): Boolean; virtual;
    function FieldReadOnly(FieldNum: Integer): boolean; virtual;//Faraj
    function Field(FieldNum: Integer): string; virtual;
    function FieldBuffer(FieldNum: Integer): PChar; virtual;
    function FieldByName(FieldName: ShortString): string;

    function StringToSql(Value: string): string; virtual;

    property Connect: TDirConnect read FConnect write FConnect;
    property Transact: TDirTransact read FTransact write FTransact;
    property Sql: string read FSql write FSql;
    property Active: Boolean read FActive;
    property Status: TDirQueryStatus read FStatus;
    property Error: ShortString read GetErrorMsg;
    property UseCursor: Boolean read FUseCursor write FUseCursor;

    property Bof: Boolean read GetBof;
    property Eof: Boolean read GetEof;
    property RecNo: LongInt read FRecno;
    property AffectedRows: LongInt read FAffectedRows;
  end;

  { Blob status }
  TDirBlobStatus = (bsNone, bsOk, bsFail, bsNotImplemented);

  { Abstract class for database binary large object }
  TDirBlob = class
  protected
    FStatus: TDirBlobStatus;
    FActive: Boolean;
    FHandle: TBlobHandle;
    FConnect: TDirConnect;
    FTransact: TDirTransact;
  protected
    procedure SetStatus(Value: TDirBlobStatus);
    procedure SetActive(Value: Boolean);
    procedure SetHandle(Value: TBlobHandle);
    function  GetErrorMsg: ShortString; virtual;
    function  GetPosition: LongInt; virtual;
    function  GetValue: string;
    procedure SetValue(Value: string);
  public
    constructor Create(AConnect: TDirConnect; ATransact: TDirTransact;
      AHandle: TBlobHandle);
    destructor Destroy; override;

    procedure Open(Mode: Integer); virtual;
    procedure Close; virtual;
    procedure CreateBlob; virtual;
    procedure DropBlob; virtual;

    function  Read(Buffer: PChar; Length: Integer): Integer; virtual;
    function  Write(Buffer: PChar; Length: Integer): Integer; virtual;
    procedure Seek(Offset: LongInt; Origin: Integer); virtual;

    procedure ImportFile(FileName: ShortString); virtual;
    procedure ExportFile(FileName: ShortString); virtual;

    property  Connect: TDirConnect read FConnect write FConnect;
    property  Transact: TDirTransact read FTransact write FTransact;
    property  Status: TDirBlobStatus read FStatus;
    property  Active: Boolean read FActive;
    property  Error: ShortString read GetErrorMsg;

    property  Handle: TBlobHandle read FHandle write FHandle;
    property  Position: LongInt read GetPosition;
    property  Value: string read GetValue write SetValue;
  end;

  TDirNotifyStatus = (nsNone, nsOk, nsFail, nsNotImplemented);

  { Abstract class for asynchrounous notifying}
  TDirNotify = class
  protected
    FActive: Boolean;
    FConnect: TDirConnect;
    FTransact: TDirTransact;
    FStatus: TDirNotifyStatus;

    procedure SetStatus(Value: TDirNotifyStatus);
    procedure SetActive(Value: Boolean);
    function GetErrorMsg: ShortString; virtual;
  public
    procedure ListenTo(Event: string); virtual;
    procedure UnlistenTo(Event: string); virtual;
    procedure DoNotify(Event: string); virtual;
    function CheckEvents: string; virtual;

    property Connect: TDirConnect read FConnect write FConnect;
    property Transact: TDirTransact read FTransact write FTransact;
    property Active: Boolean read FActive;
    property Status: TDirNotifyStatus read FStatus;
    property Error: ShortString read GetErrorMsg;
  end;

  { Abstract class for database stored procedure }
  TDirStoredProc = class
  private
    FLocFields: TStringList;  // Locate
    FLocValues: TStringList;  // Locate
    FConnect: TDirConnect;
    FTransact: TDirTransact;
    FStatus: TDirQueryStatus;

    FActive: Boolean;
    FRecno: LongInt;
    FAffectedRows: LongInt;
    FBof: Boolean;
    FEof: Boolean;
    FPrepared: Boolean;
    FStoredProcName: string;
  protected
    function GetBof: Boolean; virtual;
    procedure SetBof(Value: Boolean);
    function GetEof: Boolean; virtual;
    procedure SetEof(Value: Boolean);
    procedure SetRecNo(Value: LongInt);
    procedure SetActive(Value: Boolean);
    procedure SetStatus(Value: TDirQueryStatus);
    procedure SetAffectedRows(Value: LongInt);
    function GetErrorMsg: ShortString; virtual;
    function GetPrepared: Boolean; virtual;
    procedure SetPrepared(const Value: Boolean); virtual;
  public
    constructor Create;
    destructor Destroy; override;

    procedure ExecProc; virtual;
    procedure Open; virtual;
    procedure Close; virtual;
    function CreateBlobObject: TDirBlob; virtual;
    procedure Prepare(Params: TParams); virtual;
    procedure UnPrepare; virtual;
    function GetReturnValue: string; virtual;

    procedure ShowStoredProcs; virtual;
    procedure ShowParams(StoredProcedureName: ShortString); virtual;

    procedure First; virtual;
    procedure Last; virtual;
    procedure Prev; virtual;
    procedure Next; virtual;
    procedure Go(Num: Integer); virtual;
    function Locate(Params: string): Boolean;
    function FindNext: Boolean;

    function FieldCount: Integer; virtual;
    function RecordCount: Integer; virtual;
    function ParamCount: Integer; virtual;

    function FieldName(FieldNum: Integer): ShortString; virtual;
    function FieldAlias(FieldNum: Integer): ShortString; virtual;
    function FieldIndex(FieldName: ShortString): Integer; virtual;
    function FieldSize(FieldNum: Integer): Integer; virtual;
    function FieldMaxSize(FieldNum: Integer): Integer; virtual;
    function FieldDecimals(FieldNum: Integer): Integer; virtual;
    function FieldType(FieldNum: Integer): Integer; virtual;
    function FieldDataType(FieldNum: Integer): TFieldType; virtual;
    function FieldIsNull(FieldNum: Integer): Boolean; virtual;
    function Field(FieldNum: Integer): string; virtual;
    function FieldBuffer(FieldNum: Integer): PChar; virtual;
    function FieldByName(FieldName: ShortString): string;

    function ParamName(ParamNum: Integer): ShortString; virtual;
    function ParamSize(ParamNum: Integer): Integer; virtual;
    function ParamAlias(ParamNum: Integer): ShortString; virtual;
    function ParamMaxSize(ParamNum: Integer): Integer; virtual;
    function ParamDecimals(ParamNum: Integer): Integer; virtual;
    function ParamIndex(ParamName: ShortString): Integer; virtual;
    function ParamType(ParamNum: Integer): Integer; virtual;
    function ParamDataType(ParamNum: Integer): TFieldType; virtual;
    function ParamIsNull(ParamNum: Integer): Boolean; virtual;
    function Param(ParamNum: Integer): string; virtual;
    function ParamBuffer(ParamNum: Integer): PChar; virtual;
    function ParamByName(ParamName: ShortString): string;

    function StringToSql(Value: string): string; virtual;

    property Connect: TDirConnect read FConnect write FConnect;
    property Transact: TDirTransact read FTransact write FTransact;
    property Active: Boolean read FActive;
    property Status: TDirQueryStatus read FStatus;
    property Error: ShortString read GetErrorMsg;

    property Bof: Boolean read GetBof;
    property Eof: Boolean read GetEof;
    property RecNo: LongInt read FRecno;
    property AffectedRows: LongInt read FAffectedRows;
    property Prepared: Boolean read GetPrepared write SetPrepared;

    property StoredProcName: string read FStoredProcName write FStoredProcName;
  end;

implementation

{********************* TDirConnect implementation *********************}

{ Class constructor }
constructor TDirConnect.Create;
begin
end;

{ Class destructor }
destructor TDirConnect.Destroy;
begin
  if Active then Disconnect;
  inherited;
end;

{ Set active connect property }
procedure TDirConnect.SetActive(Value: Boolean);
begin
  FActive := Value;
end;

{ Set connect status }
procedure TDirConnect.SetStatus(Value: TDirStatus);
begin
  FStatus := Value;
end;

{ Get an error message }
function TDirConnect.GetErrorMsg: ShortString;
begin
  Result := 'Not connected';
end;

{ Connect to the database }
procedure TDirConnect.Connect;
begin
  if Active then Disconnect;
  SetStatus(csNotImplemented);
end;

{ Disconnect from the database }
procedure TDirConnect.Disconnect;
begin
  SetActive(False);
  SetStatus(csNotImplemented);
end;

{ Create new database }
procedure TDirConnect.CreateDatabase(Params: string);
begin
  if Active then Disconnect;
  SetStatus(csNotImplemented);
end;

{ Drop connected database }
procedure TDirConnect.DropDatabase;
begin
  if Active then Disconnect;
  SetStatus(csNotImplemented);
end;

{******************** TDirTransact implementation ****************}

{ Class constructor }
constructor TDirTransact.Create;
begin
  FActive := False;
  FTransactSafe := True;
end;

{ Class destructor }
destructor TDirTransact.Destroy;
begin
  if Active then EndTransaction;
  inherited;
end;

{ Set active transaction property }
procedure TDirTransact.SetActive(Value: Boolean);
begin
  FActive := Value;
end;

{ Get status transaction property }
function TDirTransact.GetStatus: TDirStatus;
begin
  Result := FStatus;
end;

{ Set status transaction property }
procedure TDirTransact.SetStatus(Value: TDirStatus);
begin
  FStatus := Value;
end;

{ Get error message }
function TDirTransact.GetErrorMsg: ShortString;
begin
  Result := '';
 if (Status <> csOk) and Assigned(Connect) then
   Result := Connect.Error
 else
   Result := '';
end;

{ Abstract connect transaction }
procedure TDirTransact.Open;
begin
  if Active then Close;
  SetStatus(csNotImplemented);
end;

{ Abstract disconnect transaction }
procedure TDirTransact.Close;
begin
//  SetActive(False);
  SetStatus(csNotImplemented);
end;

{ Abstract start transaction }
procedure TDirTransact.StartTransaction;
begin
  SetStatus(csNotImplemented);
end;

{ Abtract end transaction }
procedure TDirTransact.EndTransaction;
begin
  SetStatus(csNotImplemented);
end;

{ Abstract commit transaction }
procedure TDirTransact.Commit;
begin
  SetStatus(csNotImplemented);
end;

{ Astract rollback transaction }
procedure TDirTransact.Rollback;
begin
  SetStatus(csNotImplemented);
end;

{******************** TDirQuery implementation ******************}

function IIF(A: Boolean; B, C: Integer): Integer;
begin
  if A then Result := B
  else Result := C;
end;

{ Class constructor }
constructor TDirQuery.Create;
begin
  FLocFields := TStringList.Create;
  FLocValues := TStringList.Create;
  FBof := True;
  FEof := True;
end;

{ Class destructor }
destructor TDirQuery.Destroy;
begin
  if Active then Close;
  FLocFields.Free;
  FLocValues.Free;
  Finalize(FSql);
  inherited Destroy;
end;

{ Set active property }
procedure TDirQuery.SetActive(Value: Boolean);
begin
  FActive := Value;
end;

{ Set rows affected property }
procedure TDirQuery.SetAffectedRows(Value: Integer);
begin
  FAffectedRows := Value;
end;

{ Is begin of rows }
function TDirQuery.GetBof: Boolean;
begin
  Result := FBof;