Fórum ODBC com PostgreSQL- como configurar #498457

procedure TfrmPrincipal.FormCreate(Sender: TObject); 
const 
servidor = '192.168.230.00'; 
usuario = 'root'; 
senha = 'teste'; 
bd = 'cdrss'; 
begin 
try 
if (adoMySQLConn.Connected) then 
adoMySQLConn.Close; 

adoMySQLConn.ConnectionString :='DRIVER={MySQL ODBC 3.51 
Driver};SERVER=' + servidor + ';DATABASE=' + bd + ';UID=' + usuario 
+ ';PWD=' + senha + '; OPTION=3'; 
adoMySQLConn.Open; 
except 
on e : Exception do 
Application.MessageBox(Pchar('Ocorreu o seguinte erro ao 
tentar comunicar com o banco de dados:'#13+#10+e.Message), 'Erro'); 
end; 
end; 

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, JclSysInfo ;

var
   Key:string;
   alias:string;
   Driver:string;
   Server:string;
   User:string;
   DataBase, DriverType,Porta:string;

procedure btnExecutarClick(Sender: TObject);
var
   objeto: TOdbcClass;

begin

  try

     //seu servidor sqlserver
      Server:= '192.168.10.1'

    if rgDriver.ItemIndex = 1 then begin  //64b
      Driver:='c:\Windows\system32\SQLSRV32.dll';
      Caminho:= '\SOFTWARE\ODBC\ODBC.INI\';
    end
    else begin   //32b
      Driver:='c:\Windows\SysWOW64\SQLSRV32.dll';
      Caminho := '\SOFTWARE\Wow6432Node\ODBC\ODBC.INI\';
    end;
    Porta:= '';
    DriverType:='SQL Server';
    objeto:= TOdbcClass.Create(Caminho);

     Key := 'Homersql'; //chave do odbc
     alias :='HomerSql';  //alias do seu odbc
     User :=  '';
     DataBase := 'BasedeDados'; //sua base de dados
     objeto.CreateODBC(Key,Driver,Server, DataBase, User, 'true', alias, DriverType, Porta );


    //Postgres---------------------------------------------------------------------
      Server:= '192.168.10.8'  //ip do servidor


      //define o caminho de onde esta os drivers odbc do postgres na sua maquina,  aletre caso necessário, esse é o caminho padrao
    if rgDriver.ItemIndex = 1 then begin  //para 64bits
      Driver:='C:\Program Files\psqlODBC\'+DirVersao('C:\Program Files\psqlODBC\')+'\bin\psqlodbc35w.dll';
      DriverType := 'PostgreSQL Unicode(x64)';
    end
    else begin  //32bits
      Driver:='C:\Program Files (x86)\psqlODBC\'+DirVersao('C:\Program Files (x86)\psqlODBC\')+'\bin\psqlodbc35w.dll';
      DriverType := 'PostgreSQL Unicode(x86)';
    end;

    Porta:= '5432';
    User:='';


     Key := 'Bart';  //sua chave
     alias :='Bart'; //alias do seu odbc
     DataBase := 'baseClientes'; // sua base de dados
     objeto.CreateODBC(Key,Driver,Server, DataBase, User, 'true', alias, DriverType, Porta );


    
  except
    //inserir tratamento
  end;
end;

//----------------------------------------------------------------------------------

function TemAtributo(Attr, Val: Integer): Boolean;
begin
  Result := Attr and Val = Val;
end;

//---------------------------------------------------------------------------------

function DirVersao(Diretorio : String): string;
var
  F : TSearchRec;
  Retorno : Integer;
begin
  //Inicia Busca
  Retorno := FindFirst( Diretorio + '\*.*', faAnyFile, F );
  try
    while Retorno = 0 do
    begin
      if  (F.Name <> '.') and (F.Name <> '..') then
        begin
          if  TemAtributo( F.Attr, faDirectory ) then
              Result:=( F.Name );
          ;
        end;
        Retorno := FindNext( F )
       ;
    end;
  finally
    FindClose( F );
  end;
end;

unit UOdbcClass;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Registry, ComCtrls;
type
  TOdbcClass = class
   List: TRichEdit;
  private
    function LastPos(Needle: Char; Haystack: String): integer;
    function RegGetString(RootKey: HKEY; Name: String;
      var Value: String): boolean;
    function RegGetValue(RootKey: HKEY; Name: String; ValType: Cardinal;
      var PVal: Pointer; var ValSize: Cardinal): boolean;



    { Private declarations }
  public
    function CreateODBC(Key, Driver, Server,DataBase, LastUser, TrueConn, Alias, DriverType, Port: string): Boolean;
    function GetSystemDSN: TStringlist;
    function GetSystemDSNcharset(DSN, DRIVER: string): String;
    function GetSystemDSNDriver(DSN: string): TStringlist;
    constructor Create(value:string);

    { Public declarations }
  end;

var
  Caminho:string;
 const
 KEY_WOW64_64KEY = $0100;
 KEY_WOW64_32KEY = $0200;


implementation

uses ComObj;



constructor TOdbcClass.Create(value:string);

  begin
    Caminho := value;

  end;

function TOdbcClass.CreateODBC(Key, Driver, Server,DataBase, LastUser, TrueConn, Alias, DriverType, Port: string ): Boolean;

Var fReg : TRegistry; returnStatus : Boolean;
  begin
    try                //KEY_ALL_ACCESS
      fReg:= TRegistry.Create(KEY_ALL_ACCESS OR KEY_WOW64_64KEY);
      //local em que será criado a fonte de dados do sistema, por padrão é sempre criado em HKEY_CURRENT_USER.
      fReg.Access:= KEY_WRITE;
      fReg.RootKey := HKEY_LOCAL_MACHINE;
      //Alias do banco
      if fReg.OpenKey(Caminho + Key, TRUE) then
      begin
        fReg.WriteString('Database', DataBase);
        //informação da DLL referente a fonte de dados
        fReg.WriteString('Driver', Driver); //C:\Windows\system32\SQLSRV32.dll
        fReg.WriteString('Server', Server);
        fReg.WriteString('LastUser', LastUser);
        fReg.WriteString('Trusted_Connection', 'YES');
        if port <> '' then begin
          fReg.WriteString('PORT', Port);
          fReg.WriteString('Protocol', '6.4');
          fReg.WriteString('UseDeclareFetch', '1');
          fReg.WriteString('ByteaAsLongVarBinary', '1');
          fReg.WriteString('Servername', Server);
        end;
        //local onde será criado o nome da fonte de dados
        fReg.CloseKey;
        if fReg.OpenKey(Caminho + '\ODBC Data Sources', TRUE) then
        begin
        //nome do Alias e qual o nome do drive a ser usado (O nome do alias é onde ficará todas as informações passadas logo acima).
          fReg.WriteString(Alias, DriverType);
          fReg.CloseKey;
          fReg.Free;

        end
        else begin
          fReg.Free;
          fReg.CloseKey;
          ShowMessage('Não foi possivel encontrar o caminho do registro do ODBC para ' +Key+ ' !');
        end;
      end
      else begin
          fReg.Free;
          fReg.CloseKey;
          ShowMessage('Erro ao criar Data Sources do ODBC para ' +Key+ ', verifique se existe o driver instalado !');

      end;
      ShowMessage('Sucesso ao criar ODBC para ' +Key+ ' !');
    except
      fReg.Free;
      fReg.CloseKey;
      //ShowMessage('erro');
    end;
  end;

function TOdbcClass.GetSystemDSN : TStringlist;
  var
    fReg  : TRegistry;
    ListODBC : TStringlist;
  begin
    fReg:= TRegistry.Create(KEY_ALL_ACCESS OR KEY_WOW64_64KEY);
    //fReg := TRegistry.Create(KEY_READ);
    ListODBC := TStringlist.create;
    with fReg do
    try
      fReg.RootKey := HKEY_LOCAL_MACHINE;
      if KeyExists(Caminho + '\ODBC Data Sources') then
      begin
        OpenKeyReadOnly(Caminho + '\ODBC Data Sources');
        GetValueNames(ListODBC);
      end;
      result := ListODBC;
    finally
      fReg.Free;
    end;
  end;

function TOdbcClass.GetSystemDSNDriver(DSN : string) : TStringlist;
  var
    fReg  : TRegistry;
    ListODBC : TStringlist;
  begin
     fReg:= TRegistry.Create(KEY_ALL_ACCESS OR KEY_WOW64_64KEY);
    //fReg := TRegistry.Create(KEY_READ);
    ListODBC := TStringlist.create;
    with fReg do
    try
      fReg.RootKey := HKEY_LOCAL_MACHINE;
      if KeyExists(Caminho + DSN) then
      begin
        OpenKeyReadOnly(Caminho + DSN);

        GetValueNames(ListODBC);
      end;
      result := ListODBC;
    finally
      fReg.Free;
    end;
  end;

function TOdbcClass.GetSystemDSNcharset(DSN, DRIVER : string) : String;
  var
    fReg  : TRegistry;
    ListODBC : String;
    d: Cardinal;
  begin
    fReg:= TRegistry.Create(KEY_ALL_ACCESS OR KEY_WOW64_64KEY);
    with fReg do
    try
      fReg.RootKey := HKEY_LOCAL_MACHINE;
      if KeyExists(Caminho + DSN + '\') then
      begin
        OpenKeyReadOnly(Caminho + DSN + '\' + DRIVER);
        RegGetString(HKEY_LOCAL_MACHINE, Caminho + DSN + '\' + DRIVER, ListODBC);
      end;
      result := ListODBC;
    finally
      fReg.Free;
    end;
  end;

function TOdbcClass.RegGetString(RootKey: HKEY; Name: String; Var Value: String): boolean;
  var
    Buf: Pointer;
    BufSize: Cardinal;
  begin
    Result := False;
    if RegGetValue(RootKey, Name, REG_SZ, Buf, BufSize) then
    begin
      Dec(BufSize);
      SetLength(Value, BufSize);
      if BufSize > 0 then
        CopyMemory(@Value[1], Buf, BufSize);
      FreeMem(Buf);
      Result := True;
    end;
  end;

function TOdbcClass.RegGetValue(RootKey: HKEY; Name: String; ValType: Cardinal; var PVal: Pointer;
  var ValSize: Cardinal): boolean;
  var
    SubKey: String;
    n: integer;
    MyValType: DWORD;
    hTemp: HKEY;
    Buf: Pointer;
    BufSize: Cardinal;
  begin

    Result := False;
    n := LastPos('\', Name);
    if n > 0 then
    begin
      SubKey := Copy(Name, 1, n - 1);
      if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
      begin
        SubKey := Copy(Name, n + 1, Length(Name) - n);
        if RegQueryValueEx(hTemp, PChar(SubKey), nil, @MyValType, nil, @BufSize) = ERROR_SUCCESS then
        begin
          GetMem(Buf, BufSize);
          if RegQueryValueEx(hTemp, PChar(SubKey), nil, @MyValType, Buf, @BufSize) = ERROR_SUCCESS then
          begin
            if ValType = MyValType then
            begin
              PVal := Buf;
              ValSize := BufSize;
              Result := True;
            end else
            begin
              FreeMem(Buf);
            end;
          end else
          begin
            FreeMem(Buf);
          end;
        end;
        RegCloseKey(hTemp);
      end;
    end;
  end;

function TOdbcClass.LastPos(Needle: Char; Haystack: String): integer;
  begin
    for Result := Length(Haystack) downto 1 do
      if Haystack[Result] = Needle then
        Break;
  end;



end.