frmoperator.vb

一个用vb开发的档案管理程序

			System.Windows.Forms.SendKeys.Send("{Tab}")
		End If
		
		If KeyAscii = 0 Then
			eventArgs.Handled = True
		End If
	End Sub
	
	Private Sub Command1_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command1.Click
		
		If InStr(1, Trim(Text1.Text), "'", CompareMethod.Text) Then
			MsgBox("操作员姓名之中有特殊字符" & "<'>,请删除。", MsgBoxStyle.OKOnly + 48, "提示：")
			Text1.Focus()
			Exit Sub
		End If
		
		On Error Resume Next
		'校对数据库是否已经存在该操作员
		Dim DB As DAO.Database
		Dim EF As DAO.Recordset
		Dim RecStr As String
		
		DAODBEngine_definst.BeginTrans()
		
		DB = DAODBEngine_definst.OpenDatabase(ConData, False, False, ConStr)
		EF = DB.OpenRecordset("User", DAO.RecordsetTypeEnum.dbOpenDynaset)
		RecStr = "UID='" & Trim(Text1.Text) & "'"
		EF.FindFirst(RecStr)
		If Not EF.NoMatch Then
			EF.Close()
			DB.Close()
			MsgBox("操作员< " & Trim(Text1.Text) & " >已经存在,不能继续!    ", MsgBoxStyle.Information)
			Text1.Text = ""
			Text1.Focus()
			Exit Sub
		End If
		EF.Close()
		'UserText = Text1.Text
		'保存
		'如果要加密的话，请将 Text2.text 的文本加密!
		'别忘记在登录时，要进行解密!
		Dim shiftStr, SureStr As String
		Dim shiftStrR As Object
		Dim shiftNum, ili As Short
		shiftStr = Trim(Text2.Text)
		shiftNum = Len(shiftStr)
		ili = 1
		SureStr = ""
		For ili = 1 To shiftNum
			'UPGRADE_WARNING: 未能解析对象 shiftStrR 的默认属性。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1037"'
			shiftStrR = Mid(shiftStr, ili, 1)
			'UPGRADE_WARNING: 未能解析对象 shiftStrR 的默认属性。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1037"'
			shiftStrR = Asc(shiftStrR)
			'UPGRADE_WARNING: 未能解析对象 shiftStrR 的默认属性。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1037"'
			shiftStrR = shiftStrR - 3
			'UPGRADE_WARNING: 未能解析对象 shiftStrR 的默认属性。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1037"'
			shiftStrR = Chr(shiftStrR)
			'UPGRADE_WARNING: 未能解析对象 shiftStrR 的默认属性。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1037"'
			SureStr = SureStr & shiftStrR
		Next 
		'保存记录
		RecStr = "Insert into User (UID,PWD,权限) values('" & Trim(Text1.Text) & "','" & Trim(SureStr) & "','" & cmbAuthority.Text & "')"
		DB.Execute(RecStr)
		DB.Close()
		
		DAODBEngine_definst.CommitTrans()
		
		'刷新记录
		LoadOperator()
		
		Text1.Text = "" '刷新数据
		Text2.Text = ""
		Text3.Text = ""
		Text1.Focus()
		
	End Sub
	
	Private Sub Command2_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command2.Click
		Me.Close()
	End Sub
	
	Private Sub frmOperator_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
		
		On Error Resume Next
		
		'UPGRADE_ISSUE: Form 属性 frmOperator.HelpContextID 未升级。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2064"'
		frmOperator.DefInstance.HelpContextID = 5
		Me.Left = VB6.TwipsToPixelsX(Val(GetSetting(VB6.GetExeName(), "Operator", "Left")))
		Me.Top = VB6.TwipsToPixelsY(Val(GetSetting(VB6.GetExeName(), "Operator", "Top")))
		
		'安装操作员
		LoadOperator()
		
		cmbAuthority.SelectedIndex = 0
		
	End Sub
	
	'UPGRADE_WARNING: Form 事件 frmOperator.Unload 具有新的行为。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2065"'
	Private Sub frmOperator_Closed(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Closed
		
		SaveSetting(VB6.GetExeName(), "Operator", "Left", CStr(VB6.PixelsToTwipsX(Me.Left)))
		SaveSetting(VB6.GetExeName(), "Operator", "Top", CStr(VB6.PixelsToTwipsY(Me.Top)))
		
	End Sub
	
	Private Sub Grid1_DblClick(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Grid1.DblClick
		
		If Grid1.Text = "" Then
			MnuDelete.Enabled = False
			MnuAuthority.Enabled = False
		Else
			MnuDelete.Enabled = True
			MnuAuthority.Enabled = True
		End If
		
		'UPGRADE_ISSUE: Form 方法 frmOperator.PopupMenu 未升级。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2064"'
		PopupMenu(MnuOperate)
		
	End Sub
	
	Private Sub Grid1_MouseDownEvent(ByVal eventSender As System.Object, ByVal eventArgs As AxMSFlexGridLib.DMSFlexGridEvents_MouseDownEvent) Handles Grid1.MouseDownEvent
		
		
		If Grid1.Text = "" Then
			MnuDelete.Enabled = False
			MnuAuthority.Enabled = False
		Else
			MnuDelete.Enabled = True
			MnuAuthority.Enabled = True
		End If
		
		If eventArgs.Button = 2 Then
			'UPGRADE_ISSUE: Form 方法 frmOperator.PopupMenu 未升级。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2064"'
			PopupMenu(MnuOperate)
		End If
		
	End Sub
	
	
	Public Sub MnuAdd_Popup(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuAdd.Popup
		MnuAdd_Click(eventSender, eventArgs)
	End Sub
	Public Sub MnuAdd_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuAdd.Click
		
		Text1.Focus()
		
	End Sub
	
	Public Sub MnuAuthority_Popup(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuAuthority.Popup
		MnuAuthority_Click(eventSender, eventArgs)
	End Sub
	Public Sub MnuAuthority_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuAuthority.Click
		
		GetStatus("返回首页")
		Me.Close()
		
	End Sub
	
	Public Sub MnuDelete_Popup(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuDelete.Popup
		MnuDelete_Click(eventSender, eventArgs)
	End Sub
	Public Sub MnuDelete_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuDelete.Click
		
		DeleteRecord()
		
	End Sub
	
	Public Sub MnuOperate_Popup(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuOperate.Popup
		MnuOperate_Click(eventSender, eventArgs)
	End Sub
	Public Sub MnuOperate_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuOperate.Click
		
		GetStatus("帐号删除、添加操作")
		
	End Sub
	
	'UPGRADE_WARNING: 初始化窗体时可能激发事件 Text1.TextChanged。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2075"'
	Private Sub Text1_TextChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Text1.TextChanged
		
		If Trim(Text1.Text) <> "" Then
			Command1.Enabled = True
		Else
			Command1.Enabled = False
		End If
		
	End Sub
	
	Private Sub Text1_KeyPress(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyPressEventArgs) Handles Text1.KeyPress
		Dim KeyAscii As Short = Asc(eventArgs.KeyChar)
		
		If KeyAscii = 13 And Trim(Text1.Text) <> "" Then
			System.Windows.Forms.SendKeys.Send("{tab}")
		End If
		
		If KeyAscii = 0 Then
			eventArgs.Handled = True
		End If
	End Sub
	
	Private Sub Text2_KeyPress(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyPressEventArgs) Handles Text2.KeyPress
		Dim KeyAscii As Short = Asc(eventArgs.KeyChar)
		
		If KeyAscii = 13 Then
			System.Windows.Forms.SendKeys.Send("{tab}")
		End If
		
		If KeyAscii = 0 Then
			eventArgs.Handled = True
		End If
	End Sub
	
	Private Sub Text3_KeyPress(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyPressEventArgs) Handles Text3.KeyPress
		Dim KeyAscii As Short = Asc(eventArgs.KeyChar)
		
		If KeyAscii = 13 Then
			System.Windows.Forms.SendKeys.Send("{tab}")
		End If
		
		If KeyAscii = 0 Then
			eventArgs.Handled = True
		End If
	End Sub
	
	Private Sub Text3_Leave(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Text3.Leave
		If Trim(Text3.Text) <> Trim(Text2.Text) Then
			MsgBox("两次口令不符，请重新再来    ", MsgBoxStyle.OKOnly + 64, "口令不符")
			Text2.Text = ""
			Text3.Text = ""
			Text2.Focus()
		End If
	End Sub
	
	Private Sub DeleteRecord()
		
		On Error Resume Next
		
		If Grid1.Text = "" Then Exit Sub
		If DelNO = 1 Then
			MsgBox("仅剩下当前用户了,不能继续,请注意!    ", MsgBoxStyle.OKOnly + 32, "不能删除")
			Exit Sub
		End If
		Dim Qp As Short
		Qp = MsgBox("真的要删除[" & Grid1.Text & "]操作员吗（Y/N）？", MsgBoxStyle.YesNo + 16 + MsgBoxStyle.DefaultButton2, "确认删除")
		If Qp = 7 Then
			Exit Sub
		End If
		Dim DB As DAO.Database
		Dim RecStr As String
		DAODBEngine_definst.BeginTrans()
		DB = DAODBEngine_definst.OpenDatabase(ConData, False, False, ConStr)
		RecStr = "Delete * From User Where UID='" & Grid1.Text & "'"
		DB.Execute(RecStr)
		DB.Close()
		DAODBEngine_definst.CommitTrans()
		'刷新记录
		LoadOperator()
		
	End Sub
	
	Private Sub LoadOperator()
		
		'配置网格
		Grid1.Visible = False
		Grid1.Clear()
		Grid1.Cols = 3
		Grid1.FormatString = "^ 操作员 |^  口令 |^ 权限 "
		Grid1.set_ColWidth(0, 800)
		Grid1.set_ColWidth(1, 1210)
		Grid1.set_ColWidth(2, 1130)
		Dim DB As DAO.Database
		Dim EF As DAO.Recordset
		Dim HH As Short
		Dim tempStr, shiftStrL, shiftStr, shiftStrR, SureStr As String
		Dim ili, shiftNum, Qy As Short
		
		DB = DAODBEngine_definst.OpenDatabase(ConData, False, False, ConStr)
		EF = DB.OpenRecordset("User", DAO.RecordsetTypeEnum.dbOpenTable)
		DelNO = EF.RecordCount
		Grid1.Rows = EF.RecordCount + 4
		EF = DB.OpenRecordset("Select * From User", DAO.RecordsetTypeEnum.dbOpenDynaset)
		HH = 1
		Do While Not EF.EOF()
			Grid1.Row = HH
			Grid1.Col = 0
			Grid1.CellAlignment = 1
			'UPGRADE_WARNING: 检测到使用了 Null/IsNull()。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1049"'
			If Not IsDbNull(EF.Fields(0).Value) Then
				Grid1.Text = EF.Fields(0).Value
				UserStr = Grid1.Text
			End If
			Grid1.Row = HH
			Grid1.Col = 1
			Grid1.CellAlignment = 1
			'UPGRADE_WARNING: 检测到使用了 Null/IsNull()。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1049"'
			If Not IsDbNull(EF.Fields(1).Value) Then
				'解口令为可视
				shiftStr = Trim(EF.Fields(1).Value)
				shiftNum = Len(shiftStr)
				ili = 1
				SureStr = ""
				Qy = 0
				For ili = 1 To shiftNum
					shiftStrR = Mid(shiftStr, ili, 1)
					shiftStrR = CStr(Asc(shiftStrR))
					shiftStrR = CStr(CDbl(shiftStrR) + 3)
					shiftStrR = Chr(CInt(shiftStrR))
					SureStr = SureStr & shiftStrR
				Next 
				'因为是超级用户,所以可以看见所有的帐号密码
				Grid1.Text = SureStr
			End If
			Grid1.Row = HH
			Grid1.Col = 2
			Grid1.CellAlignment = 1
			'UPGRADE_WARNING: 检测到使用了 Null/IsNull()。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1049"'
			If Not IsDbNull(EF.Fields(2).Value) Then
				Grid1.Text = EF.Fields(2).Value
			End If
			EF.MoveNext()
			HH = HH + 1
		Loop 
		EF.Close()
		DB.Close()
		
		Grid1.Col = 0
		Grid1.Row = 1
		Grid1.ColSel = 2
		Grid1.Visible = True
		
	End Sub
End Class