Utilizamos cookies propias y de terceros. Al navegar entendemos que aceptas el uso de cookies. +Info.
Política de cookies
Proyecto AjpdSoft

· Inicio
· Buscar
· Contactar
· Cookies
· Descargas
· Foros
· Historia
· Nosotros
· Temas
· Top 10
· Trucos
· Tutoriales
· Wiki
Obtener los ODBC instalados e información sobre los mismos - Delphi
Lenguaje de programación Borland Delphi


Este truco hecho en Delphi 6 muestra cómo obtener los orígenes de datos ODBC (de sistema y de usuario) así como los datos de los principales tipos de bases de datos (Oracle, MySQL, Paradox, Access, DBase,...). Para realizarlo hemos utilizado dos TComboBox, un TMemo, un TForm y dos TButton. A continuación os mostramos el código fuente completo de la unidad principal:

unit UnidadMenuPrincipal;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, registry, shellapi;

type
  TformDNS = class(TForm)
    Label1: TLabel;
    txtDNSUsuario: TComboBox;
    Label2: TLabel;
    txtDNSSistema: TComboBox;
    GroupBox1: TGroupBox;
    txtDatos: TMemo;
    bCerrar: TButton;
    bGuardar: TButton;
    dlGuardar: TSaveDialog;
    LWEB: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure txtDNSUsuarioChange(Sender: TObject);
    procedure txtDNSSistemaChange(Sender: TObject);
    procedure obtenerDatosFinales (odbc : string; sistema : boolean);
    procedure bCerrarClick(Sender: TObject);
    procedure bGuardarClick(Sender: TObject);
    procedure LWEBClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  formDNS: TformDNS;

implementation

{$R *.dfm}

function obtenerCadenaRegistro (claveInicial : Cardinal; clave : string; valor : string) : string;
var
  reg: TRegistry;
begin
  Result := '';
  Reg := TRegistry.Create;
  Reg.RootKey := claveInicial;
  reg.OpenKey(clave, False);
  try
    Result := reg.ReadString(valor);
  finally
    reg.CloseKey;
  end;
end;

procedure obtenerDatosODBC (odbc : string; sistema : boolean;
    var bd : string; var tipo : string; var descripcion : string;
    var controlador : string; var servidor : string;
    var listener : string; var usuario : string);
var
  claveInicial : Cardinal;
begin
  bd := '';
  tipo := '';
  descripcion := '';
  controlador := '';
  servidor := '';
  listener := '';
  usuario := '';
  if sistema then
    claveInicial := HKEY_LOCAL_MACHINE
  else
    claveInicial := HKEY_CURRENT_USER;
  tipo := obtenerCadenaRegistro(claveInicial,'SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources',odbc);

  //Oracle
  if pos ('ORACLE', AnsiUpperCase (tipo)) > 0 then
  begin
    descripcion := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'Description');
    controlador := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'Driver');
    listener := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'ServerName');
    usuario := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'UserID');
  end;
  //MySQL
  if pos ('MYSQL', AnsiUpperCase (tipo)) > 0 then
  begin
    descripcion := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'DESCRIPTION');
    bd := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'DATABASE');
    controlador := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'Driver');
    servidor := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'SERVER');
    usuario := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'UID');
  end;
  //MS Access
  if pos ('ACCESS', AnsiUpperCase (tipo)) > 0 then
  begin
    descripcion := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'Description');
    bd := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'DBQ');
    controlador := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'Driver');
    usuario := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'UID');
  end;
  //DBASE
  if pos ('DBASE', AnsiUpperCase (tipo)) > 0 then
  begin
    descripcion := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'Description');
    controlador := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'Driver');
  end;
  //SQL SERVER
  if pos ('SQL SERVER', AnsiUpperCase (tipo)) > 0 then
  begin
    descripcion := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'Description');
    controlador := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'Driver');
    servidor := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'Server');
    usuario := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'LastUser');
  end;
  //Paradox
  if pos ('PARADOX', AnsiUpperCase (tipo)) > 0 then
  begin
    descripcion := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'Description');
    controlador := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'Driver');
    bd := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'DefaultDir');
    servidor := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc + '\Engines\Paradox', 'ParadoxNetPath');
    usuario := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'LastUser');
  end;
  //Excel
  if pos ('EXCEL', AnsiUpperCase (tipo)) > 0 then
  begin
    descripcion := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'Description');
    controlador := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'Driver');
    bd := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'DBQ');
    servidor := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'DefaultDir');
  end;
  //TEXT, CSV
  if pos ('TEXT', AnsiUpperCase (tipo)) > 0 then
  begin
    descripcion := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'Description');
    controlador := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'Driver');
    bd := obtenerCadenaRegistro(claveInicial, 'SOFTWARE\ODBC\ODBC.INI\' + odbc, 'DefaultDir');
  end;
end;

function obtenerODBC (System: Boolean) : TStringList;
var
  reg: TRegistry;
  lista : TStringList;
begin
  lista := TStringList.Create;
  reg := TRegistry.Create;
  try
    if System then
      reg.RootKey := HKEY_LOCAL_MACHINE
    else
      reg.RootKey := HKEY_CURRENT_USER;
    if reg.OpenKey('\Software\ODBC\ODBC.INI\ODBC Data Sources', False) then
      reg.GetValueNames(lista);
  finally
    reg.CloseKey;
    FreeAndNil(reg);
  end;
  obtenerODBC := lista;
end;

procedure TformDNS.obtenerDatosFinales (odbc : string; sistema : boolean);
var
  tipo : string;
  bd : string;
  descripcion : string;
  controlador : string;
  servidor : string;
  listener : string;
  usuario : string;
begin
  obtenerDatosODBC (odbc, sistema, bd, tipo, descripcion, controlador, servidor, listener, usuario);
  txtDatos.Clear;
  txtDatos.Lines.Add('ODBC: ' + odbc);
  if tipo <> '' then
    txtDatos.Lines.Add('Tipo: ' + tipo);
  if descripcion <> '' then
    txtDatos.Lines.Add('Descripción: ' + descripcion);
  if bd <> '' then
    txtDatos.Lines.Add('Base de datos: ' + bd);
  if controlador <> '' then
    txtDatos.Lines.Add('Driver: ' + controlador);
  if servidor <> '' then
    txtDatos.Lines.Add('Servidor: ' + servidor);
  if listener <> '' then
    txtDatos.Lines.Add('TNS Nombre servicio: ' + listener);
  if usuario <> '' then
    txtDatos.Lines.Add('Usuario: ' + usuario);
end;

procedure TformDNS.FormCreate(Sender: TObject);
begin
  txtDNSUsuario.Items := obtenerODBC(false);
  txtDNSSistema.Items := obtenerODBC(true);
end;

procedure TformDNS.txtDNSUsuarioChange(Sender: TObject);
begin
  obtenerDatosFinales (txtDNSUsuario.Text, false);
end;

procedure TformDNS.txtDNSSistemaChange(Sender: TObject);
begin
  obtenerDatosFinales (txtDNSSistema.Text, true);
end;

procedure TformDNS.bCerrarClick(Sender: TObject);
begin
  close;
end;

procedure TformDNS.bGuardarClick(Sender: TObject);
begin
  dlGuardar.Title := 'Guardar datos ODBC';
  dlGuardar.DefaultExt := 'txt';
  dlGuardar.FileName := 'Datos ODBC';
  dlGuardar.Filter := 'Archivos de texto (*.txt)|*.txt|Todos los archivos (*.*)|*.*';
  if dlGuardar.Execute then
    txtDatos.Lines.SaveToFile(dlGuardar.FileName);
end;

procedure TformDNS.LWEBClick(Sender: TObject);
begin
  ShellExecute(Handle, Nil, PChar(LWEB.CAPTION),
      Nil, Nil, SW_SHOWNORMAL);
end;

end.




Publicado el: 2005-07-07

Visita nuestro nuevo sitio web con programas y contenidos actualizados: Proyecto A