又一个抛砖引玉之作。我的小程序已经能够设置角色成员和新建用户了,真得很有趣。
先来个基础吧。
××××××××××××
准备工作
××××××××××××
1. 建立一个窗体 frmLogon
2. 放两个TXT,名称为
1) txtUser
2) txtPassword
3. 放一个命令按钮,名称为cmdLogon
×××××××××××××
代码段
×××××××××××××
dim strUserName as string'全局变量用户名
Private Sub cmdLogon_Click()
On Error GoTo ErrorHandler'有错误发生了,那应该是没法登录吧!
Static intLoginFailedTimes As Integer'错误次数,三次登录不成就废了他
If intLoginFailedTimes > 2 Then
MsgBox "达到最大错误充许次数,程序关闭...see you"
Application.CloseCurrentDatabase
End If
Dim obj As Object
Const conPropNotFoundError = 3270
'这句是关键,用户输入的用户名和密码,让SQLSERVER自己去确认对不对,如果连上了用SQL SERVER的角色权限控制用户举动,如果没连上,则产生错误,由ErrorHandler处理。
CurrentProject.OpenConnection "rovider=SQLOLEDB.1; Password=" & Me.txtPassword & "; Persist Security Info=false; User ID=" & Me.txtUser & ";Initial Catalog= DataBaseName; Data Source= YourSQLServerName"
' 返回指向当前数据库的 Database 对象变量。
Set dbs = CurrentProject
Dim strUserName As String
'我用一个表tbIOperator存储了关于此用户在本程序内的各项设置,把信息提取出来,放在标题栏上
strUserName = DLookup("[str姓名]", "[tbIOperator]", "[str操作人] like '" & Me.txtUser & "'")'用户的中文姓名
strPlace = DLookup("[str负责地区]", "[tbIOperator]", "[str操作人] like '" & Me.txtUser & "'")'用户的负责地区,以供跨地域操作时使用
If strUserName = "" Then
strUserName = Me.txtUser
End If
'设置标题栏
dbs.Properties!AppTitle = "[技巧分享] || 当前用户 : " & strUserName & " || 负责地区 : " & strPlace
DoCmd.ShowToolbar "menu bar", acToolbarNo '隐藏菜单栏
DoCmd.ShowToolbar "mnuAppMenu", acToolbarYes '显示本程序菜单栏
' 更新屏幕上的标题栏。
Application.RefreshTitleBar
DoCmd.Close
Exit Sub
ErrorHandler:
If Err.Number = conPropNotFoundError Then'没发现程序的标题栏属性则生成。
Set obj = dbs.CreateProperty("AppTitle", dbText, "技巧分享:: User:" & strUserName)
dbs.Properties.Append obj
Resume Next
Else'我想大概除了上边一个错误外,只有错误的用户登录才会引起吧?
MsgBox "无权登入...输入的用户名或密码有误,请确认重输入"
intLoginFailedTimes = intLoginFailedTimes + 1
End If
End Sub
[em26]
可不可以啊,大家?
如果有人知道如何用最简单的办法把一个数据库的所有表,视图的角色权限生成脚本,以便移植到另外一台服务器上的话,也请分享一下吧!我用了许多的办法让SQLSERVER自动生成脚本,但只能生成角色名称,而没有生成角色对于表,视图的权限,让我很郁闷啊,自己一条条的打命令,要累死的。
[此贴子已经被作者于2002-9-4 23:03:36编辑过]
|