zdirmysql.pas

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

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

unit ZDirMySql;

interface

uses Windows, SysUtils, ZDirSql, ZLibMySql, DB, Math,
  ZTransact, ZSqlTypes;

{$IFNDEF LINUX}
{$INCLUDE ..\Zeos.inc}
{$ELSE}
{$INCLUDE ../Zeos.inc}
{$ENDIF}

type
  { Direct connection to MySql database }
  TDirMySqlConnect = class (TDirConnect)
  private
    FError: string;
  protected
    function GetErrorMsg: ShortString; override;
  public
    constructor Create;
    destructor  Destroy; override;

    procedure Connect; override;
    procedure Disconnect; override;
    procedure CreateDatabase(Params: string); override;
    procedure DropDatabase; override;
  end;

  { Direct Mysql transaction stub }
  TDirMySqlTransact = class (TDirTransact)
  private
    FHandle: MYSQL;
    FError: string;
  protected
    function GetErrorMsg: ShortString; override;
  public
    constructor Create(AConnect: TDirMySqlConnect);

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

    property Handle: MYSQL read FHandle;
  end;

  { Direct query to MySql }
  TDirMySqlQuery = class (TDirQuery)
  private
    FHandle:   PMYSQL_RES;
    FStoreResult: Boolean;
    FRow:      PMYSQL_ROW;
  protected
    function GetErrorMsg: ShortString; override;
    function GetEof: Boolean; override;
  public
    constructor Create(AConnect: TDirMySqlConnect; ATransact: TDirMySqlTransact);
    destructor  Destroy; override;

    function  Execute: LongInt; override;
    procedure Open; override;
    procedure Close; override;

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

    procedure First; override;
    procedure Last; override;
    procedure Prev; override;
    procedure Next; override;
    procedure Go(N: Integer); override;

    function FieldCount:  Integer; override;
    function RecordCount: Integer; override;

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

    function FieldFlags(FieldNum: Integer): Integer;
    function StringToSql(Value: string): string; override;

    property Handle: PMYSQL_RES read FHandle;
    property StoreResult: Boolean read FStoreResult write FStoreResult;
  end;

{ Convert mysql field types to delphi field types }
function MySqlToDelphiType(Value: Byte; Flags: Integer): TFieldType;

{ Convert MySql field types to delphi field types }
function MySqlToDelphiTypeDesc(Value: string; var Size, Precision: Integer): TFieldType;

{ Monitor list }
var MonitorList: TZMonitorList;

implementation

uses ZDBaseConst, ZExtra, ZToken, ZSqlExtra;

{*************** TDirMySqlConnect implementation *****************}

{ Class constructor }
constructor TDirMySqlConnect.Create;
begin
  inherited Create;
  Port := '3306';
end;

{ Class destructor }
destructor TDirMySqlConnect.Destroy;
begin
  inherited Destroy;
end;

{ Get an error message }
function TDirMySqlConnect.GetErrorMsg: ShortString;
begin
  if Status <> csOk then
    Result := FError
  else
    Result := '';
end;

{ Connect to database server }
procedure TDirMySqlConnect.Connect;
begin
  inherited Connect;
  if hDll = 0 then MySqlLoadLib;
  SetStatus(csOk);
  SetActive(True);
end;

{ Break connection to server }
procedure TDirMySqlConnect.Disconnect;
begin
  SetStatus(csOk);
  SetActive(False);
end;

{ Create a new database }
procedure TDirMySqlConnect.CreateDatabase(Params: string);
var
  Handle: MYSQL;
begin
  if Active then Disconnect;
  if hDll = 0 then MySqlLoadLib;
  SetStatus(csFail);

  mysql_init(@Handle);
{$IFDEF NEW_LIBMYSQL_DLL}
  mysql_options(@Handle, MYSQL_OPT_COMPRESS, nil);
{$ENDIF}
  if mysql_connect(@Handle,PChar(string(HostName)),PChar(string(Login)),
    PChar(string(Passwd))) = nil then
    FError := SConnectError
  else if mysql_create_db(@Handle, PChar(string(Database))) <> 0 then
  begin
    mysql_close(@Handle);
    FError := SDbCreateError;
  end
  else
  begin
    mysql_close(@Handle);
    SetStatus(csOk);
  end;
  MonitorList.InvokeEvent(Format('CREATE DATABASE %s',[Database]), FError, Status <> csOk);
end;

{ Drop the database }
procedure TDirMySqlConnect.DropDatabase;
var
  Handle: MYSQL;
begin
  if Active then Disconnect;
  SetStatus(csFail);
  FError := SConnectError;

  mysql_init(@Handle);
{$IFDEF NEW_LIBMYSQL_DLL}
  mysql_options(@Handle, MYSQL_OPT_COMPRESS, nil);
{$ENDIF}
  if mysql_real_connect(@Handle, PChar(string(HostName)),
    PChar(string(Login)), PChar(string(Passwd)), PChar(string(Database)),
    StrToInt(Port), nil, _CLIENT_CONNECT_WITH_DB) <> nil then
  begin
    if mysql_drop_db(@Handle, PChar(string(Database))) = 0 then
      SetStatus(csOk);
    mysql_close(@Handle);
  end;

  MonitorList.InvokeEvent(Format('DROP DATABASE %s',[Database]), 'Fail.', Status <> csOk);
end;

{******************** TDirMySqlTransact implementation **************}

{ Class constructor }
constructor TDirMySqlTransact.Create(AConnect: TDirMySqlConnect);
begin
  inherited Create;
  Connect := AConnect;
  TransactSafe := False;
end;

{ Get an error message }
function TDirMySqlTransact.GetErrorMsg: ShortString;
begin
  if Assigned(Connect) then
    FError := Trim(StrPas(@Handle._net.last_error));
  Result := FError;
end;

{ Connect transaction }
procedure TDirMySqlTransact.Open;
begin
  inherited Open;
  SetStatus(csFail);
  if not Assigned(Connect) or not Connect.Active then
    Exit;

  mysql_init(@Handle);
{$IFDEF NEW_LIBMYSQL_DLL}
//!!  mysql_options(@Handle, MYSQL_OPT_COMPRESS, nil);
{$ENDIF}
  if mysql_real_connect(@Handle, PChar(string(Connect.HostName)),
     PChar(string(Connect.Login)), PChar(string(Connect.Passwd)),
     PChar(string(Connect.Database)), StrToInt(Connect.Port), nil,
     _CLIENT_CONNECT_WITH_DB) = nil then
  begin
    FError := SConnectError;
    SetStatus(csFail);
    MonitorList.InvokeEvent(Format('CONNECT %s',[Connect.Database]), FError, True);
    Exit;
  end;
  MonitorList.InvokeEvent(Format('CONNECT %s',[Connect.Database]), 'OK.', False);

  StartTransaction;
  SetActive(Status = csOk);
end;

{ Disconnect transaction }
procedure TDirMySqlTransact.Close;
begin
  EndTransaction;
  if Active then
  begin
    mysql_close(@Handle);
    if Assigned(Connect) then
      MonitorList.InvokeEvent(Format('DISCONNECT %s',
        [Connect.Database]), 'OK.', False);
  end;
  SetActive(False);
end;

{ Start transaction stub }
procedure TDirMySqlTransact.StartTransaction;
begin
  SetStatus(csFail);
  if not Assigned(Connect) then Exit;

  if TransactSafe then
  begin
    mysql_query(@Handle, 'BEGIN');
    MonitorList.InvokeEvent('BEGIN', 'OK.', False);
  end;
  SetActive(True);
  SetStatus(csOk);
end;

{ End transaction stub }
procedure TDirMySqlTransact.EndTransaction;
begin
  if Active and TransactSafe then
  begin
    mysql_query(@Handle, 'ROLLBACK');
    MonitorList.InvokeEvent('ROLLBACK', 'OK.', False);
  end;
  SetStatus(csOk);
end;

{ Commit transaction stub }
procedure TDirMySqlTransact.Commit;
begin
  SetStatus(csFail);
  if not Active then Exit;
  SetStatus(csOk);
  if TransactSafe then
  begin
    mysql_query(@Handle, 'COMMIT');
    MonitorList.InvokeEvent('COMMIT', Error, Error <> '');
    mysql_query(@Handle, 'BEGIN');
    MonitorList.InvokeEvent('BEGIN', Error, Error <> '');
    if Error <> ''  then
      SetStatus(csFail);
  end;
end;

{ Rollback transaction stub }
procedure TDirMySqlTransact.Rollback;
begin
  SetStatus(csFail);
  if not Active then Exit;
  SetStatus(csOk);
  if TransactSafe then
  begin
    mysql_query(@Handle, 'ROLLBACK');
    MonitorList.InvokeEvent('ROLLBACK', Error, Error <> '');
    mysql_query(@Handle, 'BEGIN');
    MonitorList.InvokeEvent('BEGIN', Error, Error <> '');
    if Error <> ''  then
      SetStatus(csFail);
  end;
end;

{************************************************************}

{ Making capability with old libmysql.dll }
procedure mysql_seek(Result: PMYSQL_RES; Offset: Cardinal);
{$IFNDEF OLD_LIBMYSQL_DLL}
var
  Temp: TInt64;
begin
  Temp.Data := Offset;
  Temp.Pad := 0;
  mysql_data_seek(Result, Temp);
end;
{$ELSE}
begin
  mysql_data_seek(Result, Offset);
end;
{$ENDIF}

{****************** TDirMySqlQuery implementation ******************}

{ Class constructor }
constructor TDirMySqlQuery.Create(AConnect: TDirMySqlConnect;
  ATransact: TDirMySqlTransact);
begin
  inherited Create;
  Connect   := AConnect;
  Transact  := ATransact;
  FHandle   := nil;
  FStoreResult := True;
  FRow      := nil;
end;

{ Class destructor }
destructor TDirMySqlQuery.Destroy;
begin
  inherited Destroy;
end;

{ Get an error message }
function TDirMySqlQuery.GetErrorMsg: ShortString;
begin
  Result := '';
  if not (Status in [qsTuplesOk, qsCommandOk]) and Assigned(Transact)
    and Assigned(Connect) then
    Result := Trim(StrPas(@TDirMySqlTransact(Transact).Handle._net.last_error));
end;

{ Close an open query }
procedure TDirMySqlQuery.Close;
begin
  inherited Close;
  if FHandle <> nil then
    mysql_free_result(FHandle);
  FHandle := nil;
  SetActive(False);
  FRow := nil;
end;

{ Execute a query without rows returning }
function TDirMySqlQuery.Execute: LongInt;
var
  Temp: string;
begin
  Result := inherited Execute;
  FHandle := nil;
  SetStatus(qsFail);
  if not Assigned(Connect) or not Assigned(Transact)
    or not (Connect.Active and Transact.Active) then
    Exit;

  if mysql_query(@TDirMySqlTransact(Transact).Handle,
{$IFDEF DELETE_QUERY_SPACES}
    PChar(ClearSpaces(Trim(Sql)))) = 0 then
{$ELSE}
    PChar(Trim(Sql))) = 0 then
{$ENDIF}
  begin
    SetStatus(qsCommandOk);

    Temp := Sql;
    Temp := UpperCase(StrTok(Temp, ' '#9#10#13));
    if (Temp = 'SELECT') or (Temp = 'SHOW') or (Temp = 'DESCRIBE') then
    begin
      FHandle := mysql_store_result(@TDirMySqlTransact(Transact).Handle);