1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
| Local loForm, lcConnStr
loForm = Createobject('frmLogin')
loForm.Show()
lcConnStr = loForm.Tag
loForm.Release
Release loForm
? Iif(Empty(lcConnStr),'Failed to login',lcConnStr)
Return lcConnStr
Define Class frmLogin As Form
Height = 186
Width = 216
BorderStyle = 2
Caption = "SQL Server Login"
ControlBox = .F.
WindowType = 1
ntries = 0
maxtries = 5
Add Object label1 As Label With ;
Caption = "User ID", Left = 24, Top = 47, Width = 48
Add Object label2 As Label With ;
Caption = "Password", Left = 24, Top = 78, Width = 60
Add Object txtuid As TextBox With ;
Height = 23, Left = 96, Top = 44, Width = 100
Add Object txtpwd As TextBox With ;
Height = 23, Left = 96, Top = 75, Width = 100, PasswordChar = "*"
Add Object label3 As Label With ;
Caption = "Server", Height = 17, Left = 24, Top = 14, Width = 40
Add Object txtserver As TextBox With ;
Height = 23, Left = 96, TabIndex = 2, Top = 11, Width = 100
Add Object label4 As Label With ;
Caption = "Database", Height = 17, Left = 24, Top = 104, Width = 60
Add Object txtdatabase As TextBox With ;
Height = 23, Left = 96, Top = 104, Width = 100
Add Object command1 As CommandButton With ;
Top = 144, Left = 111, Height = 27, Width = 84, Caption = "Connect"
Procedure Unload
Return This.Tag
Endproc
Procedure command1.Click
Local lnHandle, lcServerInstance, lcUID, lcPWD, lcConnStr, lcDatabase
Local Array aCheck[1]
SQLSetprop(0,"DispLogin",3)
SQLSetprop(0,"DispWarnings",.F.)
With Thisform
lcServerInstance = Trim(.txtserver.Value)
lcUID = Trim(.txtuid.Value)
lcPWD = Trim(.txtpwd.Value)
lcDatabase = Trim(.txtdatabase.Value)
If (Empty(lcServerInstance) Or Empty(lcUID) Or Empty(lcPWD))
If Messagebox('You must specify server, user and password to login.', ;
5+16,'SQL server login') = 2 && Responded cancel
.Hide && User cancelled
Endif
Return
Endif
lcConnStr = 'DRIVER={SQL Native Client};SERVER=' + m.lcServerInstance + ;
';UID='+m.lcUID+';PWD='+m.lcPWD+;
';Database='+m.lcDatabase+;
';Trusted_connection=No;'
lnHandle=Sqlstringconnect(m.lcConnStr)
.ntries = .ntries + 1 && Increase try count
If ( lnHandle > 0 ) && Got the handle - return
SQLDisconnect(lnHandle)
.Tag = lcConnStr && Save connection string to tag
.Hide
Else
If .ntries = .maxtries
Messagebox('Login failed ! Sorry, no more retries.',16,'SQL server login')
.Hide
Else
Aerror(aCheck)
*For simplicity using 2nd array element as error info
If Messagebox(aCheck[2],5+16,'SQL server login') = 2 && Responded cancel
.Hide
Endif
Endif
Endif
Endwith
Endproc
Enddefine |
