Answer:
unit MahODBC;
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:\WINNT\System32\SQLSRV32.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 = 'Software\ODBC\';
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.INI\ODBC 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.
|
Sign Up
