Un programa en Delphi para administrar bases de datos del tipo :
- MSSQL
- MySQL
- SQLite
Unas imagenes :
(http://doddyhackman.webcindario.com/images/dhdatabaseman101.jpg)
(http://doddyhackman.webcindario.com/images/dhdatabaseman102.jpg)
(http://doddyhackman.webcindario.com/images/dhdatabaseman103.jpg)
El codigo :
// DH Database Manager 0.8
// (C) Doddy Hackman 2016
unit manager;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.ComCtrls,
Vcl.StdCtrls,
Vcl.DBCtrls, Vcl.Grids, Vcl.DBGrids, ZAbstractConnection, ZConnection,
ZAbstractTable, ZDataset, Data.DB, ZAbstractRODataset, ZAbstractDataset,
ShellApi, Vcl.ImgList, Vcl.Imaging.pngimage;
type
TFormHome = class(TForm)
imgLogo: TImage;
status: TStatusBar;
pcOptions: TPageControl;
tsConfiguration: TTabSheet;
tsOptions: TTabSheet;
tsGrid: TTabSheet;
gbConfiguration: TGroupBox;
lblHost: TLabel;
txtHostname: TEdit;
lblPort: TLabel;
txtPort: TEdit;
lblUsername: TLabel;
txtUsername: TEdit;
lblPassword: TLabel;
txtPassword: TEdit;
lblDatabase: TLabel;
txtDatabase: TEdit;
cmbService: TComboBox;
btnConnect: TButton;
btnDisconnect: TButton;
gbOptions: TGroupBox;
lblTable: TLabel;
lblSQL_Query: TLabel;
cmbTables: TComboBox;
txtSQL_Query: TEdit;
btnLoadTable: TButton;
btnExecute: TButton;
connection: TZConnection;
lblService: TLabel;
grid_connection: TDBGrid;
nav_connection: TDBNavigator;
query_connection: TZQuery;
table_connection: TZTable;
datasource_connection: TDataSource;
btnLoadDB: TButton;
odLoadDB: TOpenDialog;
btnRefreshTables: TButton;
ilIconosMenu: TImageList;
ilIconosBotones: TImageList;
procedure btnConnectClick(Sender: TObject);
procedure btnDisconnectClick(Sender: TObject);
procedure btnLoadTableClick(Sender: TObject);
procedure btnExecuteClick(Sender: TObject);
procedure cmbServiceSelect(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnLoadDBClick(Sender: TObject);
procedure btnRefreshTablesClick(Sender: TObject);
private
{ Private declarations }
procedure DragDropFile(var Msg: TMessage); message WM_DROPFILES;
public
{ Public declarations }
procedure cargarTablas();
end;
var
FormHome: TFormHome;
implementation
{$R *.dfm}
// Functions
function message_box(title, message_text, type_message: string): string;
begin
if not(title = '') and not(message_text = '') and not(type_message = '') then
begin
try
begin
if (type_message = 'Information') then
begin
MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
MB_ICONINFORMATION);
end
else if (type_message = 'Warning') then
begin
MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
MB_ICONWARNING);
end
else if (type_message = 'Question') then
begin
MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
MB_ICONQUESTION);
end
else if (type_message = 'Error') then
begin
MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
MB_ICONERROR);
end
else
begin
MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
MB_ICONINFORMATION);
end;
Result := '[+] MessageBox : OK';
end;
except
begin
Result := '[-] Error';
end;
end;
end
else
begin
Result := '[-] Error';
end;
end;
// Function to DragDrop
// Based in : http://www.clubdelphi.com/foros/showthread.php?t=85665
// Thanks to ecfisa
var
bypass_window: function(Msg: Cardinal; dwFlag: Word): BOOL; stdcall;
procedure TFormHome.DragDropFile(var Msg: TMessage);
var
nombre_archivo, extension: string;
limite, number: integer;
path: array [0 .. MAX_COMPUTERNAME_LENGTH + MAX_PATH] of char;
begin
limite := DragQueryFile(Msg.WParam, $FFFFFFFF, path, 255) - 1;
if (Win32MajorVersion = 6) and (Win32MinorVersion > 0) then
for number := 0 to limite do
begin
bypass_window(number, 1);
end;
for number := 0 to limite do
begin
DragQueryFile(Msg.WParam, number, path, 255);
//
if (FileExists(path)) then
begin
nombre_archivo := ExtractFilename(path);
extension := ExtractFileExt(path);
extension := StringReplace(extension, '.', '',
[rfReplaceAll, rfIgnoreCase]);
if (extension = 'sqlite') or (extension = 'db3') or (extension = 's3db')
then
begin
txtDatabase.Text := path;
status.Panels[0].Text := '[+] DB Loaded';
message_box('DH Database Manager 0.8', 'DB Loaded', 'Information');
end
else
begin
status.Panels[0].Text := '[-] The DB is not valid';
message_box('DH Database Manager 0.8', 'The DB is not valid',
'Warning');
end;
end;
//
end;
DragFinish(Msg.WParam);
end;
//
procedure TFormHome.cargarTablas();
var
lst: TStrings;
count: integer;
begin
if (connection.Connected = true) then
begin
try
begin
cmbTables.Clear;
lst := TStringList.Create;
connection.GetTableNames('', lst);
count := lst.count;
cmbTables.Items.Assign(lst);
lst.Free();
if (count >= 1) then
begin
cmbTables.ItemIndex := 0;
end;
ShowMessage('Tables loaded : ' + IntToStr(count));
end;
except
begin
ShowMessage('Tables not found');
end;
end;
end
else
begin
message_box('DH Database Manager 0.8', 'Not connected', 'Warning');
end;
end;
procedure TFormHome.cmbServiceSelect(Sender: TObject);
begin
if (cmbService.Text = 'MSSQL') then
begin
txtDatabase.ReadOnly := false;
btnLoadDB.Enabled := false;
end
else if (cmbService.Text = 'MYSQL') then
begin
txtDatabase.ReadOnly := false;
btnLoadDB.Enabled := false;
end
else if (cmbService.Text = 'SQLITE') then
begin
txtDatabase.Text := '';
txtDatabase.ReadOnly := true;
btnLoadDB.Enabled := true;
end
else
begin
status.Panels[0].Text := '[-] Service not found';
message_box('DH Database Manager 0.8', 'Service not found', 'Warning');
end;
end;
procedure TFormHome.FormCreate(Sender: TObject);
begin
//
if (Win32MajorVersion = 6) and (Win32MinorVersion > 0) then
begin
@bypass_window := GetProcAddress(LoadLibrary('user32.dll'),
'ChangeWindowMessageFilter');
bypass_window(WM_DROPFILES, 1);
bypass_window(WM_COPYDATA, 1);
bypass_window($0049, 1);
end;
DragAcceptFiles(Handle, true);
//
UseLatestCommonDialogs := false;
odLoadDB.InitialDir := GetCurrentDir;
odLoadDB.Filter :=
'SQLITE files (*.sqlite)|*.SQLITE|DB3 Files (*.db3)|*.DB3|S3DB File (*.s3db)|*.S3DB';
//
btnLoadDB.Enabled := false;
end;
procedure TFormHome.btnConnectClick(Sender: TObject);
begin
// MSSQL : localhost\SQLEXPRESS
// admin:123456
// MYSQL : localhost:3306
// root
if (cmbService.Text = 'MSSQL') then
begin
if (txtHostname.Text = '') or (txtUsername.Text = '') or
(txtPassword.Text = '') then
begin
status.Panels[0].Text := '[-] Missing data';
message_box('DH Database Manager 0.8', 'Missing data', 'Warning');
end
else
begin
try
begin
connection.HostName := txtHostname.Text;
if not(txtDatabase.Text = '') then
begin
connection.Database := txtDatabase.Text;
end;
connection.Database := 'sistema';
connection.Protocol := 'mssql';
connection.User := txtUsername.Text;
connection.Password := txtPassword.Text;
connection.Connect;
status.Panels[0].Text := '[+] Connected';
message_box('DH Database Manager 0.8', 'Connected', 'Information');
if not(txtDatabase.Text = '') then
begin
cargarTablas();
end;
end;
except
begin
status.Panels[0].Text := '[-] Error connecting';
message_box('DH Database Manager 0.8', 'Error connecting', 'Error');
end;
end;
end;
end
else if (cmbService.Text = 'MYSQL') then
begin
if (txtHostname.Text = '') or (txtPort.Text = '') or (txtUsername.Text = '')
then
begin
status.Panels[0].Text := '[-] Missing data';
message_box('DH Database Manager 0.8', 'Missing data', 'Warning');
end
else
begin
try
begin
connection.HostName := txtHostname.Text;
connection.Port := StrToInt(txtPort.Text);
if not(txtDatabase.Text = '') then
begin
connection.Database := txtDatabase.Text;
end;
connection.Protocol := 'mysql-5';
connection.User := txtUsername.Text;
connection.Password := txtPassword.Text;
connection.Connect;
status.Panels[0].Text := '[+] Connected';
message_box('DH Database Manager 0.8', 'Connected', 'Information');
if not(txtDatabase.Text = '') then
begin
cargarTablas();
end;
end;
except
begin
status.Panels[0].Text := '[-] Error connecting';
message_box('DH Database Manager 0.8', 'Error connecting', 'Error');
end;
end;
end;
end
else if (cmbService.Text = 'SQLITE') then
begin
if not(FileExists(txtDatabase.Text)) then
begin
status.Panels[0].Text := '[-] SQLITE Database not found';
message_box('DH Database Manager 0.8', 'SQLITE Database not found',
'Warning');
end
else
begin
try
begin
connection.Protocol := 'sqlite-3';
connection.Database := txtDatabase.Text;
connection.Connect;
status.Panels[0].Text := '[+] Connected';
message_box('DH Database Manager 0.8', 'Connected', 'Information');
if not(txtDatabase.Text = '') then
begin
cargarTablas();
end;
end;
except
begin
status.Panels[0].Text := '[-] Error connecting';
message_box('DH Database Manager 0.8', 'Error connecting', 'Error');
end;
end;
end;
end
else
begin
status.Panels[0].Text := '[-] Service not found';
message_box('DH Database Manager 0.8', 'Service not found', 'Warning');
end;
end;
procedure TFormHome.btnDisconnectClick(Sender: TObject);
begin
if connection.Connected = true then
begin
connection.Connected := false;
status.Panels[0].Text := '[+] Disconnect';
message_box('DH Database Manager 0.8', 'Disconnect', 'Information');
end
else
begin
status.Panels[0].Text := '[-] Not connected';
message_box('DH Database Manager 0.8', 'Not connected', 'Warning');
end;
end;
procedure TFormHome.btnExecuteClick(Sender: TObject);
begin
if (connection.Connected = true) then
begin
try
begin
query_connection.Active := false;
query_connection.SQL.Clear;
query_connection.SQL.Add(txtSQL_Query.Text);
query_connection.Active := true;
datasource_connection.DataSet := query_connection;
datasource_connection.DataSet.Refresh;
status.Panels[0].Text := '[+] Command Executed';
message_box('DH Database Manager 0.8', 'Command Executed',
'Information');
end;
except
on E: Exception do
begin
if (E.Message = 'Can not open a Resultset') then
begin
status.Panels[0].Text := '[?] SQL Query not return ResultSet';
message_box('DH Database Manager 0.8',
'SQL Query not return ResultSet', 'Information');
end
else
begin
status.Panels[0].Text := '[-] SQL Query Error';
message_box('DH Database Manager 0.8', 'SQL Query Error', 'Error');
end;
end;
end;
end
else
begin
status.Panels[0].Text := '[-] Not connected';
message_box('DH Database Manager 0.8', 'Not connected', 'Warning');
end;
end;
procedure TFormHome.btnLoadDBClick(Sender: TObject);
begin
if odLoadDB.Execute then
begin
txtDatabase.Text := odLoadDB.filename;
end;
end;
procedure TFormHome.btnLoadTableClick(Sender: TObject);
begin
if (connection.Connected = true) then
begin
try
begin
table_connection.Active := false;
table_connection.TableName := cmbTables.Text;
datasource_connection.DataSet := table_connection;
table_connection.Active := true;
datasource_connection.DataSet.Refresh;
status.Panels[0].Text := '[+] Table Loaded';
message_box('DH Database Manager 0.8', 'Table Loaded', 'Information');
end;
except
begin
status.Panels[0].Text := '[-] Error loading table';
message_box('DH Database Manager 0.8', 'Error loading table', 'Error');
end;
end;
end
else
begin
status.Panels[0].Text := '[-] Not connected';
message_box('DH Database Manager 0.8', 'Not connected', 'Warning');
end;
end;
procedure TFormHome.btnRefreshTablesClick(Sender: TObject);
begin
cargarTablas();
end;
end.
// The End ?
Si quieren bajar el programa lo pueden hacer de aca :
SourceForge (https://sourceforge.net/p/dh-database-manager/).
Github (https://github.com/DoddyHackman/DH_Database_Manager).
Eso seria todo.