تنظیمات ODBC

[حمیدرضاصادقیان]

سلام دوستان. میخواستم ببینم چطور میشه network libraries رو در کد نویسی تنظیم کرد.مثلا یک dsn ایجاد میکنیم و اونو تنظیم کنیم که از named pipe یا tcp/ip استفاده کن. من dsn رو ایجاد کردم ولی برای تنظیم dsn راهی پیدا نکردم.

[حمیدرضاصادقیان]

یک دستور هست به نام createnamedpipe که یک namepipe ایجاد میکنه ولی این به درد من نمی خوره. میخوام تنظیمات network libraries رو در odbc تنظیم کنم. در خود کانکشها یک قسمت به نام network library داره که وقتی اونو میام براش تعریف کانکشن رو باز نمیکنه و پیغام میده چند نوع ole db های مختلف باز هستند.

[حمیدرضاصادقیان]

از اساتید گرام کسی نیست راهنمایی کنه؟

[حمیدرضاصادقیان]

کسی نیست راهنمایی کنه؟

[vesal]

فکر کنم این کمکت کنه

public
{ Public declarations }
procedure CheckDLL(dll : string);
procedure CreateDSN(dsn,dbpath,desc : string);
procedure RemoveDSN(dsn : string);
end;

var
Form1: TForm1;
DllHandle : THandle = 0;
dllexists : boolean = false;
implementation

{$R *.DFM}

const
ODBC_ADD_SYS_DSN = 4;
ODBC_REMOVE_SYS_DSN = 6;

function SQLConfigDataSource(
hwndParent: HWND;
fRequest: WORD;
lpszDriver: LPCSTR;
lpszAttributes: LPCSTR): BOOL; stdcall; external 'ODBCCP32.DLL';

procedure TForm1.CheckDLL(dll : string);
var
i : integer;
begin
DLLHandle := LoadLibrary('ODBCCP32.DLL');
if DLLHandle <> 0 then
dllexists := true
else begin
dllexists := false;
showmessage(dll +' not found');
end;
if DLLHandle <> 0 then
FreeLibrary(DLLHandle);
end;

procedure TForm1.CreateDSN(dsn,dbpath,desc : string);
begin
Checkdll('ODBCCP32.DLL');
if not dllexists then exit
else begin
SQLConfigDataSource(0, ODBC_ADD_SYS_DSN,
'Microsoft Access Driver (*.mdb)', PChar(
'DSN='+dsn+#0 +
'Driver=ODBCJT32.DLL'#0 +
'DBQ='+dbpath+#0 +
'DefaultDir=D:\' + #0 +
'Description='+desc+#0 +
'FIL=MS Access'#0 +
'UID=Admin'#0));
ShowMessage(dsn+' Added');
end;
end;

procedure TForm1.RemoveDSN(dsn : string);
begin
Checkdll('ODBCCP32.DLL');
if not dllexists then exit
else begin
SQLConfigDataSource(0, ODBC_REMOVE_SYS_DSN,
'Microsoft Access Driver (*.mdb)', PChar(
'DSN='+dsn+#0));
ShowMessage(dsn+' Removed or not found');
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
CreateDSN('ATestDsn','D:\mytestdb.mdb','test db');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
RemoveDSN('ATestDsn');
end;

[حمیدرضاصادقیان]

سلام.دوست عزیز ممنون از راهنماییت.حالا یک سوال من میخوام اینو برای اس کیو ال اضافه کنم با کد زیر ولی هیچ dsnای رو اضافه نمیکنه. بهنظرت خطا در چیه؟


SQLConfigDataSource(0, ODBC_ADD_SYS_DSN,
'DRIVER=SQL Server',pchar(
'UID=Hamid'+
'Trusted_Connection=Yes'+
'Network=DBNMPNTW'+
'WSID=HAMID-XP'+
'APP=Microsoft Data Access Components'+
'SERVER=hamid-xp'+
'Description=g'+
'UID=Hamid'));

[حمیدرضاصادقیان]

اساتید کسی راه حلی نداره؟

[حمیدرضاصادقیان]

هیچکس راه حلی نداره؟

[حمیدرضاصادقیان]

سلام.کسی نیست راهنمایی کنه؟ چطور میتونم dsn مربوطه رو برای sql ایجاد کنم.؟

[vesal]

حمیدجان شرمنده من این یک مدت خیلی سرم شلوغ بود.
ولی من این کد رو خودم تست کردم جواب داد حالا چرا جواب نگرفتی نمی دونم. ولی یه چیز دیگه پیدا کردم که فکر کنم به دردت بخوره البته شرمنده اگه خیلی زیاده.




unit MahODBC;
interface



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



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.Descript ion);
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.