[Delphi] DH Database Manager 0.8

  • 0 Respuestas
  • 3263 Vistas

0 Usuarios y 1 Visitante están viendo este tema.

Desconectado BigBear

  • *
  • Underc0der
  • Mensajes: 543
  • Actividad:
    0%
  • Reputación 3
    • Ver Perfil

[Delphi] DH Database Manager 0.8

  • en: Octubre 28, 2016, 05:16:16 pm
Un programa en Delphi para administrar bases de datos del tipo :

  • MSSQL[/li]
  • MySQL[/li]
  • SQLite[/li][/list]

    Unas imagenes :







    El codigo :

    Código: Delphi
    1. // DH Database Manager 0.8
    2. // (C) Doddy Hackman 2016
    3.  
    4. unit manager;
    5.  
    6. interface
    7.  
    8. uses
    9.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
    10.   System.Classes, Vcl.Graphics,
    11.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.ComCtrls,
    12.   Vcl.StdCtrls,
    13.   Vcl.DBCtrls, Vcl.Grids, Vcl.DBGrids, ZAbstractConnection, ZConnection,
    14.   ZAbstractTable, ZDataset, Data.DB, ZAbstractRODataset, ZAbstractDataset,
    15.   ShellApi, Vcl.ImgList, Vcl.Imaging.pngimage;
    16.  
    17. type
    18.   TFormHome = class(TForm)
    19.     imgLogo: TImage;
    20.     status: TStatusBar;
    21.     pcOptions: TPageControl;
    22.     tsConfiguration: TTabSheet;
    23.     tsOptions: TTabSheet;
    24.     tsGrid: TTabSheet;
    25.     gbConfiguration: TGroupBox;
    26.     lblHost: TLabel;
    27.     txtHostname: TEdit;
    28.     lblPort: TLabel;
    29.     txtPort: TEdit;
    30.     lblUsername: TLabel;
    31.     txtUsername: TEdit;
    32.     lblPassword: TLabel;
    33.     txtPassword: TEdit;
    34.     lblDatabase: TLabel;
    35.     txtDatabase: TEdit;
    36.     cmbService: TComboBox;
    37.     btnConnect: TButton;
    38.     btnDisconnect: TButton;
    39.     gbOptions: TGroupBox;
    40.     lblTable: TLabel;
    41.     lblSQL_Query: TLabel;
    42.     cmbTables: TComboBox;
    43.     txtSQL_Query: TEdit;
    44.     btnLoadTable: TButton;
    45.     btnExecute: TButton;
    46.     connection: TZConnection;
    47.     lblService: TLabel;
    48.     grid_connection: TDBGrid;
    49.     nav_connection: TDBNavigator;
    50.     query_connection: TZQuery;
    51.     table_connection: TZTable;
    52.     datasource_connection: TDataSource;
    53.     btnLoadDB: TButton;
    54.     odLoadDB: TOpenDialog;
    55.     btnRefreshTables: TButton;
    56.     ilIconosMenu: TImageList;
    57.     ilIconosBotones: TImageList;
    58.     procedure btnConnectClick(Sender: TObject);
    59.     procedure btnDisconnectClick(Sender: TObject);
    60.     procedure btnLoadTableClick(Sender: TObject);
    61.     procedure btnExecuteClick(Sender: TObject);
    62.     procedure cmbServiceSelect(Sender: TObject);
    63.     procedure FormCreate(Sender: TObject);
    64.     procedure btnLoadDBClick(Sender: TObject);
    65.     procedure btnRefreshTablesClick(Sender: TObject);
    66.   private
    67.     { Private declarations }
    68.     procedure DragDropFile(var Msg: TMessage); message WM_DROPFILES;
    69.   public
    70.     { Public declarations }
    71.     procedure cargarTablas();
    72.   end;
    73.  
    74. var
    75.   FormHome: TFormHome;
    76.  
    77. implementation
    78.  
    79. {$R *.dfm}
    80. // Functions
    81.  
    82. function message_box(title, message_text, type_message: string): string;
    83. begin
    84.   if not(title = '') and not(message_text = '') and not(type_message = '') then
    85.   begin
    86.     try
    87.       begin
    88.         if (type_message = 'Information') then
    89.         begin
    90.           MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
    91.             MB_ICONINFORMATION);
    92.         end
    93.         else if (type_message = 'Warning') then
    94.         begin
    95.           MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
    96.             MB_ICONWARNING);
    97.         end
    98.         else if (type_message = 'Question') then
    99.         begin
    100.           MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
    101.             MB_ICONQUESTION);
    102.         end
    103.         else if (type_message = 'Error') then
    104.         begin
    105.           MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
    106.             MB_ICONERROR);
    107.         end
    108.         else
    109.         begin
    110.           MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
    111.             MB_ICONINFORMATION);
    112.         end;
    113.         Result := '</li><li type="square"> MessageBox : OK';[/li][/list]
    114.       end;
    115.     except
    116.       begin
    117.         Result := '[-] Error';
    118.       end;
    119.     end;
    120.   end
    121.   else
    122.   begin
    123.     Result := '[-] Error';
    124.   end;
    125. end;
    126.  
    127. // Function to DragDrop
    128.  
    129. // Based in : http://www.clubdelphi.com/foros/showthread.php?t=85665
    130. // Thanks to ecfisa
    131.  
    132. var
    133.   bypass_window: function(Msg: Cardinal; dwFlag: Word): BOOL; stdcall;
    134.  
    135. procedure TFormHome.DragDropFile(var Msg: TMessage);
    136. var
    137.   nombre_archivo, extension: string;
    138.   limite, number: integer;
    139.   path: array [0 .. MAX_COMPUTERNAME_LENGTH + MAX_PATH] of char;
    140. begin
    141.   limite := DragQueryFile(Msg.WParam, $FFFFFFFF, path, 255) - 1;
    142.   if (Win32MajorVersion = 6) and (Win32MinorVersion > 0) then
    143.     for number := 0 to limite do
    144.     begin
    145.       bypass_window(number, 1);
    146.     end;
    147.   for number := 0 to limite do
    148.   begin
    149.     DragQueryFile(Msg.WParam, number, path, 255);
    150.  
    151.     //
    152.  
    153.     if (FileExists(path)) then
    154.     begin
    155.       nombre_archivo := ExtractFilename(path);
    156.       extension := ExtractFileExt(path);
    157.       extension := StringReplace(extension, '.', '',
    158.         [rfReplaceAll, rfIgnoreCase]);
    159.       if (extension = 'sqlite') or (extension = 'db3') or (extension = 's3db')
    160.       then
    161.       begin
    162.         txtDatabase.Text := path;
    163.         status.Panels[0].Text := '</li><li type="square"> DB Loaded';[/li][/list]
    164.         message_box('DH Database Manager 0.8', 'DB Loaded', 'Information');
    165.       end
    166.       else
    167.       begin
    168.         status.Panels[0].Text := '[-] The DB is not valid';
    169.         message_box('DH Database Manager 0.8', 'The DB is not valid',
    170.           'Warning');
    171.       end;
    172.     end;
    173.  
    174.     //
    175.  
    176.   end;
    177.   DragFinish(Msg.WParam);
    178. end;
    179.  
    180. //
    181.  
    182. procedure TFormHome.cargarTablas();
    183. var
    184.   lst: TStrings;
    185.   count: integer;
    186. begin
    187.   if (connection.Connected = true) then
    188.   begin
    189.     try
    190.       begin
    191.         cmbTables.Clear;
    192.         lst := TStringList.Create;
    193.         connection.GetTableNames('', lst);
    194.         count := lst.count;
    195.         cmbTables.Items.Assign(lst);
    196.         lst.Free();
    197.         if (count >= 1) then
    198.         begin
    199.           cmbTables.ItemIndex := 0;
    200.         end;
    201.         ShowMessage('Tables loaded : ' + IntToStr(count));
    202.       end;
    203.     except
    204.       begin
    205.         ShowMessage('Tables not found');
    206.       end;
    207.     end;
    208.   end
    209.   else
    210.   begin
    211.     message_box('DH Database Manager 0.8', 'Not connected', 'Warning');
    212.   end;
    213. end;
    214.  
    215. procedure TFormHome.cmbServiceSelect(Sender: TObject);
    216. begin
    217.   if (cmbService.Text = 'MSSQL') then
    218.   begin
    219.     txtDatabase.ReadOnly := false;
    220.     btnLoadDB.Enabled := false;
    221.   end
    222.   else if (cmbService.Text = 'MYSQL') then
    223.   begin
    224.     txtDatabase.ReadOnly := false;
    225.     btnLoadDB.Enabled := false;
    226.   end
    227.   else if (cmbService.Text = 'SQLITE') then
    228.   begin
    229.     txtDatabase.Text := '';
    230.     txtDatabase.ReadOnly := true;
    231.     btnLoadDB.Enabled := true;
    232.   end
    233.   else
    234.   begin
    235.     status.Panels[0].Text := '[-] Service not found';
    236.     message_box('DH Database Manager 0.8', 'Service not found', 'Warning');
    237.   end;
    238. end;
    239.  
    240. procedure TFormHome.FormCreate(Sender: TObject);
    241. begin
    242.  
    243.   //
    244.  
    245.   if (Win32MajorVersion = 6) and (Win32MinorVersion > 0) then
    246.   begin
    247.     @bypass_window := GetProcAddress(LoadLibrary('user32.dll'),
    248.       'ChangeWindowMessageFilter');
    249.     bypass_window(WM_DROPFILES, 1);
    250.     bypass_window(WM_COPYDATA, 1);
    251.     bypass_window($0049, 1);
    252.   end;
    253.   DragAcceptFiles(Handle, true);
    254.  
    255.   //
    256.  
    257.   UseLatestCommonDialogs := false;
    258.   odLoadDB.InitialDir := GetCurrentDir;
    259.   odLoadDB.Filter :=
    260.     'SQLITE files (*.sqlite)|*.SQLITE|DB3 Files (*.db3)|*.DB3|S3DB File (*.s3db)|*.S3DB';
    261.  
    262.   //
    263.  
    264.   btnLoadDB.Enabled := false;
    265. end;
    266.  
    267. procedure TFormHome.btnConnectClick(Sender: TObject);
    268. begin
    269.  
    270.   // MSSQL : localhost\SQLEXPRESS
    271.   // admin:123456
    272.  
    273.   // MYSQL : localhost:3306
    274.   // root
    275.  
    276.   if (cmbService.Text = 'MSSQL') then
    277.   begin
    278.     if (txtHostname.Text = '') or (txtUsername.Text = '') or
    279.       (txtPassword.Text = '') then
    280.     begin
    281.       status.Panels[0].Text := '[-] Missing data';
    282.       message_box('DH Database Manager 0.8', 'Missing data', 'Warning');
    283.     end
    284.     else
    285.     begin
    286.       try
    287.         begin
    288.           connection.HostName := txtHostname.Text;
    289.  
    290.           if not(txtDatabase.Text = '') then
    291.           begin
    292.             connection.Database := txtDatabase.Text;
    293.           end;
    294.  
    295.           connection.Database := 'sistema';
    296.           connection.Protocol := 'mssql';
    297.           connection.User := txtUsername.Text;
    298.           connection.Password := txtPassword.Text;
    299.           connection.Connect;
    300.  
    301.           status.Panels[0].Text := '</li><li type="square"> Connected';[/li][/list]
    302.           message_box('DH Database Manager 0.8', 'Connected', 'Information');
    303.  
    304.           if not(txtDatabase.Text = '') then
    305.           begin
    306.             cargarTablas();
    307.           end;
    308.  
    309.         end;
    310.       except
    311.         begin
    312.           status.Panels[0].Text := '[-] Error connecting';
    313.           message_box('DH Database Manager 0.8', 'Error connecting', 'Error');
    314.         end;
    315.       end;
    316.     end;
    317.   end
    318.   else if (cmbService.Text = 'MYSQL') then
    319.   begin
    320.     if (txtHostname.Text = '') or (txtPort.Text = '') or (txtUsername.Text = '')
    321.     then
    322.     begin
    323.       status.Panels[0].Text := '[-] Missing data';
    324.       message_box('DH Database Manager 0.8', 'Missing data', 'Warning');
    325.     end
    326.     else
    327.     begin
    328.       try
    329.         begin
    330.           connection.HostName := txtHostname.Text;
    331.           connection.Port := StrToInt(txtPort.Text);
    332.  
    333.           if not(txtDatabase.Text = '') then
    334.           begin
    335.             connection.Database := txtDatabase.Text;
    336.           end;
    337.  
    338.           connection.Protocol := 'mysql-5';
    339.  
    340.           connection.User := txtUsername.Text;
    341.           connection.Password := txtPassword.Text;
    342.           connection.Connect;
    343.  
    344.           status.Panels[0].Text := '</li><li type="square"> Connected';[/li][/list]
    345.           message_box('DH Database Manager 0.8', 'Connected', 'Information');
    346.  
    347.           if not(txtDatabase.Text = '') then
    348.           begin
    349.             cargarTablas();
    350.           end;
    351.  
    352.         end;
    353.       except
    354.         begin
    355.           status.Panels[0].Text := '[-] Error connecting';
    356.           message_box('DH Database Manager 0.8', 'Error connecting', 'Error');
    357.         end;
    358.       end;
    359.     end;
    360.   end
    361.   else if (cmbService.Text = 'SQLITE') then
    362.   begin
    363.     if not(FileExists(txtDatabase.Text)) then
    364.     begin
    365.       status.Panels[0].Text := '[-] SQLITE Database not found';
    366.       message_box('DH Database Manager 0.8', 'SQLITE Database not found',
    367.         'Warning');
    368.     end
    369.     else
    370.     begin
    371.       try
    372.         begin
    373.           connection.Protocol := 'sqlite-3';
    374.           connection.Database := txtDatabase.Text;
    375.           connection.Connect;
    376.  
    377.           status.Panels[0].Text := '</li><li type="square"> Connected';[/li][/list]
    378.           message_box('DH Database Manager 0.8', 'Connected', 'Information');
    379.  
    380.           if not(txtDatabase.Text = '') then
    381.           begin
    382.             cargarTablas();
    383.           end;
    384.  
    385.         end;
    386.       except
    387.         begin
    388.           status.Panels[0].Text := '[-] Error connecting';
    389.           message_box('DH Database Manager 0.8', 'Error connecting', 'Error');
    390.         end;
    391.       end;
    392.     end;
    393.   end
    394.   else
    395.   begin
    396.     status.Panels[0].Text := '[-] Service not found';
    397.     message_box('DH Database Manager 0.8', 'Service not found', 'Warning');
    398.   end;
    399.  
    400. end;
    401.  
    402. procedure TFormHome.btnDisconnectClick(Sender: TObject);
    403. begin
    404.   if connection.Connected = true then
    405.   begin
    406.     connection.Connected := false;
    407.     status.Panels[0].Text := '</li><li type="square"> Disconnect';[/li][/list]
    408.     message_box('DH Database Manager 0.8', 'Disconnect', 'Information');
    409.   end
    410.   else
    411.   begin
    412.     status.Panels[0].Text := '[-] Not connected';
    413.     message_box('DH Database Manager 0.8', 'Not connected', 'Warning');
    414.   end;
    415. end;
    416.  
    417. procedure TFormHome.btnExecuteClick(Sender: TObject);
    418. begin
    419.   if (connection.Connected = true) then
    420.   begin
    421.     try
    422.       begin
    423.         query_connection.Active := false;
    424.         query_connection.SQL.Clear;
    425.         query_connection.SQL.Add(txtSQL_Query.Text);
    426.         query_connection.Active := true;
    427.         datasource_connection.DataSet := query_connection;
    428.         datasource_connection.DataSet.Refresh;
    429.         status.Panels[0].Text := '</li><li type="square"> Command Executed';[/li][/list]
    430.         message_box('DH Database Manager 0.8', 'Command Executed',
    431.           'Information');
    432.       end;
    433.     except
    434.       on E: Exception do
    435.       begin
    436.         if (E.Message = 'Can not open a Resultset') then
    437.         begin
    438.           status.Panels[0].Text := '[?] SQL Query not return ResultSet';
    439.           message_box('DH Database Manager 0.8',
    440.             'SQL Query not return ResultSet', 'Information');
    441.         end
    442.         else
    443.         begin
    444.           status.Panels[0].Text := '[-] SQL Query Error';
    445.           message_box('DH Database Manager 0.8', 'SQL Query Error', 'Error');
    446.         end;
    447.       end;
    448.     end;
    449.   end
    450.   else
    451.   begin
    452.     status.Panels[0].Text := '[-] Not connected';
    453.     message_box('DH Database Manager 0.8', 'Not connected', 'Warning');
    454.   end;
    455. end;
    456.  
    457. procedure TFormHome.btnLoadDBClick(Sender: TObject);
    458. begin
    459.   if odLoadDB.Execute then
    460.   begin
    461.     txtDatabase.Text := odLoadDB.filename;
    462.   end;
    463. end;
    464.  
    465. procedure TFormHome.btnLoadTableClick(Sender: TObject);
    466. begin
    467.   if (connection.Connected = true) then
    468.   begin
    469.     try
    470.       begin
    471.         table_connection.Active := false;
    472.         table_connection.TableName := cmbTables.Text;
    473.         datasource_connection.DataSet := table_connection;
    474.         table_connection.Active := true;
    475.         datasource_connection.DataSet.Refresh;
    476.         status.Panels[0].Text := '</li><li type="square"> Table Loaded';[/li][/list]
    477.         message_box('DH Database Manager 0.8', 'Table Loaded', 'Information');
    478.       end;
    479.     except
    480.       begin
    481.         status.Panels[0].Text := '[-] Error loading table';
    482.         message_box('DH Database Manager 0.8', 'Error loading table', 'Error');
    483.       end;
    484.     end;
    485.   end
    486.   else
    487.   begin
    488.     status.Panels[0].Text := '[-] Not connected';
    489.     message_box('DH Database Manager 0.8', 'Not connected', 'Warning');
    490.   end;
    491. end;
    492.  
    493. procedure TFormHome.btnRefreshTablesClick(Sender: TObject);
    494. begin
    495.   cargarTablas();
    496. end;
    497.  
    498. end.
    499.  
    500. // The End ?
    501.  

    Si quieren bajar el programa lo pueden hacer de aca :

    You are not allowed to view links. Register or Login.
    You are not allowed to view links. Register or Login.

    Eso seria todo.

 

[Sintaxis general de Delphi] By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 3359
Último mensaje Febrero 24, 2010, 04:35:15 pm
por ANTRAX
Eliminar acentos y otros agregados de un caracter/cadena Delphi 2009

Iniciado por ANTRAX

Respuestas: 0
Vistas: 5202
Último mensaje Febrero 24, 2010, 04:57:14 pm
por ANTRAX
1er troyano en Delphi By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 5456
Último mensaje Febrero 24, 2010, 04:34:48 pm
por ANTRAX
[Delphi] Creacion de un Server Builder con recursos

Iniciado por BigBear

Respuestas: 1
Vistas: 2697
Último mensaje Marzo 09, 2015, 07:56:20 pm
por Flemon
[Delphi] Project Arsenal X 0.2 (Regalo de navidad)

Iniciado por BigBear

Respuestas: 2
Vistas: 5384
Último mensaje Diciembre 28, 2015, 10:27:44 am
por BigBear