mysqlserver.pas

MYSQL 连接控件 MYSQL 连接控件

	inherited;
end;

procedure TMySQLServer.Connect;
begin
  SetConnected(True);
end;

procedure TMySQLServer.Disconnect;
begin
  SetConnected(False);
end;

procedure TMySQLServer.Link(const Detail,Master,Condition: string);
var
	i,j: integer;
  DS: TDatasource;
  M,D: TMySQLDataset;
begin
	i := FindDataset(Master);
  if i>-1 then begin
  	M := TMySQLDataset(FOwnDatasets.Objects[i]);
  	j := FindDataset(Detail);
     if (j>-1) then begin
     	D := TMySQLDataset(FOwnDatasets.Objects[j]);
        if Assigned(D.MasterSource) and (D.MasterSource.DataSet=M) and SameText(Condition,D.MasterFields) then exit;
        UnLink(Detail);
        DS := TDatasource.Create(nil);
        DS.DataSet := M;
        D.MasterFields := Condition;
        D.MasterSource := DS;
     end else MYSQLError(Driver,FConnection,1,'Detail dataset "'+Detail+'" not found.');
  end else MYSQLError(Driver,FConnection,1,'Master dataset "'+Master+'" not found.');
end;

procedure TMySQLServer.UnLink(const Detail: string);
var
	i: integer;
  DS: TDatasource;
begin
	i := FindDataset(Detail);
  if i>-1 then begin
  	if Assigned(TMySQLDataset(FOwnDatasets.Objects[i]).MasterSource) then begin
     	DS := TMySQLDataset(FOwnDatasets.Objects[i]).MasterSource;
        DS.DataSet := nil;
        FreeAndNil(DS);
     end;
     TMySQLDataset(FOwnDatasets.Objects[i]).MasterSource := nil;
     TMySQLDataset(FOwnDatasets.Objects[i]).MasterFields := '';
  end else MYSQLError(Driver,FConnection,1,'Detail dataset "'+Detail+'" not found.');
end;

procedure TMySQLServer.FreeDataset(const AName: string='');
var
	i: integer;
begin
	i := FindDataset(AName);
	if i>-1 then begin
    	TMySQLDataset(FOwnDatasets.Objects[i]).Close;
    	UnLink(FOwnDatasets[i]);
    	TMySQLDataset(FOwnDatasets.Objects[i]).Server := nil;
    	TMySQLDataset(FOwnDatasets.Objects[i]).Free;
    	FOwnDatasets.Objects[i] := nil;
     FOwnDatasets.Delete(i);
  end;
end;

function TMySQLServer.FindDataset(const AName: string=''): integer;
begin
	Result := -1;
  if not Assigned(FOwnDatasets) then exit;
  Result := FOwnDatasets.IndexOf(AName);
end;

function TMySQLServer.NewDataset(const AName: string=''; const Table: string=''): TDataset;
var
	i: integer;
begin
	Result := nil;
  if not Assigned(FOwnDatasets) then exit;
  i := FOwnDatasets.AddObject(AName,TMySQLDataset.Create(nil));
  TMySQLDataset(FOwnDatasets.Objects[i]).Server := Self;
  TMySQLDataset(FOwnDatasets.Objects[i]).Options := TMySQLDataset(FOwnDatasets.Objects[i]).Options - [doRetrieveFieldValues,doRetrieveIndexDefs];
  if length(Table)>0 then TMySQLDataset(FOwnDatasets.Objects[i]).TableName := Table;
  Result := TMySQLDataset(FOwnDatasets.Objects[i]);
end;

function TMySQLServer.Dataset(const AName: string='';const Table: string='';AutoOpen: boolean=False; const Master: string=''; const Condition: string=''): TDataset;
var
	i: integer;
  T: TDataset;
begin
	Result := nil;
	i := FindDataset(AName);
	if i>-1 then T := TMySQLDataset(FOwnDatasets.Objects[i])
  else T := NewDataset(AName,Table);
  if not Assigned(T) then exit;
	if length(Master)>0 then Link(AName,Master,Condition);
  if AutoOpen then T.Open;
  Result := T;
end;

function TMySQLServer.DatasetFrom(const SQL: string='';const AName: string='';AutoOpen: boolean=True; const Master: string=''; const Condition: string=''): TDataset;
var
	i: integer;
  T: TDataset;
begin
	Result := nil;
	i := FindDataset(AName);
	if i>-1 then T := TMySQLDataset(FOwnDatasets.Objects[i])
  else T := NewDataset(AName,'');
  if not Assigned(T) then exit;
  if not SameText(TMySQLDataset(T).SQL.Text,SQL) then TMySQLDataset(T).SQL.Text := SQL;
  if length(Master)>0 then Link(AName,Master,Condition);
  if AutoOpen then T.Open;
  Result := T;
end;

procedure TMySQLServer.ActivateConnection;
begin
  if not Assigned(FConnection) then Connected := True;
end;

function TMySQLServer.SelectDatabase(Value: string; Conn: pointer = nil): boolean;
begin
	if length(Value)>0 then begin
     if Conn=FConnection then ActivateConnection;
     if Assigned(Conn) then Result := Driver.SelectDatabase(Conn,Value)
     else Result := Driver.SelectDatabase(FConnection,Value)
  end else Result:= True;
end;

function TMySQLServer.CreateDatabase(const AExecSQL: boolean=False): string;
var
  SQL: TStringList;
  i: integer;
begin
  SQL := TStringList.Create;
  try
     if length(DatabaseName)>0 then begin
        if soDropIfExists in Options then SQL.Add('drop database if exists '+FormatIdentifier(DatabaseName)+';');
        SQL.Add('create database if not exists '+FormatIdentifier(DatabaseName)+';');
        SQL.Add('use '+FormatIdentifier(DatabaseName)+';');
     end;
     for i := 0 to FOwnDatasets.Count-1 do
        if doAutoCreate in TMySQLDatasetBase(FOwnDatasets[i]).Options then SQL.Add(TMySQLDatasetBase(FOwnDatasets[i]).CreateTable);
     for i := 0 to DatasetCount-1 do
        if doAutoCreate in TMySQLDatasetBase(Datasets[i]).Options then SQL.Add(TMySQLDatasetBase(Datasets[i]).CreateTable);
     if length(DatabaseName)>0 then SQL.Add('use '+FormatIdentifier(DatabaseName)+';');
     if AExecSQL then ExecSQLBatch(SQL);
     Result := SQL.Text;
  finally
     SQL.Free;
  end;
end;

procedure TMySQLServer.CreateDatabase(Value: string; Conn: pointer = nil);
begin
	ActivateConnection;
  if Assigned(Conn) then Driver.CreateDatabase(Conn,Value)
  else Driver.CreateDatabase(FConnection,Value);
  if (soCloseOnChildren in FConOptions) and Assigned(FConnection) and CheckChildrenAllClosed then Close;
end;

procedure TMySQLServer.DropDatabase;
begin
	ActivateConnection;
  if Assigned(Conn) then Driver.DropDatabase(Conn,Value)
  else Driver.DropDatabase(FConnection,Value);
  if (soCloseOnChildren in FConOptions) and Assigned(FConnection) and CheckChildrenAllClosed then Close;
end;

function TMySQLServer.ExecSQL(SQL: string): boolean;
var
  R: pointer;
begin
	ActivateConnection;
  Result := False;
  if Assigned(FConnection) then begin
  	if (Driver.ServerVer<32200) and (length(SQL)>0) and (SQL[length(SQL)]=';') then SQL := copy(SQL,1,length(SQL)-1);
     R := Driver.OpenQuery(FConnection,SQL);
     Driver.CloseQuery(R);
     Result := True;
  end;
  if (soCloseOnChildren in FConOptions) and Assigned(FConnection) and CheckChildrenAllClosed then Close;
end;

function TMySQLServer.ExecSQLBatch(SQL: TStrings): boolean;
var
  i: integer;
  Script: TStringList;
begin
  Result := True;
  Script := TStringList.Create;
  try
  	Script.Text := SQL.Text;
     ParseScript(Script);
     if Script.Count>0 then
     	for i := 0 to Script.Count-1 do
        	Result := Result and ExecSQL(Script[i])
     else
     	Result := False;
  finally
  	Script.Free;
  end;
end;

function TMySQLServer.Ping: boolean;
begin
	Result := Connected and Driver.Ping(FConnection);
end;

function TMySQLServer.ConnectionDatabase(Conn: pointer = nil): string;
var
   R: pointer;
   Row: PMYSQL_ROW;
   C: pointer;
begin
  if Assigned(Conn) then C := Conn
  else C := FConnection;
  Result := '';
  if Assigned(C) then begin
     R := Driver.OpenQuery(C,'select database() as FDB;');
     if not Assigned(R) then exit;
     try
        Row := Driver.RetrieveRow(R);
        while Assigned(Row) do begin
           if length(Result)=0 then Result := Row[0];
           Row := Driver.RetrieveRow(R);
        end;
     finally
        Driver.CloseQuery(R);
     end;
  end;
end;

procedure TMySQLServer.GetDatabaseNames(List: TStrings);
var
   R: pointer;
   Row: PMYSQL_ROW;
begin
  ActivateConnection;
  if Connected then begin
     with List do begin
       BeginUpdate;
       try
         Clear;
         R := Driver.OpenQuery(FConnection,'show databases');
         if not Assigned(R) then exit;
         try
            Row := Driver.RetrieveRow(R);
            while Assigned(Row) do begin
               List.Add(TrimRight(Row[0]));
               Row := Driver.RetrieveRow(R);
            end;
         finally
            Driver.CloseQuery(R);
         end;
       finally
         EndUpdate;
       end;
     end;
     if (soCloseOnChildren in FConOptions) and Assigned(FConnection) and CheckChildrenAllClosed then Close;
  end;
end;

function TMySQLServer.EscapeStr(const Value: string): string;
begin
  if Assigned(Driver) then
     Result := Driver.EscapeStr(Value)
  else
     Result := Value;
end;

function  TMySQLServer.FormatIdentifier(const Value: string=''): string;
begin
  if Assigned(Driver) then
 	   Result := Driver.FormatIdentifier(Value)
  else
     Result := Value;
end;

function TMySQLServer.GetLock(const Value: string = 'MyLock'; TimeOut: integer = 0): integer;
var
   R: pointer;
   Row: PMYSQL_ROW;
   S: string;
begin
	Result := -1;
	ActivateConnection;
  if Connected then begin
  	S := 'select get_lock('''+Value+''','+IntToStr(TimeOut)+');';
     R := Driver.OpenQuery(FConnection,S);
     if not Assigned(R) then exit;
     try
        Row := Driver.RetrieveRow(R);
        while Assigned(Row) do begin
           Result := StrToIntDef(Row[0],-1);
           Row := Driver.RetrieveRow(R);
        end;
     finally
        Driver.CloseQuery(R);
     end;
  end;
end;

function TMySQLServer.ReleaseLock(const Value: string): integer;
var
   R: pointer;
   Row: PMYSQL_ROW;
   S: string;
begin
	Result := -1;
	ActivateConnection;
  if Connected then begin
  	S := 'select release_lock('''+Value+''');';
     R := Driver.OpenQuery(FConnection,S);
     if not Assigned(R) then exit;
     try
        Row := Driver.RetrieveRow(R);
        while Assigned(Row) do begin
           Result := StrToIntDef(Row[0],-1);
           Row := Driver.RetrieveRow(R);
        end;
     finally
        Driver.CloseQuery(R);
     end;
  end;
end;

procedure TMySQLServer.GetTableNames(const DatabaseName: string; List: TStrings; const Conn: pointer = nil);
var
   R: pointer;
   Row: PMYSQL_ROW;
   S: string;
begin
	ActivateConnection;
  if Connected then begin
     with List do begin
        BeginUpdate;
        try
           Clear;
           if length(DatabaseName)>0 then
             S := 'show tables from '+FormatIdentifier(DatabaseName)
           else
             S := 'show tables';
           if Assigned(Conn) then R := Driver.OpenQuery(Conn,S)
           else R := Driver.OpenQuery(FConnection,S);
           if not Assigned(R) then exit;
           try
              Row := Driver.RetrieveRow(R);
              while Assigned(Row) do begin
                 List.Add(TrimRight(PChar(Row[0])));
                 Row := Driver.RetrieveRow(R);
              end;
           finally
             Driver.CloseQuery(R);
           end;
        finally