其他游戏

开发平台：
Visual Basic

Module1.bas：源码内容
							Attribute VB_Name = "Module1"
Option Explicit
Public Declare Function SetWindowPos Lib _
"user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) As Long
'SetWindowPos把窗口设置为顶层
Public Const HWND_TOPMOST = -1 '常量定义
Public Const SWP_SHOWWINDOW = &H40 '显示窗口
'privirw保存用户的使用权限
Public priview As String
'该函数判断登陆的用户名是否存在
Function is_name_exit() As Boolean
Dim filepath As String
Dim name   As String
Dim str1 As String
Dim flag As Boolean
'falg=false 用户名不存在
flag = False
'name = dlForm.Comboyh.List(dlForm.Comboyh.ListIndex)
 name = dlForm.Comboyh.Text
'MsgBox name
If Right((App.Path), 1) <> "" Then
filepath = App.Path + "" + "zh1.txt"
Else
filepath = App.Path + "zh1.txt"
End If
Dim filenumber As Integer
filenumber = FreeFile()
Open filepath For Input As filenumber
Do While Not EOF(1)
Line Input #filenumber, str1
'该用户名以存在
If name = str1 Then
 flag = True
End If
str1 = ""
Loop
Close filenumber
is_name_exit = flag
End Function
'把文件名加入文件中出
Sub add_name_to_file(name As String)
Dim filepath As String
'name = dlForm.Comboyh.List(dlForm.Comboyh.ListIndex)
If Right((App.Path), 1) <> "" Then
filepath = App.Path + "" + "zh1.txt"
Else
filepath = App.Path + "zh1.txt"
End If
Dim filenumber As Integer
filenumber = FreeFile()
Open filepath For Append As filenumber
Print #filenumber, name
Close #filenumber
End Sub
'读入最近登陆的3个用户到comboyh中
Sub getzh()
dlForm.Combo1.Clear
dlForm.Combo1.Visible = False
dlForm.Comboyh.Clear
Dim filepath As String
Dim name   As String
Dim str1 As String
Dim i As Integer
i = 0
If Right((App.Path), 1) <> "" Then
filepath = App.Path + "" + "zh1.txt"
Else
filepath = App.Path + "zh1.txt"
End If
Dim filenumber As Integer
filenumber = FreeFile()
Open filepath For Input As filenumber
Do While Not EOF(filenumber)
Line Input #filenumber, str1
dlForm.Combo1.List(i) = str1
i = i + 1
Loop
Close #filenumber
Dim k As Integer
k = 1
Dim s As String
For i = 0 To 2 Step 1
s = dlForm.Combo1.List(dlForm.Combo1.ListCount - k)
If s <> "" Then
dlForm.Comboyh.List(i) = s
End If
k = k + 1
Next i
dlForm.Comboyh.ListIndex = 0
End Sub
Sub dtlinedb()
''''''''''''''''''''''''''''''''''''''
'动态连接数据库
Dim dbpath As String
 
If Right(App.Path, 1) <> "" Then
dbpath = App.Path & ""
Else
dbpath = App.Path
End If
 If dlForm.Check1.Value = 1 Then
 '以管理员登陆
 'MsgBox "gly"
dbpath = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False; Data Source=" & dbpath & "年审评定数据库.mdb"
dlForm.dlAdodc.ConnectionString = dbpath
dlForm.dlAdodc.CommandType = adCmdText
dlForm.dlAdodc.RecordSource = "select * from 管理员权限表"
'动态连接数据库时一定要刷新数据库
dlForm.dlAdodc.Refresh
 Else
 'MsgBox "yh"
 dbpath = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False; Data Source=" & dbpath & "年审评定数据库.mdb"
dlForm.dlAdodc.ConnectionString = dbpath
dlForm.dlAdodc.CommandType = adCmdText
dlForm.dlAdodc.RecordSource = "select * from 用户权限表"
'动态连接数据库时一定要刷新数据库
dlForm.dlAdodc.Refresh
End If
'Debug.Print dbpath
'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:年审管理系统
'年审评定数据库.mdb;Persist Security Info=False
'''''''''''''''''''''''''''''''''''''''
End Sub
''''''
' 该函数检查密码是否正确
Function mima_right() As Boolean
 Dim i As Integer
 Dim ming As String
 ming = dlForm.Comboyh.List(dlForm.Comboyh.ListIndex)
 dlForm.dlAdodc.Recordset.MoveFirst
 For i = 0 To dlForm.dlAdodc.Recordset.RecordCount - 1 Step 1
  If ming = dlForm.dlAdodc.Recordset.Fields(0).Value And _
     dlForm.Text1 = dlForm.dlAdodc.Recordset.Fields(1).Value Then
      mima_right = True
      Exit For
      Else
       dlForm.dlAdodc.Recordset.MoveNext
    End If
    
 Next i
  If i = dlForm.dlAdodc.Recordset.RecordCount Then
   
   MsgBox "密码不正确!!", 48, "友情提示!!"
    mima_right = False
  End If
End Function
'从第一条记录向下查找
Function Findfirst(rs As ADODB.Recordset, ByVal s As String) As Boolean
 
 On Error Resume Next
 Dim i As Integer
 rs.MoveFirst
 For i = 0 To rs.RecordCount - 1 Step 1
   '查找数据库里又无该用户名
  If s = rs.Fields("管理员名").Value Then
    Findfirst = True
     Debug.Print Findfirst
     Exit Function
   End If
  Next i
   Debug.Print Findfirst
  Findfirst = False
End Function
Public Sub lind_zldb()
Dim dbpath As String
 
If Right(App.Path, 1) <> "" Then
dbpath = App.Path & ""
Else
dbpath = App.Path
End If
 
 '以管理员登陆
 'MsgBox "gly"
dbpath = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False; Data Source=" & dbpath & "年审评定数据库.mdb"
zlqueryForm.zl_queryAdodc.ConnectionString = dbpath
zlqueryForm.zl_queryAdodc.CommandType = adCmdText
zlqueryForm.zl_queryAdodc.RecordSource = "select * from 驾驶员资料表"
'动态连接数据库时一定要刷新数据库
zlqueryForm.zl_queryAdodc.Refresh
End Sub

						