mysqlpropedit.pas

MYSQL 连接控件 MYSQL 连接控件

  for i := 0 to PropCount - 1 do begin
     if not Assigned(TMySQLServer(GetComponent(I))) or not Assigned(TMySQLServer(GetComponent(I)).Driver) then begin
        Result := False;
        exit;
     end;
  end;
  Result := True;
end;

function TMySQLDriverProperty.GetAttributes: TPropertyAttributes;
begin
  Result := inherited GetAttributes;
  if not HasSubProperties then exclude(Result, paSubProperties);
  Result := Result - [paReadOnly] + [paValueList, paSortList, paRevertable{ paReadOnly}{$IFDEF DELPHI6UP},paVolatileSubProperties{$ENDIF}];
end;

function TMySQLDriverProperty.GetValue: string;
begin
  if HasSubProperties then
     case TMySQLServer(GetComponent(0)).DriverKind of
        {$IFDEF MYSQLDIRECT}dtDirect: Result := 'Direct';{$ENDIF}
        dtLibrary: Result := 'Library';
        {$IFDEF MYSQLEMBEDDED}dtEmbedded: Result := 'Embedded';{$ENDIF}
     end
  else
     Result := '';
end;

procedure TMySQLDriverProperty.GetValues(Proc: TGetStrProc);
begin
  Proc('Direct');
  Proc('Library');
  Proc('Embedded');
end;

procedure TMySQLDriverProperty.SetValue(const Value: string);
var
  i: integer;
begin
  for i := 0 to PropCount - 1 do begin
     if SameText(Value,'Library') then TMySQLServer(GetComponent(i)).DriverKind := dtLibrary
     {$IFDEF MYSQLEMBEDDED}else if SameText(Value,'Embedded') then TMySQLServer(GetComponent(i)).DriverKind := dtEmbedded{$ENDIF}
     {$IFDEF MYSQLDIRECT}else TMySQLServer(GetComponent(i)).DriverKind := dtDirect;{$ENDIF}
  end;
  Modified;
end;

//****************************************************
// 					TMySQLServerConnectedProperty
//****************************************************

procedure TMySQLServerConnectedProperty.SetValue(const Value: string);
begin
  if (Value='True') and  not TMySQLServer(GetComponent(0)).Connected then begin
     if (length(TMySQLServer(GetComponent(0)).DatabaseName)>0) and
        (soAutoCreate in TMySQLServer(GetComponent(0)).Options) and
        (soDropIfExists in TMySQLServer(GetComponent(0)).Options) and
        (MessageDlg('You have chosen to AutoCreate this database, "'+TMySQLServer(GetComponent(0)).DatabaseName+'", if it does not exists and also enabled DropIfExists.  Be warned, if this server is enabled now and "'+TMySQLServer(GetComponent(0)).DatabaseName+'" exists, you will lose ALL tables and data in "'+TMySQLServer(GetComponent(0)).DatabaseName+'". '+
                    'Do you wish to proceed?',mtWarning,[mbYes,mbNo],0)=mrNo) then exit;
  end;
  inherited;
end;

//****************************************************
// 					TMySQLDatasetBaseActiveProperty
//****************************************************

procedure TMySQLDatasetBaseActiveProperty.SetValue(const Value: string);
var
  S: string;
begin
  if (Value='True') and  not TMySQLDatasetBase(GetComponent(0)).Active then begin
     if not Assigned(TMySQLDatasetBase(GetComponent(0)).Server) then begin
        MessageDlg('Please set the Server property with a TMySQLServer before enabling.',mtError,[mbOK],0);
        exit;
     end;
     if (doShareConnection in TMySQLDatasetBase(GetComponent(0)).Options) and
        ((length(TMySQLDatasetBase(GetComponent(0)).DatabaseName)=0) and
        (length(TMySQLDatasetBase(GetComponent(0)).Server.DatabaseName)=0)) and
        (MessageDlg('Please specify a DatabaseName for either this dataset or it''s TMySQLServer. '+
                   'Alternatively make sure you have specified a custom "USE database;" in an SQL property in a dataset sharing this connection/thread. '+
                   'If you have not done this, enabling this dataset will fail.  Do you wish to proceed?',mtWarning,[mbYes,mbNo],0)=mrNo) then exit;
     if (doShareConnection in TMySQLDatasetBase(GetComponent(0)).Options) and
        (length(TMySQLDatasetBase(GetComponent(0)).DatabaseName)>0) and
        (TMySQLDatasetBase(GetComponent(0)).DatabaseName<>TMySQLDatasetBase(GetComponent(0)).Server.DatabaseName) and
        (MessageDlg('Please take note that this dataset shares the connection to the MySQL Server with it''s server and currently also with '+
                    IntToStr(TMySQLDatasetBase(GetComponent(0)).Server.DataSetCount-1)+' other datasets. '+
                   'Setting the databasename to another database than the TMySQLServer''s will change the current database for all the datasets and TMySQLServer using this connection/thread. Do you wish to proceed?',mtWarning,[mbYes,mbNo],0)=mrNo) then exit;
     if not(doShareConnection in TMySQLDatasetBase(GetComponent(0)).Options) and
        ((length(TMySQLDatasetBase(GetComponent(0)).DatabaseName)=0) and
        (length(TMySQLDatasetBase(GetComponent(0)).Server.DatabaseName)=0)) and
        (MessageDlg('This dataset will utilize it''s own connection/thread to the MySQL server and as such needs to specify the database for the connection/thread, i.e. "USE database;". '+
                   'If you have not specified a "USE database;" in the SQL properties, opening the dataset might fail. Alternatively please set the DatabaseName property for it or it''s TMySQLServer. Do you wish to proceed?',mtWarning,[mbYes,mbNo],0)=mrNo) then exit;
     if (GetComponent(0) is TMySQLTable) and
        (length(TMySQLDatasetBase(GetComponent(0)).TableName)=0) then begin
        MessageDlg('Please specify a TableName for this dataset.',mtError,[mbOK],0);
        exit;
     end;
     if ((GetComponent(0) is TMySQLDataset) or (GetComponent(0) is TMySQLQuery)) and
        (length(TMySQLDatasetBase(GetComponent(0)).TableName)=0) and
        (MessageDlg('Without a TableName specified, this dataset will not be updateble unless you have specified custom SQL in all the SQLDelete/-Insert and -Update properties. Besides this, activating this dataset will fail without a custom select in the SQL property. '+
                    'Do you wish to proceed?',mtWarning,[mbYes,mbNo],0)=mrNo) then exit;
     if not TMySQLDatasetBase(GetComponent(0)).Server.Connected and
        (length(TMySQLDatasetBase(GetComponent(0)).Server.DatabaseName)>0) and
        (soAutoCreate in TMySQLDatasetBase(GetComponent(0)).Server.Options) and
        (soDropIfExists in TMySQLDatasetBase(GetComponent(0)).Server.Options) and
        (MessageDlg('Enabling this dataset will automatically connect it''s TMySQLServer, "'+TMySQLDatasetBase(GetComponent(0)).Server.Name+'", which has AutoCreate option set for database "'+TMySQLDatasetBase(GetComponent(0)).Server.DatabaseName+'", which will recreate the database if it does not exists and also enabled is DropIfExists.  Be warned, if this dataset is enabled now and "'+TMySQLDatasetBase(GetComponent(0)).Server.DatabaseName+'" exists, you will lose ALL tables and data in "'+TMySQLDatasetBase(GetComponent(0)).Server.DatabaseName+'". '+
                    'Do you wish to proceed?',mtWarning,[mbNo,mbYes],0)=mrNo) then exit;
     if (length(TMySQLDatasetBase(GetComponent(0)).TableName)>0) and
        ((length(TMySQLDatasetBase(GetComponent(0)).DatabaseName)>0) or
        (length(TMySQLDatasetBase(GetComponent(0)).Server.DatabaseName)>0)) then begin
        if (length(TMySQLDatasetBase(GetComponent(0)).DatabaseName)>0) then S := TMySQLDatasetBase(GetComponent(0)).DatabaseName+'.'+TMySQLDatasetBase(GetComponent(0)).TableName
        else if (length(TMySQLDatasetBase(GetComponent(0)).Server.DatabaseName)>0) then S := TMySQLDatasetBase(GetComponent(0)).Server.DatabaseName+'.'+TMySQLDatasetBase(GetComponent(0)).TableName;
        if (doAutoCreate in TMySQLDatasetBase(GetComponent(0)).Options) and
           (doDropIfExists in TMySQLDatasetBase(GetComponent(0)).Options) and
           (MessageDlg('You have chosen to AutoCreate this table, "'+S+'", if it does not exists and also enabled DropIfExists.  Be warned, if this dataset is enabled now and "'+S+'" exists you will lose ALL data in "'+S+'". '+
                       'Do you wish to proceed?',mtWarning,[mbYes,mbNo],0)=mrNo) then exit;
     end;
  end;
  inherited;
end;


//****************************************************
// 					TMySQLDatabaseNameProperty
//****************************************************

procedure TMySQLDatabaseNameProperty.GetValueList(List: TStrings);
begin
	if GetComponent(0) is TMySQLServer then
  	TMySQLServer(GetComponent(0)).GetDatabaseNames(List)
  else
  	if Assigned(TMySQLDatasetBase(GetComponent(0)).Server) then
			TMySQLDatasetBase(GetComponent(0)).Server.GetDatabaseNames(List)
     else
     	MessageDlg('Must select Server first',mtError,[mbOK],0);
end;

//****************************************************
// 					TMySQLTableNameProperty
//****************************************************

procedure TMySQLDSTableNameProperty.GetValueList(List: TStrings);
begin
	if Assigned(TMySQLDatasetBase(GetComponent(0)).Server) and
     ((length(TMySQLDatasetBase(GetComponent(0)).DatabaseName)>0) or
     (length(TMySQLDatasetBase(GetComponent(0)).Server.DatabaseName)>0)) then
		TMySQLDatasetBase(GetComponent(0)).Server.GetTableNames(TMySQLDatasetBase(GetComponent(0)).DatabaseName,List)
  else
  	MessageDlg('Must select Server first and optionally a DatabaseName if the TMySQLServer does not have one set',mtError,[mbOK],0);
end;

//****************************************************
// 					TMySQLFieldNameProperty
//****************************************************

procedure TMySQLDSFieldNameProperty.GetValueList(List: TStrings);
begin
	if Assigned(TMySQLDatasetBase(GetComponent(0)).Server) and
     ((length(TMySQLDatasetBase(GetComponent(0)).DatabaseName)>0) or
     (length(TMySQLDatasetBase(GetComponent(0)).Server.DatabaseName)>0)) and
     (length(TMySQLDatasetBase(GetComponent(0)).TableName)>0) then
		TMySQLDatasetBase(GetComponent(0)).Server.GetFieldNames(TMySQLDatasetBase(GetComponent(0)).DatabaseName,TMySQLDatasetBase(GetComponent(0)).TableName,List)
  else
  	MessageDlg('Must select Server && DatabaseName && TableName first',mtError,[mbOK],0);
end;

procedure Register;
begin
  // Classes
  RegisterClass(TMySQLStringField);
  RegisterClass(TMySQLBase);
  {$IFDEF MYSQLDIRECT}
  RegisterClass(TMySQLDirect);
  {$ENDIF}
  RegisterClass(TMySQLLibrary);
  {$IFDEF MYSQLEMBEDDED}
  RegisterClass(TMySQLEmbedded);
  {$ENDIF}
	// Components
  RegisterComponents('MySQL', [TMySQLServer,TMySQLDataset,TMySQLTable,TMySQLQuery]);
  // Prop Editors
  RegisterPropertyEditor(TypeInfo(TMySQLDriverType), TMySQLServer, 'DriverKind', TMySQLDriverKindProperty);
  RegisterPropertyEditor(TypeInfo(TMySQLBase), TMySQLServer, 'DriverProperties', TMySQLDriverProperty);
  RegisterPropertyEditor(TypeInfo(string), TMySQLServer, 'DatabaseName', TMySQLDatabaseNameProperty);
  RegisterPropertyEditor(TypeInfo(string), TMySQLDatasetBase, 'DatabaseName', TMySQLDatabaseNameProperty);
  RegisterPropertyEditor(TypeInfo(string), TMySQLDatasetBase, 'TableName', TMySQLDSTableNameProperty);
  RegisterPropertyEditor(TypeInfo(string), TMySQLDatasetBase, 'FieldName', TMySQLDSFieldNameProperty);
  RegisterPropertyEditor(TypeInfo(string), TMySQLTable, 'IndexFieldNames', TMySQLDSFieldNameProperty);
  RegisterPropertyEditor(TypeInfo(string), TMySQLDatasetBase, 'MasterFields', TMySQLMasterFieldsProperty);
  RegisterPropertyEditor(TypeInfo(boolean), TMySQLDatasetBase, 'Active', TMySQLDatasetBaseActiveProperty);
  RegisterPropertyEditor(TypeInfo(boolean), TMySQLServer, 'Connected', TMySQLServerConnectedProperty);
end;

end.