[Delphi] DH Database Manager 0.8

[BigBear]

Un programa en Delphi para administrar bases de datos del tipo :

• MSSQL
  
• MySQL
  
• SQLite
  
  Unas imagenes :
  
  
  
  
  
  
  
  El codigo :
  
  
  Código (delphi) [Seleccionar] Expandir
  
// 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.
  Github.
  
  Eso seria todo.