Fórum PostgreSQL X Delphi #26386

// -> Teste.pas:

unit Teste;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, ADODB;

type
  TfrmTeste = class(TForm)
    btnTeste: TButton;
    ADODataSet1: TADODataSet;
    ADOCommand1: TADOCommand;
    ADOConnection1: TADOConnection;
    procedure btnTesteClick(Sender: TObject);
    procedure ADOConnection1BeforeConnect(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmTeste: TfrmTeste;

implementation

{$R *.dfm}

uses
  Global;

procedure TfrmTeste.ADOConnection1BeforeConnect(Sender: TObject);
begin
  TGlobal.ConfiguraODBC(´sua_base_dados´, ´localhost´, ´seu_usuario´, ´sua_senha´, ´DataSourceTeste´, ´PostgreSQL´);
  ADOConnection1.ConnectionString := ´Provider=MSDASQL.1;Persist Security Info=False;Data Source=DataSourceTeste´;
end;

procedure TfrmTeste.btnTesteClick(Sender: TObject);
begin
  ADOConnection1.Connected := True;
  ADODataSet1.Connection := ADOConnection1;
  ADOCommand1.Connection := ADOConnection1;
  
  ADOCommand1.CommandText := ´CREATE TABLE TESTE (ID_TESTE NUMERIC(5) PRIMARY KEY)´;
  ADOCommand1.Execute;

  ADOCommand1.CommandText := ´INSERT INTO TESTE (ID_TESTE) VALUES (10)´;
  ADOCommand1.Execute;  

  ADODataSet1.CommandText := ´SELECT ID_TESTE FROM TESTE´;
  ADODataSet1.Open;
  
  ShowMessage(´Teste ok - ´ + ADODataSet1.FieldByName(´ID_TESTE´).AsString);

  ADODataSet1.Close;
  ADOConnection1.Connected := False;
end;

end.


// -> Teste.dfm:

object frmTeste: TfrmTeste
  Left = 192
  Top = 107
  Width = 696
  Height = 480
  Caption = ´frmTeste´
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = ´MS Sans Serif´
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object btnTeste: TButton
    Left = 8
    Top = 8
    Width = 75
    Height = 25
    Caption = ´btnTeste´
    TabOrder = 0
    OnClick = btnTesteClick
  end
  object ADODataSet1: TADODataSet
    Parameters = <>
    Left = 124
    Top = 8
  end
  object ADOCommand1: TADOCommand
    ExecuteOptions = [eoExecuteNoRecords]
    Parameters = <>
    Left = 156
    Top = 8
  end
  object ADOConnection1: TADOConnection
    BeforeConnect = ADOConnection1BeforeConnect
    Left = 92
    Top = 8
  end
end


// -> Global.pas:

unit Global;

interface

uses
  Windows, Messages, SysUtils;

type
  TGlobal = class(TObject)
  private
    class function ExisteDataSourceODBC(DataSource: string): boolean;
    class procedure ConfiguraRegistroODBC(NomeBase, Servidor, Usuario, Senha, ODBCDataSource: string);
  public
    class procedure ConfiguraODBC(NomeBase, Servidor, Usuario, Senha, DataSourceODBC, ODBCDriver: string);
  end;

implementation

uses
  Registry;

const
  ODBC_ADD_DSN = 1;

class function TGlobal.ExisteDataSourceODBC(DataSource: string): boolean;
Var
  Registro: TRegistry;
Begin
  Registro := TRegistry.Create;
  Try
    Registro.RootKey := HKEY_CURRENT_USER;
    Result := Registro.KeyExists(´\Software\ODBC\ODBC.INI\´ + DataSource);
    Registro.CloseKey;
  finally
    FreeAndNil(Registro);
  end;
end;

class procedure TGlobal.ConfiguraRegistroODBC(NomeBase, Servidor, Usuario, Senha, ODBCDataSource: string);
var
  Registro: TRegistry;
begin
  Registro := TRegistry.Create;
  try
    Registro.RootKey := HKEY_CURRENT_USER;
    if Registro.OpenKey(´\Software\ODBC\ODBC.INI\´ + ODBCDataSource, False) then
    begin
      if Registro.ReadString(´Database´) <> NomeBase then
        Registro.WriteString(´Database´, NomeBase);

      if Registro.ReadString(´Servername´) <> Servidor then
        Registro.WriteString(´Servername´, Servidor);

      if Registro.ReadString(´Username´) <> Usuario then
        Registro.WriteString(´Username´, Usuario);

      if Registro.ReadString(´Password´) <> Senha then
        Registro.WriteString(´Password´, Senha);

      if Registro.ReadString(´Port´) <> ´5432´ then
        Registro.WriteString(´Port´, ´5432´);

      if Registro.ReadString(´Protocol´) <> ´6.4´ then
        Registro.WriteString(´Protocol´, ´6.4´);

      if (Registro.ReadString(´ReadOnly´) = ´1´) or (Registro.ReadString(´ReadOnly´) = ´´) then
        Registro.WriteString(´ReadOnly´, ´0´);

      if Registro.ReadString(´UseDeclareFetch´) <> ´1´ then
        Registro.WriteString(´UseDeclareFetch´, ´1´);

      if Registro.ReadString(´ByteaAsLongVarBinary´) <> ´1´ then
        Registro.WriteString(´ByteaAsLongVarBinary´, ´1´);

      Registro.CloseKey;
    end;
  finally
    FreeAndNil(Registro);
  end;
end;

function SQLConfigDataSource(hwndParent: HWND; fRequest: WORD; lpszDriver: LPCSTR; lpszAttributes: LPCSTR): BOOL; stdcall; external ´ODBCCP32.DLL´;
  
class procedure TGlobal.ConfiguraODBC(NomeBase, Servidor, Usuario, Senha, DataSourceODBC, ODBCDriver: string);
begin
  if not ExisteDataSourceODBC(DataSourceODBC) then
    SQLConfigDataSource(
      0, ODBC_ADD_DSN, PAnsiChar(ODBCDriver), PAnsiChar(´DSN=´ + DataSourceODBC + #00));
      
  TGlobal.ConfiguraRegistroODBC(NomeBase, Servidor, Usuario, Senha, DataSourceODBC);
end;

end.