Buscar

Criando e Acessando ODBC SQL Server

Código

Nesta dica que estou prestes a mostrar vou inserir uma Unit com funções pra criação do objeto odbcsqlserver que possibilita a criação e administração de Fonte de Dados ODBC através de código delphi evitando aquele trabalho manual que se faz toda vez que se instala um programa, com banco de dado voltado pra SQL Server...

Abaixo segue Unit e logo depois o exemplo de como usa-la ...


unit t_odbc;

interface

// ===========================================================================
// Mike Heydon 2003
// ODBC Alias/DSN Setups and Error Handled Login
// Currently ONLY MS SQL supported
// ===========================================================================

uses Windows, Controls, StdCtrls, Buttons, Forms, ExtCtrls, Registry,
     SysUtils, Classes, Graphics, DbTables, Dialogs;

(* ============================= DOCUMENTATION ===============================
This class adds dynamic ODBC Alias/DSN generation at run-time. Also featured
is two login modes, one that lets the programmer handle returned errors and
another that stays in a loop with error messages that allows retry and
Alias/DSN user setup. There are also properties that set and retrieve
ODBC Alias/DSN driver and dsn settings such as CPTimeout, Version etc.

The class currently only supports MS SQL, but other systems can be added
quiet easily. (I will add Oracle on the next project where Oracle Database
is used). See comments "Other Systems ...".

Informix, DB2 anyone ???

I have taken a "Poetic License" in that I only address SYSTEM DSN settings
held in HKEY_LOCAL_MACHINE Registry settings. Windows allows you to set the
same name DSN in both USER and SYSTEM DSN tables. This can be very confusing
when trying to debug a SYSTEM DSN that does not work only to find the same
DSN name in the USER section. Windows searches for DSN's first by USER DSN and
then by SYSTEM DSN. In both of the Login functions, any DSN of the same name
in USER DSN section of the Registry is DELETED (HKEY_CURRENT_USER).

I have also written the class using Borland's BDE. Those of you that have
dropped the BDE for alternatives will have to remove the TDataBase classes
and replace with the equivalent. TDataBase is used to get the Alias/DSN
name and to connect to the Database.

LOGIN LOGIC
-----------
Check for Alias/DSN in Registry
   Return ODBC_ErrNoAlias if PROGRAMMER MODE
   or Popup custom Alias/DSN Edit Form if AUTO MODE

if AUserName AND APassword is NOT NULL then
   login will attempt Server authentication with NO login prompt
   (This mode is not normally used as it can be a security leak, but it
    can be very useful for silent logins in Server Authentication mode)

if AUsername is NOT NULL then Server authentication with Passed username
filled in as default in a custom login form.

if AUserName is NULL then first try Windows authentication, else
try Server Authentication with custom login prompt. (NOTE : if property
DisableWindowsAuth = TRUE, then Windows Authentication is skipped)

OUT vars AUserName and APassword capture values (if any) are returned. This
is useful for saving passwords and usernames for silent login in Server
Authentication mode or as passing as command line arguments to other SQL
based applications. (Be aware of security issues!)


PROPERTIES
----------
property DisableWindowsAuth : boolean
          Used to override default action of trying Windows Authentication
          login regardless of DSN Trusted_Connection setting. Default value
          is FALSE (Windows Authentication is Attempted)

property LastErrorMess : string (read only)
          Returns text description of the last error occurence.

property OdbcType : TOdbcType (read only)
          Returns the type of System as used in the Create constructor.
          (Currently only odbcMsSql)

property OdbcDriver : string (read only)
          Returns the Driver used by the System from the Registry
          eg. "C:WINNTSystem32SQLSRV32.dll"

property OdbcDriverVer : string (read only)
          Returns the Version of the System Driver from the Registry
          eg. "03.50"

property OdbcDriverTimeout : integer
          Used to Get or Set the CP Timeout value for the System Driver.
          eg. "60"


METHODS
-------
constructor Create(AType : TOdbcType);

          Used to Create the class. (Only odbcMsSql currently supported)

          eg. var MyOdbc : TOdbcClass;
              MyOdbc := TOdbcClass.Create(odbcMsSql);
              ...
              MyOdbc.Free;


function GetDsnInfo(const ADsnName : string;
                     out AData : TOdbcMsSqlData) : boolean; overload;

          Used to get current Alias/DSN settings for Alias Name from Registry.
          Database, Description, Driver, LastUser, Server and
          Trusted_Connection.

          eg.  var DsnInfo : TOdbcMsSqlData;
               if MyOdbc.GetDsn('MyBase',DsnInfo) then
                 ShowMessage(DsnInfo.Description)
               else
                 ShowMessage('Alias/DSN does not exist');


procedure SetDsnInfo(const ADsnName : string;
                      var AData : TOdbcMsSqlData); overload;

          Used to set or create Alias/DSN settings for Alias Name in Registry.
          if Database, Description, LastUser or Server is NULL then
          that setting is NOT updated or added to the registry. Driver is
          ignored totally and is set internally from property OdbcDriver.

          eg.  var DsnInfo : TOdbcMsSqlData;
               FillChar(DsnInfo,SizeOf(TOdbcMsSqlData),0);
               DsnInfo.DDatabase := 'MyBase';
               DsnInfo.Server := 'SERVER1';
               DsnInfo.Description := 'Production Database';
               MyOdbc.SetDsn('MyBase',DsnInfo);


procedure EditDsn(const ADsnName : string);

          Used to Create or Edit an Alias/DSN via a custom popup form.
          The only input fields needed to create an Alias/DSN are
          Database,Server and Windows Authentication.

          eg.  MyOdbc.EditDsn('MyBase');


function Login(ADataBase : TDataBase; var AUserName : string;
                var APassword : string) : TOdbcError;

          Used to Login to a Database where programmer code control over errors
          are required. Returns code of result. ODBC_WindowsAuth,
          ODBC_ServerAuth, ODBC_ErrNoAlias, ODBC_ErrBadPassword,
          ODBC_ErrMissingDbName or ODBC_ErrConnectionFail.

          eg.  var sUser,sPass : string;
               var iResult : integer;
               sUser := '';
               sPass := '';

               iResult := MyOdbc.Login(Database1,sUser,sPass)

               case iResult of
                 ODBC_WindowsAuth,
                 ODBC_ServerAuth   : ShowMessage('Connect OK');

                 ODBC_ErrMissingDbName,
                 ODBC_ErrBadPassword,
                 ODBC_ErrConnectionFail : begin
                                            ShowMessage(MyOdbc.LastErrorMess);
                                            Application.Terminate;
                                           end;

                 ODBC_ErrNoAlias : MyOdbc.EditDsn(Database1.AliasName);
               end;


procedure LoginAndHandleErrors(ADataBase : TDataBase;
                                var AUserName : string;
                                var APassword : string);

          Used to Login to a Database where automatic error messages, retrys
          and User Created or Edited Alias/DSN,s are required. The method
          will only return with a valid connection. If the user decides to
          ABORT after retrying and Alias/DSN setups the application will
          terminate.

          eg.  var sUser,sPass : string;
               sUser := '';
               sPass := '';

               MyOdbc.LoginAndHandleErrors(Database1,sUser,sPass)
               // Connection Guaranteed here else terminated
               ...
               WinExec(PChar('prog.exe ' + sUser + ' ' + sPass),SW_SHOWNORMAL);
               // The above app can use ParamStr() to read these vars and use
               // them in the same call LoginAndhandleErrors(), This saves
               // having to relog into every app that is executed.

============================================================================= *)


const
      // Login Error and Success Codes
      ODBC_WindowsAuth       = 0;
      ODBC_ServerAuth        = 1;

      ODBC_ErrNoAlias        = 100;
      ODBC_ErrBadPassword    = 101;
      ODBC_ErrMissingDbName  = 102;
      ODBC_ErrConnectionFail = 103;

type
     TOdbcError = integer;     // Error ODBC_ Constants
     TOdbcType = (odbcMsSql);  // Add Other Systems ...  eg (odbcOracle)

     PTOdbcMsSqlData = ^TOdbcMsSqlData;         // Utility Pointer Type
     TOdbcMsSqlData = record                    // MS SQL DSN data struc
                        Database : string[255];
                        Description : string[255];
                        Driver : string[255];
                        LastUser : string[255];
                        Server : string[255];
                        Trusted_Connection : boolean;
                     end;

     // Other System Structures ...
     // eg PTOdbcOracleData
     //    TOdbcOracleData

     // =========================
     // ODBC Class
     // ==========================
     TOdbcClass = class(TObject)
     private
       FDisableWindowsAuth : boolean;
       FSavePass,
       FSaveUser,
       FLastErrorMess : string;
       FDriverTimeout : integer;
       FDriver,
       FDriverODBCVer : string;
       FRegistry : TRegistry;
       FOdbcType : TOdbcType;
       function GetFOdbcDriver : string;
       function GetFOdbcDriverVer : string;
       function GetFOdbcDriverTimeout : integer;
       procedure SetFOdbcDriverTimeout(AValue : integer);
     protected
       function ConvertDriverName : string;
       procedure ManualLogin(ADatabase: TDatabase; LoginParams: TStrings);
       procedure GetOdbcDriverInfo;
     public
       constructor Create(AType : TOdbcType);
       destructor Destroy; override;

       // Following need OVERLOADS for Other Systems ...
       function GetDsnInfo(const ADsnName : string;
                           out AData : TOdbcMsSqlData) : boolean; overload;
       // eg. function GetDsnInfo(const ADsnName : string;
       //                out AData : TOdbcOracleData) : boolean; overload;

       // Following need OVERLOADS for Other Systems ...
       procedure SetDsnInfo(const ADsnName : string;
                            var AData : TOdbcMsSqlData); overload;
       // eg. procedure SetDsnInfo(const ADsnName : string;
       //                          var AData : TOdbcOracleData); overload;

       // Edit or Add a Alias/DSN via custom popup form
       procedure EditDsn(const ADsnName : string);

       // Programmer Mode Login, Error Codes etc handled by programmer
       function Login(ADataBase : TDataBase; var AUserName : string;
                      var APassword : string) : TOdbcError;

       // Auto Login, Error Codes, Alias creation etc handled by class
       procedure LoginAndHandleErrors(ADataBase : TDataBase;
                                      var AUserName : string;
                                      var APassword : string);

       // Properties
       property DisableWindowsAuth : boolean read FDisableWindowsAuth
                                             write FDisableWindowsAuth;
       property LastErrorMess : string read FLastErrorMess;
       property OdbcType : TOdbcType read FOdbcType;
       property OdbcDriver : string read GetFOdbcDriver;
       property OdbcDriverVer : string read GetFOdbcDriverVer;
       property OdbcDriverTimeout : integer read GetFOdbcDriverTimeout
                                            write SetFOdbcDriverTimeout;
     end;


// -----------------------------------------------------------------------------
implementation

const
      // Registry
      C_BASE   = 'SoftwareODBC';
      C_DATA   = C_BASE + 'ODBCINST.INI';
      C_DSN    = C_BASE + 'ODBC.INI';
      C_SOURCE = C_DSN +  'ODBC Data Sources';

      // Drivers
      C_MSSQL    = 'SQL Server';
      // Other Systems ... eg. C_ORACLE = 'Oracle ODBC Driver'

      // Misc
      C_UNKNOWN  = 'Unknown';

// ---------------------------------------------------------------------------
// TODBCCLASS DEFINITION
// ---------------------------------------------------------------------------

// ==========================================
// Create and Destroy Methods for TOdbcClass
// ==========================================

constructor TOdbcClass.Create(AType : TOdbcType);
begin
  FDisableWindowsAuth := false;
  FOdbcType := AType;
  FRegistry := TRegistry.Create;
  FRegistry.RootKey := HKEY_LOCAL_MACHINE;
end;

destructor TOdbcClass.Destroy;
begin
  FRegistry.Free;

  inherited Destroy;
end;

// ================================================
// Return the Driver Name Registry Key from
// ODBC Driver Type
// ================================================

function TOdbcClass.ConvertDriverName : string;
var Retvar : string;
begin
  case FOdbcType of
    odbcMsSql : Retvar := C_MSSQL;

    // .. Future Other Systems

  else
    Retvar := C_UNKNOWN;
  end;

  Result := Retvar;
end;

// ==============================================
// Load ALL Driver Info into property fields
// ==============================================

procedure TOdbcClass.GetOdbcDriverInfo;
var sTimeOut : string;
begin
  if FRegistry.OpenKey(C_DATA + ConvertDriverName,false) then begin
     FDriver := FRegistry.ReadString('Driver');
     FDriverODBCVer := FRegistry.ReadString('DriverODBCVer');
     sTimeOut := FRegistry.ReadString('CPTimeOut');
     FDriverTimeOut := StrToIntDef(sTimeOut,0);
     FRegistry.CloseKey;
  end;
end;

// ==========================================
// Get Method for Driver Info Properties
// ==========================================

function TOdbcClass.GetFOdbcDriver : string;
begin
  GetOdbcDriverInfo;
  Result := FDriver;
end;

function TOdbcClass.GetFOdbcDriverVer : string;
begin
  GetOdbcDriverInfo;
  Result := FDriverODBCVer;
end;

function TOdbcClass.GetFOdbcDriverTimeout : integer;
begin
  GetOdbcDriverInfo;
  Result := FDriverTimeOut;
end;

// =============================================
// Set Methods for Driver Info Properties
// =============================================

procedure TOdbcClass.SetFOdbcDriverTimeout(AValue : integer);
begin
  if FRegistry.OpenKey(C_DATA + ConvertDriverName,false) then begin
     if AValue < 10 then AValue := 10;
     FRegistry.WriteString('CPTimeout',IntToStr(AValue));
     FRegistry.CloseKey;
  end;
end;

// ========================================
// Get Info for DSN into OUT record var
// Overload for Other Systems ...
// ========================================

// MS SQL

function TOdbcClass.GetDsnInfo(const ADsnName : string;
                               out AData : TOdbcMsSqlData) : boolean;
var sTrusted : string;
var Retvar : boolean;
begin
  FillChar(AData,SizeOf(TOdbcMsSqlData),0);

  if FRegistry.OpenKey(C_DSN + ADsnName,false) then begin
     AData.Database := FRegistry.ReadString('Database');
     AData.Description := FRegistry.ReadString('Description');
     AData.Driver := FRegistry.ReadString('Driver');
     AData.Lastuser := FRegistry.ReadString('Lastuser');
     AData.Server := FRegistry.ReadString('Server');
     sTrusted := Uppercase(FRegistry.ReadString('Trusted_Connection'));
     AData.Trusted_Connection := (sTrusted = 'YES');
     FRegistry.CloseKey;
     Retvar := true;
  end
  else
    Retvar := false;

  Result := Retvar;
end;

// ==========================================
// Update or create a new DSN
// NULL Strings in record are IGNORED
// Overload for Other Systems ...
// ==========================================

// MS SQL

procedure TOdbcClass.SetDsnInfo(const ADsnName : string;
                                var AData : TOdbcMsSqlData);
begin
  if FRegistry.OpenKey(C_DSN + ADsnName,true) then begin
     if trim(AData.Database) <> '' then
       FRegistry.WriteString('Database',AData.Database);
     if trim(AData.Description) <> '' then
       FRegistry.WriteString('Description',AData.Description);
     if trim(AData.Driver) <> '' then
       FRegistry.WriteString('Driver',AData.Driver);
     if trim(AData.Lastuser) <> '' then
       FRegistry.WriteString('Lastuser',AData.Lastuser);
     if trim(AData.Server) <> '' then
       FRegistry.WriteString('Server',AData.Server);

     if AData.Trusted_Connection then
       FRegistry.WriteString('Trusted_Connection','Yes')
     else
       FRegistry.WriteString('Trusted_Connection','No');

     FRegistry.CloseKey;
  end;

  // Add to ODBC Data Sources for Windows ODBC
  if FRegistry.OpenKey(C_SOURCE,true) then begin
    FRegistry.WriteString(ADsnName,ConvertDriverName);
    FRegistry.CloseKey;
  end;
end;


// ========================================================
// *INTERNAL* for Server Authentication TDataBase.OnLogin
// Create Dynamic Login Screen and Controls
// ========================================================

procedure TOdbcClass.ManualLogin(ADatabase: TDatabase; LoginParams: TStrings);
var fForm : TForm;
    btnCancel,btnOk : TBitBtn;
    pnTop,pnMiddle,pnBottom : TPanel;
    lbName,lbPass : TLabel;
    ebName,ebPass : TEdit;
    rFormResult : TModalResult;
begin
  // Login Form
  fForm := TForm.Create(nil);
  fForm.Position := poScreenCenter;
  fForm.BorderStyle := bsDialog;
  fForm.Height := 110;
  fForm.Width := 250;
  SetWindowLong(fForm.Handle,GWL_STYLE,
                GetWindowLong(FForm.Handle,GWL_STYLE) and not WS_CAPTION);
  FForm.ClientHeight := FForm.Height;

  // Panels
  pnTop := TPanel.Create(fForm);
  pnTop.Parent := fForm;
  pnTop.Height := 26;
  pnTop.Align := alTop;
  pnTop.Alignment := taLeftJustify;
  pnTop.Font.Style := pnTop.Font.Style + [fsBold];
  pnTop.Caption := '  Login : ' + ADataBase.AliasName;

  pnBottom := TPanel.Create(fForm);
  pnBottom.Parent := fForm;
  pnBottom.Align := alBottom;

  pnMiddle := TPanel.Create(fForm);
  pnMiddle.Parent := fForm;
  pnMiddle.Align := alClient;

  // Name and Edit Box
  lbName := TLabel.Create(fForm);
  lbName.Parent := pnMiddle;
  lbName.Left := 8;
  lbName.Top := 8;
  lbName.Caption := 'User Name';

  ebName := TEdit.Create(fForm);
  ebName.Parent := pnMiddle;
  ebName.Left := 80;
  ebName.Top := 8;
  ebName.Width := 154;
  ebName.Text := ADataBase.Params.ValueFromIndex[0];

  // Password and Edit Box
  lbPass := TLabel.Create(fForm);
  lbPass.Parent := pnMiddle;
  lbPass.Left := 8;
  lbPass.Top := 35;
  lbPass.Caption := 'Password';

  ebPass := TEdit.Create(fForm);
  ebPass.Parent := pnMiddle;
  ebPass.Left := 80;
  ebPass.Top := 35;
  ebPass.Width := 154;
  ebPass.Font.Name := 'WingDings 2';
  ebPass.PasswordChar := #225;

  // Cancel Button
  btnCancel := TBitBtn.Create(fForm);
  btnCancel.Parent := pnBottom;
  btnCancel.Top := 8;
  btnCancel.Left := pnBottom.Width - btnCancel.Width - 10;
  btnCancel.Kind := bkCancel;

  // OK Button
  btnOk := TBitBtn.Create(fForm);
  btnOk.Parent := pnBottom;
  btnOk.Top := 8;
  btnOk.Left := pnBottom.Width - btnOk.Width - 90;
  btnOk.Kind := bkOk;

  // Get the capture
  if trim(ebName.Text) = '' then
    fForm.ActiveControl := ebName
  else
    fForm.ActiveControl := ebPass;

  fForm.ShowModal;
  rFormResult := fForm.ModalResult;
  LoginParams.Clear;
  LoginParams.Add('USER NAME=' + ebName.Text);
  LoginParams.Add('PASSWORD=' + ebPass.Text);
  FSaveUser := ebName.Text;
  FSavePass := ebPass.Text;
  fForm.Free;

  if rFormResult = mrCancel then begin
   Application.Terminate;
   raise Exception.Create('');
  end;
end;

// ===========================================
// Edit or Create a DSN via custom form
// Dymaically create form and controls
// ===========================================

procedure TOdbcClass.EditDsn(const ADsnName : string);
var fForm : TForm;
    btnCancel,btnOk : TBitBtn;
    pnTop,pnMiddle,pnBottom : TPanel;
    lbSName,lbName : TLabel;
    ebSName,ebName : TEdit;
    cbAuth : TCheckBox;
    rFormResult : TModalResult;
    pDsnInfo : PTOdbcMsSqlData;
    // Other Systems ...
begin
  // Init Pointers for easy freeing
  pDsnInfo := nil;
  // Other Systems ...

  // Edit DSN Form
  fForm := TForm.Create(nil);
  fForm.Position := poScreenCenter;
  fForm.BorderStyle := bsDialog;
  fForm.Height := 138;
  fForm.Width := 250;
  SetWindowLong(fForm.Handle,GWL_STYLE,
                GetWindowLong(FForm.Handle,GWL_STYLE) and not WS_CAPTION);
  FForm.ClientHeight := FForm.Height;

  // Panels
  pnTop := TPanel.Create(fForm);
  pnTop.Parent := fForm;
  pnTop.Height := 26;
  pnTop.Align := alTop;
  pnTop.Alignment := taLeftJustify;
  pnTop.Font.Style := pnTop.Font.Style + [fsBold];
  pnTop.Caption := '  DSN : ' + ADsnName;

  pnBottom := TPanel.Create(fForm);
  pnBottom.Parent := fForm;
  pnBottom.Align := alBottom;

  pnMiddle := TPanel.Create(fForm);
  pnMiddle.Parent := fForm;
  pnMiddle.Align := alClient;

  // Database Name
  lbName := TLabel.Create(fForm);
  lbName.Parent := pnMiddle;
  lbName.Left := 8;
  lbName.Top := 8;
  lbName.Caption := 'Database';

  ebName := TEdit.Create(fForm);
  ebName.Parent := pnMiddle;
  ebName.Left := 60;
  ebName.Top := 8;
  ebName.Width := 174;

  // Server Name
  lbSName := TLabel.Create(fForm);
  lbSName.Parent := pnMiddle;
  lbSName.Left := 8;
  lbSName.Top := 35;
  lbSName.Caption := 'Server';

  ebSName := TEdit.Create(fForm);
  ebSName.Parent := pnMiddle;
  ebSName.Left := 60;
  ebSName.Top := 35;
  ebSName.Width := 174;

  // Authentication
  cbAuth := TCheckBox.Create(fForm);
  cbAuth.Parent := pnMiddle;
  cbAuth.Left := 60;
  cbAuth.Top := 62;
  cbAuth.Width := 160;
  cbAuth.Caption := 'Windows Authentication';

  // Cancel Button
  btnCancel := TBitBtn.Create(fForm);
  btnCancel.Parent := pnBottom;
  btnCancel.Top := 8;
  btnCancel.Left := pnBottom.Width - btnCancel.Width - 10;
  btnCancel.Kind := bkCancel;

  // OK Button
  btnOk := TBitBtn.Create(fForm);
  btnOk.Parent := pnBottom;
  btnOk.Top := 8;
  btnOk.Left := pnBottom.Width - btnOk.Width - 90;
  btnOk.Kind := bkOk;

  // Load System Dependent Registry Settings
  case FOdbcType of
    odbcMsSql : begin
                  New(pDsnInfo);
                  GetDsnInfo(ADsnName,pDsnInfo^);
                  if pDsnInfo^.Description = '' then
                    pDsnInfo^.Description := ADsnName;
                  ebName.Text := pDsnInfo^.Database;
                  ebSName.Text := pDsnInfo^.Server;
                  cbAuth.Checked := pDsnInfo^.Trusted_Connection;
                end;
    // Other Systems ..
  end;

  // Get the capture
  fForm.ActiveControl := ebName;
  fForm.ShowModal;
  rFormResult := fForm.ModalResult;

  // System Dependant
  if rFormResult = mrOk then begin
    case FOdbcType of
      odbcMsSql : begin
                    pDsnInfo^.Database := trim(ebName.Text);
                    pDsnInfo^.Driver := OdbcDriver;
                    pDsnInfo^.Server := trim(ebSName.Text);
                    pDsnInfo^.Trusted_Connection := cbAuth.Checked;
                    SetDsnInfo(ADsnName,pDsnInfo^);
                  end;

       // Other Systems ...
    end;
  end;

  fForm.Free;

  if PDsnInfo <> nil then Dispose(pDsnInfo);
  // Other Systems ...
end;


// ====================================================================
// Login to a database (Programmer responsible for Error Handling)
// Database is passed as a TDatabase
//
// Will Error with ODBC_ErrNoAlias if no alias is found
//
// if AUserName and APassword is NOT NULL then
// login will attempt Server authentication with NO login prompt
//
// if AUsername is NOT NULL then Server authentication with Passed
// username filled in
//
// if AUserName is NULL then first try Windows authentication, else
// try Server Authentication with login prompt (Registry LastUser)
// ====================================================================

function TOdbcClass.Login(ADataBase : TDataBase; var AUserName : string;
                          var APassword : string) : TOdbcError;
var pMsSqlInfo : PTOdbcMsSqldata;
    Retvar : TOdbcError;
    bTrusted : boolean;
begin
  // There can be duplicate DSN in User and System
  // Delete the one in User if present (we use System DSN only)
  // From ODBC.INI
  FRegistry.RootKey := HKEY_CURRENT_USER;
  if FRegistry.KeyExists(C_DSN + ADataBase.AliasName) then
    FRegistry.DeleteKey(C_DSN + ADataBase.AliasName);
  // From ODBC.INIODBC Data Sources
  if FRegistry.OpenKey(C_SOURCE,false) then begin
    if FRegistry.ValueExists(ADataBase.AliasName) then
       FRegistry.DeleteValue(ADatabase.AliasName);
    FRegistry.CloseKey;
  end;
  FRegistry.RootKey := HKEY_LOCAL_MACHINE;

  Retvar := ODBC_ErrConnectionFail;
  ADataBase.Close;
  ADataBase.LoginPrompt := false;
  ADatabase.OnLogin := nil;
  ADataBase.Params.Clear;

  if trim(ADataBase.DatabaseName) = '' then begin
    FLastErrorMess := 'Missing Database Name';
    Retvar := ODBC_ErrMissingDbName;
  end
  else begin

    case FOdbcType of

      odbcMsSql : begin
                    New(pMsSqlInfo);

                    if not GetDsnInfo(ADataBase.AliasName,pMsSqlInfo^) then begin
                      FLastErrorMess := 'Unknown Alias : ' + ADataBase.AliasName;
                      Retvar := ODBC_ErrNoAlias
                    end
                    else begin
                        // Save Trusted Connection
                        bTrusted := pMsSqlInfo^.Trusted_Connection;
                        // Turn OFF Trusted Connection
                        pMsSqlInfo^.Trusted_Connection := false;
                        SetDsnInfo(ADataBase.AliasName,pMsSqlInfo^);

                       // If User and Password <> NULL then try Server Auth
                       // No Login prompt
                       // This is used with stored names and passwords
                       // NOT ADVISABLE FOR SECURITY
                        if (trim(AUserName) <> '') and (trim(APassword) <> '') then begin
                         try
                           ADataBase.Params.Add('USER NAME=' + AUserName);
                           ADataBase.Params.Add('PASSWORD=' + APassword);
                           ADataBase.Open;
                           FLastErrorMess := 'Connect Ok';
                           Retvar := ODBC_ServerAuth;
                         except
                           on E : Exception do begin
                             FLastErrorMess := E.Message;
                             if pos('name or password',FLastErrorMess) <> 0 then
                               Retvar := ODBC_ErrBadPassword
                             else
                               Retvar := ODBC_ErrConnectionFail;
                           end;
                         end;
                       end
                       else begin
                         // UserName supplied but NO password then Server Auth
                         // with login prompt
                         // This is used with stored names only
                         if (APassword = '') and (AUserName <> '') then begin
                           ADataBase.LoginPrompt := true;
                           ADataBase.OnLogin := ManualLogin;
                           ADataBase.Params.Add('USER NAME=' + AUserName);
                           try
                             ADataBase.Open;
                             AUserName := FSaveUser;
                             APassword := FSavePass;
                             FLastErrorMess := 'Connect Ok';
                             Retvar := ODBC_ServerAuth;
                           except
                             on E : Exception do begin
                              FLastErrorMess := E.Message;
                               if pos('name or password',FLastErrorMess) <> 0 then
                                 Retvar := ODBC_ErrBadPassword
                               else
                                 Retvar := ODBC_ErrConnectionFail;
                             end;
                           end;
                         end
                         else begin
                            // No User Name , try Windows Auth else
                            // Server Auth with last user as login prompt
                            // This in the NORMAL MODE
                            if AUserName = '' then begin
                              // Turn ON Trusted Connection
                              pMsSqlInfo^.Trusted_Connection := true;
                              SetDsnInfo(ADataBase.AliasName,pMsSqlInfo^);

                              try
                                // Windows Auth
                                // If Windows Auth Disabled then force
                                // into Exception part for Server Auth
                                if FDisableWindowsAuth then
                                  raise Exception.Create('');
                                ADataBase.Open;
                                FLastErrorMess := 'Connect Ok';
                                Retvar := ODBC_WindowsAuth;
                              except
                                // Server Auth with Last User
                                // Turn OFF Trusted Connection
                                pMsSqlInfo^.Trusted_Connection := false;
                                SetDsnInfo(ADataBase.AliasName,pMsSqlInfo^);

                                ADataBase.LoginPrompt := true;
                                ADataBase.OnLogin := ManualLogin;
                                ADataBase.Params.Add('USER NAME=' +
                                                      pMsSqlInfo.LastUser);
                                ADataBase.Params.Add('PASSWORD=');
                                try
                                  ADataBase.Open;
                                  AUserName := FSaveUser;
                                  APassword := FSavePass;
                                  FLastErrorMess := 'Connect Ok';
                                  Retvar := ODBC_ServerAuth;
                                except
                                  on E : Exception do begin
                                   FLastErrorMess := E.Message;
                                    if pos('name or password',FLastErrorMess) <> 0 then
                                      Retvar := ODBC_ErrBadPassword
                                    else
                                      Retvar := ODBC_ErrConnectionFail;
                                  end;
                                end;
                              end;
                            end;
                         end;
                       end;

                       // Restore Trusted Connection Status
                       pMsSqlInfo^.Trusted_Connection := bTrusted;
                       SetDsnInfo(ADataBase.AliasName,pMsSqlInfo^);
                    end;

                    Dispose(pMsSqlInfo);
                  end;

      // Case Other Systems ...

    end;
  end;

  Result := Retvar;
end;


// ==============================================================
// Advanced Login that Creates or Edits Alias/Dsn and Retries
// Will terminate program if unsuccessful.
// Errors handled with messages and Retry/Abort
// Auto Alias/DSN Add or Edit.
// ==============================================================

procedure TOdbcClass.LoginAndHandleErrors(ADataBase : TDataBase;
                                          var AUserName : string;
                                          var APassword : string);
var bDone : boolean;
    iODBCResult : TOdbcError;
begin
  bDone := false;

  repeat
    iOdbcResult := Login(ADataBase,AUserName,APassword);

    case iODBCResult of
      ODBC_ServerAuth,
      ODBC_WindowsAuth : bDone := true;

      ODBC_ErrNoAlias : begin
                          if MessageDlg('Alias/DSN ' + ADataBase.AliasName +
                                     ' does not Exist' + #13#10 +
                                     'Create it Now ?',mtConfirmation,
                                     [mbOk,mbAbort],0) = mrOk then
                            EditDsn(ADataBase.AliasName)
                          else begin
                            Application.Terminate;
                            raise Exception.Create('');
                          end;
                        end;

      ODBC_ErrConnectionFail,
      ODBC_ErrBadPassword : begin
                              if MessageDlg(FLastErrorMess,
                                            mtError,
                                            [mbAbort,mbRetry],0) = mrAbort then begin
                                Application.Terminate;
                                raise Exception.Create('');
                              end
                              else begin
                                if MessageDlg('Do you want to Edit the ' +
                                              'Alias/DSN Setup ?',mtConfirmation,
                                              [mbYes,mbNo],0) = mrYes then
                                   EditDsn(ADataBase.AliasName);
                              end;
                            end;

      ODBC_ErrMissingDbName : begin
                                MessageDlg('Programmer Error : Missing Database Name',
                                           mtError,[mbOk],0);
                                Application.Terminate;
                                raise Exception.Create('');
                              end;
    end;

  until bDone;
end;

{eof}
end.

//Salve esta unit +++++++++++++++++++++++++++++
//Exemplo de como usar as //funções da Unit acima ....

procedure Tf_base_dados.DataModuleCreate(Sender: TObject);
var
  MeuODBC : TOdbcClass;
  DsnInfo : TOdbcMsSqlData;
  suser, spass : string;
begin
  suser := 'sa';
  spass := '';
  MeuODBC := TOdbcClass.Create(odbcMsSql);

  if MeuODBC.GetDsnInfo('Nome do alias do painel de controle', DsnInfo) then
    begin
      if DsnInfo.Database <> '' then
        begin
           dm_base_dados.DatabaseName := 'Alias da aplicacao';
           dm_base_dados.DriverName := DsnInfo.Driver;
           dm_base_dados.AliasName := 'nome do alias do painel de controle';
           dm_base_dados.Open;
           MeuODBC.Free;
           exit;
        end;
    end;

  FillChar(DsnInfo, SizeOf(TOdbcMsSqlData), 0);
  DsnInfo.Database := 'Banco de dados';
  DsnInfo.Server := '(local)';
  DsnInfo.Driver := MeuODBC.OdbcDriver;
  DsnInfo.LastUser := 'sa';
  DsnInfo.Trusted_Connection := true;
  MeuODBC.DisableWindowsAuth := false;
  DsnInfo.Description := 'Banco de Dados do Easy Lan House Manager';
  MeuODBC.SetDsnInfo('Nome do alias do painel de controle', DsnInfo);
  MeuODBC.Free;
end;




   

Publicidade

Vote na dica




Quantidade de votos: 0 votos
Aceitação: 0%


Detalhes da dica

Categoria: Banco de dados
Adicionada dia: 28/07/09
Por: Solivan Noleto Milhomem
Visualizada: 8079 vezes

Planeta Delphi - Tudo sobre programação Delphi Planeta Delphi - www.planetadelphi.com.br - Todos os direitos reservados | Copyright 2001-2009