mysqlcommon.pas

通过Tmysql来访问MSQL Server数据库的应用案例.

    function    GetFieldName(const i : longint) : string;
    function    GetIndexByFieldName(const FieldString : string) : integer;

    function    GetDataCount : integer;

    procedure   _OnComplete(Sender: TObject; Data: TObject);
    procedure   _OnError(Sender: TObject; Data: TObject; Msg: string);
  public
    constructor Create;
    destructor  Destroy; override;

    property    Default_OnComplete : TmySQLClientTask_OnComplete read FDefault_OnComplete write FDefault_OnComplete;
    property    Default_OnError    : TmySQLClientTask_OnError    read FDefault_OnError    write FDefault_OnError;

    property    FieldCount : integer read GetFieldCount;
    property    Field[const i : integer] : pmysql_field read GetField;
    property    FieldName[const i : integer] : string read GetFieldName;

    property    DataCount : integer read GetDataCount;

    property    TaskHandler : TmySQLClientTaskHandler read FTaskHandler write FTaskHandler;

    property    CurrentTaskData : TmySQLClientTaskData read FCurrentTaskData write FCurrentTaskData;

    function    Data(const i, j : longword) : pchar;
    function    DataAsInteger(const i, j : longword) : integer;
    function    DataAsDateTime(const i, j : longword) : TDateTime;

    function    DataByFieldName(const i : longint; const FieldString : string) : pchar;

    procedure   Prepare(Query : pchar; const TaskName : string);
    procedure   PrepareTask(
      Query : pchar;
      const TaskName : string;
      OnComplete : TmySQLClientTask_OnComplete;
      OnError    : TmySQLClientTask_OnError
    );

    procedure   Reset;
  end;

type
  TmySQLClientUtility = class(TObject)
  private
    FTaskHandler   : TmySQLClientTaskHandler;

    FCurrentTaskData : TmySQLClientTaskData;

    function    GetServerInfo : string;
    function    GetClientInfo : string;
    function    GetHostInfo   : string;
    function    GetProtoInfo  : byte;

    function    GetErrorMsg : string;
    function    GetStat     : pchar;

    function    GetListResult : TStringList;
    function    GetIntegerResult : integer;

    procedure   _OnComplete(Sender: TObject; Data: TObject);
    procedure   _OnError(Sender: TObject; Data: TObject; Msg: string);
  protected
  public
    Default_OnSelectDatabase         : TmySQLClientTask_OnComplete;
    Default_OnSelectDatabaseError    : TmySQLClientTask_OnError;

    Default_OnCreateDatabase         : TmySQLClientTask_OnComplete;
    Default_OnCreateDatabaseError    : TmySQLClientTask_OnError;

    Default_OnDropDatabase           : TmySQLClientTask_OnComplete;
    Default_OnDropDatabaseError      : TmySQLClientTask_OnError;

    Default_OnListDatabases          : TmySQLClientTask_OnComplete;
    Default_OnListDatabasesError     : TmySQLClientTask_OnError;

    Default_OnListTables             : TmySQLClientTask_OnComplete;
    Default_OnListTablesError        : TmySQLClientTask_OnError;

    Default_OnListFields             : TmySQLClientTask_OnComplete;
    Default_OnListFieldsError        : TmySQLClientTask_OnError;

    Default_OnListProcesses          : TmySQLClientTask_OnComplete;
    Default_OnListProcessesError     : TmySQLClientTask_OnError;

    Default_OnPing                   : TmySQLClientTask_OnComplete;
    Default_OnPingError              : TmySQLClientTask_OnError;

    Default_OnShutdown               : TmySQLClientTask_OnComplete;
    Default_OnShutdownError          : TmySQLClientTask_OnError;

    Default_OnKill                   : TmySQLClientTask_OnComplete;
    Default_OnKillError              : TmySQLClientTask_OnError;

    Default_OnOptions                : TmySQLClientTask_OnComplete;
    Default_OnOptionsError           : TmySQLClientTask_OnError;

    Default_OnRefresh                : TmySQLClientTask_OnComplete;
    Default_OnRefreshError           : TmySQLClientTask_OnError;

    constructor Create;
    destructor  Destroy; override;

    property    TaskHandler : TmySQLClientTaskHandler read FTaskHandler write FTaskHandler;
    property    CurrentTaskData : TmySQLClientTaskData read FCurrentTaskData write FCurrentTaskData;

    property    ServerInfo : string read GetServerInfo;
    property    ClientInfo : string read GetClientInfo;
    property    HostInfo   : string read GetHostInfo;
    property    ProtoInfo  : byte   read GetProtoInfo;

    property    ErrorMsg   : string read GetErrorMsg;
    property    Stat       : pchar read GetStat;

    property    ListResult : TStringList read GetListResult;
    property    PingResult : integer read GetIntegerResult;
    property    RefreshResult : integer read GetIntegerResult;
    property    OptionsResult : integer read GetIntegerResult;
    property    ShutdownResult : integer read GetIntegerResult;

    procedure   PrepareConnectTask(
      const host, user, passwd, db: pchar;
      port: Cardinal; unix_socket: PChar; clientflag: Cardinal;
      const TaskName : string;
      OnComplete : TmySQLClientTask_OnComplete;
      OnError    : TmySQLClientTask_OnError
    );

    procedure   PrepareCloseTask(
      const TaskName : string;
      OnComplete : TmySQLClientTask_OnComplete;
      OnError    : TmySQLClientTask_OnError
    );

    procedure   PrepareSelectDatabase(
      db : pchar;
      const TaskName : string
    );
    procedure   PrepareSelectDatabaseTask(
      db : pchar;
      const TaskName : string;
      OnComplete : TmySQLClientTask_OnComplete;
      OnError    : TmySQLClientTask_OnError
    );

    procedure   PrepareCreateDatabase(
      db : pchar;
      const TaskName : string
    );
    procedure   PrepareCreateDatabaseTask(
      db : pchar;
      const TaskName : string;
      OnComplete : TmySQLClientTask_OnComplete;
      OnError    : TmySQLClientTask_OnError
    );

    procedure   PrepareDropDatabase(
      db : pchar;
      const TaskName : string
    );
    procedure   PrepareDropDatabaseTask(
      db : pchar;
      const TaskName : string;
      OnComplete : TmySQLClientTask_OnComplete;
      OnError    : TmySQLClientTask_OnError
    );

    procedure   PrepareListDatabases(
      Wild : pchar;
      const TaskName : string
    );
    procedure   PrepareListDatabasesTask(
      Wild : pchar;
      const TaskName : string;
      OnComplete : TmySQLClientTask_OnComplete;
      OnError    : TmySQLClientTask_OnError
    );

    procedure   PrepareListTables(
      Wild : pchar;
      const TaskName : string
    );
    procedure   PrepareListTablesTask(
      Wild : pchar;
      const TaskName : string;
      OnComplete : TmySQLClientTask_OnComplete;
      OnError    : TmySQLClientTask_OnError
    );

    procedure   PrepareListFields(
      TableName : pchar;
      Wild : pchar;
      const TaskName : string
    );
    procedure   PrepareListFieldsTask(
      TableName : pchar;
      Wild : pchar;
      const TaskName : string;
      OnComplete : TmySQLClientTask_OnComplete;
      OnError    : TmySQLClientTask_OnError
    );

    procedure   PrepareListProcesses(
      const TaskName : string
    );
    procedure   PrepareListProcessesTask(
      const TaskName : string;
      OnComplete : TmySQLClientTask_OnComplete;
      OnError    : TmySQLClientTask_OnError
    );

    procedure PreparePing(
      const TaskName : string
    );
    procedure PreparePingTask(
      const TaskName : string;
      OnComplete : TmySQLClientTask_OnComplete;
      OnError    : TmySQLClientTask_OnError
    );

    procedure PrepareShutdown(
      const TaskName : string
    );
    procedure PrepareShutdownTask(
      const TaskName : string;
      OnComplete : TmySQLClientTask_OnComplete;
      OnError    : TmySQLClientTask_OnError
    );

    procedure PrepareKill(
      const pid : integer;
      const TaskName : string
    );
    procedure PrepareKillTask(
      const pid : integer;
      const TaskName : string;
      OnComplete : TmySQLClientTask_OnComplete;
      OnError    : TmySQLClientTask_OnError
    );

    procedure PrepareOptions(
      const opt: mysql_option; arg: pchar;
      const TaskName : string
    );
    procedure PrepareOptionsTask(
      const opt: mysql_option; arg: pchar;
      const TaskName : string;
      OnComplete : TmySQLClientTask_OnComplete;
      OnError    : TmySQLClientTask_OnError
    );

    procedure PrepareRefresh(
      const RefreshOptions: TSetRefreshOptions;
      const TaskName : string
    );
    procedure PrepareRefreshTask(
      const RefreshOptions: TSetRefreshOptions;
      const TaskName : string;
      OnComplete : TmySQLClientTask_OnComplete;
      OnError    : TmySQLClientTask_OnError
    );
  end;

  function Quote(pout, pin : pchar; var len : integer; const Options : TQuoteOptionsSet) : pchar;
  function QuoteString(sIn : string; const Options : TQuoteOptionsSet) : string;
//  function EscapeString(const S : string) : string; - Broken in DLL?

var
  libmysql_location : string;


//----------------------------------------------------------------------------
//----------------------------------------------------------------------------

implementation

uses
  SysUtils;


{procedure AddLog(sTemp : string);
var
  T : TextFile;
begin
  $I-
  AssignFile(T,DEBUGFILE_COMMON);

  if FileExists(DEBUGFILE_COMMON) then
    Append(T)
  else
    Rewrite(T);
  $I+

  if IOResult=0 then begin
    writeln(T,DateTimeToStr(Now)+' '+sTemp);
    CloseFile(T);
  end;
end; }

//----------------------------------------------------------------------------
//----------------------------------------------------------------------------

constructor TmySQLClientQuery.Create;
begin
  if (libmysql_status<>LIBMYSQL_READY) and (libmysql_status<>LIBMYSQL_INCOMPATIBLE) then exit;

  FTaskHandler:=nil;
  FFieldsLoaded :=FALSE;
  FCurrentTaskData:=nil;

  FData         :=TStringList.Create;
  FFields       :=TStringList.Create;
end;

destructor TmySQLClientQuery.Destroy;
begin
  FData.Free;
  FFields.Free;

  inherited;
end;

procedure TmySQLClientQuery.Reset;
begin
  FCurrentTaskData.Free;
  FCurrentTaskData:=nil;

  FFields.Clear;
  FFieldsLoaded:=FALSE;
  FData.Clear;
end;

procedure TmySQLClientQuery.Prepare(Query : pchar; const TaskName : string);
begin
  PrepareTask(Query,TaskName,FDefault_OnComplete,FDefault_OnError);
end;

procedure TmySQLClientQuery.PrepareTask(
  Query : pchar;
  const TaskName : string;
  OnComplete : TmySQLClientTask_OnComplete;
  OnError    : TmySQLClientTask_OnError
);
begin
  FTaskHandler.Thread.Prepare_mysql_query(
    task_mysql_store_result,

    Query,

    TaskName,

    _OnComplete,
    _OnError,

    OnComplete,
    OnError
  );
end;

procedure TmySQLClientQuery._OnComplete(Sender : TObject; Data : TObject);
var
  key        : pchar;
  row        : pmysql_row;
  i          : integer;
  temp       : string;
  dokey      : boolean;
begin
  FCurrentTaskData:=TmySQLClientTaskData(Data);

  if FCurrentTaskData.F_executetype=Execute_Stored then begin
    with FCurrentTaskData do begin
      if F_presults=nil then
        exit;

      dokey:=F_keyfield<(F_presults.field_count);
      temp:='';

      for i:=0 to F_presults.row_count-1 do begin
        row:=mysql_fetch_row(F_presults);
        if dokey then begin
          temp:='';
          key:=row^[F_keyfield];
          temp:=StrPas(key);
        end;
        FData.AddObject(temp,TObject(row));
      end;

      if Assigned(FTaskOnComplete) then
        FTaskOnComplete(Self);

      if FTaskHandler.FThreaded=TRUE then Reset;
    end;
  end;
end;

procedure TmySQLClientQuery._OnError(Sender: TObject; Data: TObject; Msg: string);
var
  T          : TmySQLClientTaskData;
begin
  if Data=nil then exit;

  T:=TmySQLClientTaskData(Data);

  if Assigned(T.FTaskOnError) then
    T.FTaskOnError(Self,Msg);

  Reset;
end;

function TmySQLClientQuery.Data(const i, j : longword) : pchar;
var
  R : pmysql_row;
begin
  Result:='';

  if FCurrentTaskData=nil then
    Result:=nil
  else with FCurrentTaskData do begin
    if F_presults=nil then exit;

    if i>=longword(FData.Count) then exit;

    if j>=(F_presults^.field_count) then exit;

    R:=pmysql_row(FData.Objects[i]);

    Result:=R^[j];
  end;
end;

function TmySQLClientQuery.DataAsInteger(const i, j : longword) : integer;
begin
  Result:=-1;

  if Data(i,j)<>'' then begin
    try
      Result:=StrToInt(Data(i,j));
    except
    end;
  end;
end;

function TmySQLClientQuery.DataAsDateTime(const i, j : longword) : TDateTime;
var
  Temp : string[19];
  yyyy : string[4];
  mm, dd, hh, nn, ss : string[2];
begin
  Temp:=StrPas(Data(i,j));
  if Length(Temp)<>19 then begin Result:=0; exit; end;

  yyyy:=Copy(Temp,1,4);
  mm:=Copy(Temp,6,2);
  dd:=Copy(Temp,9,2);
  hh:=Copy(Temp,12,2);
  nn:=Copy(Temp,15,2);
  ss:=Copy(Temp,18,2);

  try
    Result:=StrToDateTime(mm+'/'+dd+'/'+yyyy+' '+hh+':'+nn+':'+ss);
  except
    Result:=0;
  end;
end;

function TmySQLClientQuery.GetFieldCount : integer;
begin
  Result:=-1;

  if FCurrentTaskData.F_presults=nil then exit;

  Result:=FCurrentTaskData.F_presults^.field_count;
end;

function TmySQLClientQuery.GetDataCount : integer;
begin
  Result:=FData.Count;
end;

procedure TmySQLClientQuery.GetFields;
var
  F : pmysql_field;
begin
  if FCurrentTaskData.F_presults=nil then exit;

  F:=mysql_fetch_field(FCurrentTaskData.F_presults);

  while (f<>nil) do begin
    FFields.AddObject(StrPas(F^.name),Pointer(F));

    F:=mysql_fetch_field(FCurrentTaskData.F_presults);
  end;

  FFieldsLoaded:=TRUE;
end;

function TmySQLClientQuery.GetFieldName(const i : longint) : string;
begin
  if FCurrentTaskData.F_presults=nil then exit;

  if not FFieldsLoaded then GetFields;

  if i>=FFields.Count then exit;

  Result:=FFields[i];
end;

function TmySQLClientQuery.GetField(const i : longint) : pmysql_field;
begin
  Result:=nil;

  if FCurrentTaskData.F_presults=nil then exit;

  if not FFieldsLoaded then GetFields;

  if i>=FFields.Count then exit;

  Result:=Pointer(FFields.Objects[i]);
end;