⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mysqlserver.pas

📁 MYSQL 连接控件 MYSQL 连接控件
💻 PAS
📖 第 1 页 / 共 3 页
字号:
           EndUpdate;
        end;
     end;
     if (soCloseOnChildren in FConOptions) and Assigned(FConnection) and CheckChildrenAllClosed then Close;
  end;
end;

procedure TMySQLServer.GetFieldNames(const DatabaseName, TableName: string; List: TStrings);
var
   R: pointer;
   Row: PMYSQL_ROW;
begin
	ActivateConnection;
  if Connected then
     with List do begin
        BeginUpdate;
        try
           Clear;
           if (length(TableName)>0) and (length(DatabaseName)>0) then begin
              R := Driver.OpenQuery(FConnection, 'show columns from '+FormatIdentifier(DatabaseName)+'.'+FormatIdentifier(TableName));
              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;
           end;
        finally
          EndUpdate;
        end;
        if (soCloseOnChildren in FConOptions) and Assigned(FConnection) and CheckChildrenAllClosed then Close;
     end;
end;

function TMySQLServer.AllocConnection: pointer;
var
  Comp: integer;
begin
  Comp := 0;
  if coLongPassword in FConOptions then Comp := Comp or CLIENT_LONG_PASSWORD;
  if coFoundRows in FConOptions then Comp := Comp or CLIENT_FOUND_ROWS;
  if coLongFlag in FConOptions then Comp := Comp or CLIENT_LONG_FLAG;
  if coConnectWithDB in FConOptions then Comp := Comp or CLIENT_CONNECT_WITH_DB;
  if coNoSchema in FConOptions then Comp := Comp or CLIENT_NO_SCHEMA;
  if coCompress in FConOptions then Comp := Comp or CLIENT_COMPRESS;
  if coODBC in FConOptions then Comp := Comp or CLIENT_ODBC;
  if coLocalFiles in FConOptions then Comp := Comp or CLIENT_LOCAL_FILES;
  if coIgnoreSpace in FConOptions then Comp := Comp or CLIENT_IGNORE_SPACE;
  if coInteractive in FConOptions then Comp := Comp or CLIENT_INTERACTIVE;
  {$IFDEF HAVE_SSL}
  if coSSL in FConOptions then Comp := Comp or CLIENT_SSL;
  {$ENDIF}
  if coIgnoreSigpipe in FConOptions then Comp := Comp or CLIENT_IGNORE_SIGPIPE;
  if coTransactions in FConOptions then Comp := Comp or CLIENT_TRANSACTIONS;
  if coProtocol41 in FConOptions then Comp := Comp or CLIENT_PROTOCOL_41;
  if coSecureConnection in FConOptions then Comp := Comp or CLIENT_SECURE_CONNECTION;
  if coMultiQueries in FConOptions then Comp := Comp or CLIENT_MULTI_QUERIES;
  Result := Driver.Open(FHost,FUsername,FPassword,FPort,Comp,FDBName);
end;

function TMySQLServer.CheckChildrenAllClosed: boolean;
var
  i: integer;
begin
  Result := True;
  for i := 0 to FOwnDatasets.Count-1 do begin
     Result := Result and not TMySQLDatasetBase(FOwnDatasets.Objects[i]).Active;
     if not Result then exit;
  end;
  for i := 0 to DatasetCount-1 do begin
     Result := Result and not TMySQLDatasetBase(Datasets[i]).Active;
     if not Result then exit;
  end;
end;

procedure TMySQLServer.FreeConnection(var Value: pointer);
begin
  if Assigned(Driver) and Assigned(FConnection) and (Value<>FConnection) then Driver.Close(Value)
  else Value := nil;
  if (soCloseOnChildren in FConOptions) and Assigned(FConnection) and CheckChildrenAllClosed then Close;
end;

{$IFDEF IDEONLY}
function IDERunning: boolean;
begin
  {$IFDEF MSWINDOWS}
  Result := FindWindow('TAppBuilder',nil)>0;
  {$ELSE}
  Result := False;
  {$ENDIF}
end;
{$ENDIF}

procedure TMySQLServer.DoConnect;
var
  APort,ADB: string;
begin
	if Assigned(FConnection) then DoDisconnect;
  {$IFDEF IDEONLY}
     if not IDERunning then
  	{$IFNDEF CONSOLEAPP}
  		MessageDlg('MySQL access provided by SciBit.'#10#13'See http://www.scibit.com',mtInformation,[mbOK],0);
     {$ELSE}
	      WriteLn('MySQL access provided by SciBit.'#10#13'See http://www.scibit.com');
     {$ENDIF}
  {$ENDIF}
  if Assigned(FOnLogin) then FOnLogin(Self,Params);
  FHost := ReadIniString(Params.Text,'client','host',FHost);
  APort := ReadIniString(Params.Text,'client','port',IntToStr(FPort));
  FUsername := ReadIniString(Params.Text,'client','user',FUsername);
  FPassword := ReadIniString(Params.Text,'client','password',FPassword);
  {$IFNDEF CONSOLEAPP}
  if LoginPrompt and not MySQLLoginDialog(FHost,APort,FUsername,FPassword) then exit;
  {$ENDIF}
  FPort := StrToIntDef(APort,FPort);
  if (soAutoCreate in Options) and (length(FDBName)>0) then begin
     ADB := FDBName;
     DatabaseName := '';
  end;
  FConnection := AllocConnection;
  try
     if Driver.ServerVer<32100 then begin
        DoDisconnect;
        MYSQLError(Driver,FConnection,-1,'Only compatible with MySQL Server 3.21.xx and higher. Your version: '+IntToStr(Driver.ServerVer));
     end;
     if (soAutoCreate in Options) then begin
        FDBName := ADB;
        CreateDatabase(True);
     end;
     if not(coConnectWithDB in FConOptions) and (length(DatabaseName)>0) then SetDatabaseName(DatabaseName);
  except
     Driver.Close(FConnection);
     raise;
  end;
end;

procedure TMySQLServer.DoDisconnect;
begin
  if Assigned(Driver) and Assigned(FConnection) then Driver.Close(FConnection);
end;

procedure TMySQLServer.SetConnected(Value: boolean);
begin
  {$IFNDEF CONSOLEAPP}
  {$IFDEF MYSQLEMBEDDED}
  if Value and (Value<>Connected) and (csDesigning in ComponentState) and (DriverKind=dtEmbedded) and (Driver.Options.IndexOfName('basedir')<0) then
     if MessageDlg('You have not specified a "basedir" in either the TMySQLServer''s [embedded] Options, nor in the driver''s Options! '+
                   'Click Yes if you wish to proceed to enable this server, and you are sure you have an [embedded] or [server] group in your my.cnf file. '+
                   'Click Abort if you want to abort this connecting request.  If you don''t specify a basedir to a valid mysql database for the embedded server, '+
                   'your application my become unstable, in this case your application will be your IDE. See the component helpfile on Embeddeding mysql server for more information.',
        mtWarning,[mbYes,mbAbort],0)=mrAbort then exit;
  {$ENDIF}
  {$ENDIF}
  inherited;
end;

function TMySQLServer.GetConnected;
begin
	Result := Assigned(Driver) and Assigned(FConnection);
end;

function TMySQLServer.GetClientVersion: string;
begin
  Result := Driver.ClientInfo;
end;

function TMySQLServer.GetClientVer: integer;
begin
  Result := Driver.ClientVer;
end;

function TMySQLServer.GetServerVersion: string;
begin
  Result := Driver.ServerInfo(FConnection);
end;

function TMySQLServer.GetServerVer: integer;
begin
  Result := Driver.ServerVer;
end;

function TMySQLServer.GetHost;
begin
	Result := FHost;
end;

function TMySQLServer.GetPort;
begin
	Result := FPort;
end;

function TMySQLServer.GetUserName;
begin
  Result := FUserName;
end;

function TMySQLServer.GetPassword;
begin
  Result := FPassword;
end;

function TMySQLServer.GetCompression;
begin
  Result := coCompress in FConOptions;
end;

function TMySQLServer.GetOptions;
begin
  Result := FConOptions;
end;

function TMySQLServer.GetDriver: TMySQLBase;
begin
  Result := FDriver
end;

procedure TMySQLServer.SetCompression(Value: boolean);
begin
  if (coCompress in Options)<>Value then begin
     Connected := False;
     if Value then Include(FConOptions,coCompress)
     else Exclude(FConOptions,coCompress);
  end;
end;

procedure TMySQLServer.SetDriverType(Value: TMySQLDriverType);
var
  S: string;
begin
  if FDriverType<>Value then begin
     if Connected then Connected := False
     else begin
        SendConnectEvent(False);
        DoDisconnect;
     end;
     if Assigned(FDriver) then FreeAndNil(FDriver);
     case Value of
        {$IFDEF MYSQLDIRECT}dtDirect: begin
                                         FDriver := TMySQLDirect.Create(ReadIniSection(Params.Text,'direct',''));
                                         S := 'direct';
                                      end;{$ENDIF}
        dtLibrary: begin
                    FDriver := TMySQLLibrary.Create(ReadIniSection(Params.Text,'client',''));
                    S := 'client';
                   end;
        {$IFDEF MYSQLEMBEDDED}dtEmbedded: FDriver := TMySQLEmbedded.Create(ReadIniSection(Params.Text,'embedded',''));{$ENDIF}
     end;
     FDriverType := Value;
     case FProtocolType of
        ptTCP: Params.Text := WriteIniString(Params.Text,S,'protocol','tcp');
        ptPipe: Params.Text := WriteIniString(Params.Text,S,'protocol','pipe');
     end;
  end
  {$IFDEF MYSQLDIRECT}
  else
     if Assigned(FDriver) and (FDriverType=dtDirect) then FDriver.Options.Text := ReadIniSection(Params.Text,'direct','');
  {$ENDIF}
end;

procedure TMySQLServer.SetProtocolType(Value: TMySQLProtocolType);
var
  S: string;
begin
  if FProtocolType<>Value then begin
     if Connected then Connected := False
     else begin
        SendConnectEvent(False);
        DoDisconnect;
     end;
     FProtocolType := Value;
     case FDriverType of
        {$IFDEF MYSQLDIRECT}dtDirect: S := 'direct';{$ENDIF}
        dtLibrary: S := 'client';
        {$IFDEF MYSQLEMBEDDED}dtEmbedded: S := 'embedded';{$ENDIF}
     end;
     case FProtocolType of
        ptTCP: Params.Text := WriteIniString(Params.Text,S,'protocol','tcp');
        ptPipe: Params.Text := WriteIniString(Params.Text,S,'protocol','pipe');
     end;
     FDriver.Options.Text := ReadIniSection(Params.Text,S,'');
  end
end;

procedure TMySQLServer.SetDriver(Value: TMySQLBase);
begin
  if FDriver<>Value then begin
     Connected := False;
     if Assigned(FDriver) then FreeAndNil(FDriver);
     FDriver := Value;
  end;
end;

procedure TMySQLServer.SetDatabaseName;
begin
	if Value<>FDBName then FDBName := Value;
  if not (csLoading in ComponentState) and Connected then SelectDatabase(Value,FConnection);
end;

procedure TMySQLServer.SetHost(Value: string);
begin
  if FHost<>Value then begin
     Connected := False;
     FHost := Value;
  end;
end;

procedure TMySQLServer.SetPort(Value: word);
begin
  if FPort<>Value then begin
     Connected := False;
     FPort := Value;
  end;
end;

procedure TMySQLServer.SetUserName(Value: string);
begin
  if FUserName<>Value then begin
     Connected := False;
     FUserName := Value;
  end;
end;

procedure TMySQLServer.SetPassword(Value: string);
begin
  if FPassword<>Value then begin
     Connected := False;
     FPassword := Value;
  end;
end;

procedure TMySQLServer.SetParams(Value: TStrings);
begin
  if FParams.Text<>Value.Text then begin
     Connected := False;
     if Assigned(FDriver) then
        case FDriverType of
           {$IFDEF MYSQLDIRECT}dtDirect: FDriver.Options.Text := ReadIniSection(Value.Text,'direct','');{$ENDIF}
           dtLibrary: FDriver.Options.Text := ReadIniSection(Value.Text,'client','');
           {$IFDEF MYSQLEMBEDDED}dtEmbedded: FDriver.Options.Text := ReadIniSection(Value.Text,'embedded','');{$ENDIF}
        end;
     FParams.Assign(Value);
  end;
end;

procedure TMySQLServer.SetOptions;
begin
  if FConOptions<>Value then begin
     Connected := False;
     FConOptions := Value;
  end;
end;


end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -