modulepeople.bas

人事资源管理系统

Attribute VB_Name = "ModulePeople"
' ******************************************************************************
'系统公共变量定义
' ******************************************************************************
Option Explicit
Public gUserName As String
Public gUserKind As String
Public gEmployeeId As String
Public gLoginSucceeded  As Boolean
Public Const BLUE = &HFF0000
Public Const WHITE = &H80000005
' ******************************************************************************
'过程名：Main
'说  明：系统启动函数
'参  数：无
'返回值：无
' ******************************************************************************
Sub Main()
Dim fLogin As New frmLogin  '启动登录窗体
fLogin.Show vbModal '装入并显示模式窗体。
If Not gLoginSucceeded Then
   MsgBox "系统启动失败,请重试!", vbOKOnly + vbExclamation, "警告"
End If
Unload fLogin
End Sub
' ******************************************************************************
'函数名：ConnectString
'说  明：设置数据库连接字符串，连接数据库前要首先通过ODBC建立文件DSN：dbmanpower.dsn
'参  数：无
'返回值：数据库连接字符串
' ******************************************************************************
Public Function ConnectString() As String
  ConnectString = "FileDSN=dbmanpower.dsn;UID=sa;PWD=sa"
End Function
' ******************************************************************************
'函数名：ExecuteSQL
'说  明：执行SQL语句
'参  数：SQL As String, rst As ADODB.Recordset, Optional enableWrite As Boolean
'返回值：SQL语句执行成功——true，失败——false
' ******************************************************************************
Public Function ExecuteSQL(ByVal SQL As String, rst As ADODB.Recordset, _
Optional enableWrite As Boolean = True) As Boolean
    Dim con As ADODB.Connection
    Dim sTokens() As String
    On Error GoTo Execute_Error
    sTokens = Split(SQL)
    Set con = New ADODB.Connection
    con.Open ConnectString     '打开数据库
    Set rst = New ADODB.Recordset
    If enableWrite Then  '读写方式
        rst.Open Trim$(SQL), con, adOpenStatic, adLockOptimistic
    Else  '只读方式
        rst.Open Trim$(SQL), con, adOpenStatic, adLockReadOnly
    End If
    ExecuteSQL = True
    Exit Function
Execute_Error:
   ExecuteSQL = False
  Exit Function
End Function
' ******************************************************************************
'函数名：DBExist
'说  明：判断数据库中是否存在记录
'参  数：SQL As String
'返回值：存在则返回记录数，不存在返回0
' ******************************************************************************
Public Function DBExist(ByVal SQL As String) As Integer
   Dim con As ADODB.Connection
   Dim sTokens() As String
   Dim flag As String
   Dim rst As ADODB.Recordset
   sTokens = Split(SQL)
   Set con = New ADODB.Connection
   con.Open ConnectString
   flag = ExecuteSQL(SQL, rst, False)
   '判断该记录是否存在
   If rst.RecordCount <> 0 Then
    DBExist = rst.RecordCount
   Else
    DBExist = 0
   End If
   con.Close
End Function
' ******************************************************************************
'函数名：txtIsNull
'说  明：判断输入内容是否为空
'参  数：text As String
'返回值：存在——true，不存在——false
' ******************************************************************************
Public Function txtIsNull(txt As TextBox) As Boolean
    If Trim(txt.Text) = "" Then
        txtIsNull = True
        txt.SetFocus
        txt.BackColor = BLUE
    Else
        txtIsNull = False
    End If
End Function
' ******************************************************************************
'函数名：IsOverStringLen
'说  明：判断输入内容是否超过允许最大值lenthText
'参  数：str As String, lenthText As Integer
'返回值：不超过——true，超过——false
' ******************************************************************************
Public Function IsOverStringLen(ByVal str As String, lenthText As Integer) As Boolean
    If Len(Trim(str)) > lenthText Then
        IsOverStringLen = True
    Else
        IsOverStringLen = False
    End If
End Function
' ******************************************************************************
'过程名：viewData
'说  明：将数据在datagrid中显示
'参  数：无
'返回值：无
' ******************************************************************************
Public Function viewData(ByVal txtSQL As String, dgAll As DataGrid) As Integer
    Dim rstData As ADODB.Recordset
    Dim result As String
    '检索需要的信息
    result = ExecuteSQL(txtSQL, rstData, False)
    '设置datagrid的数据源
    If rstData.RecordCount <> 0 Then
        Set dgAll.DataSource = rstData
        viewData = rstData.RecordCount
    Else
        MsgBox "还没有数据！", vbOKOnly + vbExclamation, "警告"
        viewData = 0
    End If
End Function
' ******************************************************************************
'过程名：ISEquelLen
'说  明：判断文本框中内容是否等于给定的长度
'参  数：txt As TextBox, intlen As Integer
'返回值：超过返回值为True，否则为false
' ******************************************************************************
Public Function ISEquelLen(ByVal txt As TextBox, intlen As Integer) As Boolean
If Len(txt.Text) <> intlen Then
   txt.SetFocus
   txt.BackColor = BLUE
   ISEquelLen = False
Else
   ISEquelLen = True
End If
End Function
' ******************************************************************************
'过程名：cboData
'说  明：为cbo赋值
'参  数：无
'返回值：无
' ******************************************************************************v
Public Function cboData(ByVal txt As String, cbo As ComboBox) As Boolean
Dim res As String
Dim rstcbo As ADODB.Recordset
Dim i As Integer
res = ExecuteSQL(txt, rstcbo, False)
If rstcbo.RecordCount <> 0 Then
  For i = 0 To rstcbo.RecordCount - 1
    cbo.AddItem (rstcbo.Fields(1))
    cbo.ItemData(cbo.NewIndex) = rstcbo.Fields(0)
    rstcbo.MoveNext
  Next
  cboData = True
Else
  cboData = False
End If
End Function