函数.bas

来自「一间公司的管理系统的源码」· BAS 代码 · 共 97 行

Attribute VB_Name = "mobFunction"
Option Explicit
'******************************************
'打开数据库
Sub OpenDB()
If Right(App.Path, 1) = "\" Then
  DBpath = App.Path & DBname
Else
  DBpath = App.Path + "\" + DBname
End If
connStr = "provider=Microsoft.Jet.oledb.4.0;data source=" & DBpath & ";Jet OLEDB:Database Password=" & DBpass & ";"
conn.Open connStr
End Sub
'******************************************
'关闭数据库
Sub CloseDB()
On Error Resume Next
conn.Close
Set conn = Nothing
End Sub
'******************************************
'检查是否已经登录
Sub CheckLogin(ThisForm)
If Login <> True Then
    MsgBox "您没有登录，无法进行相关操作！", vbOKOnly + vbInformation, App.Title
    Unload ThisForm
    denglu.Show
End If
End Sub
'******************************************
'显示错误提示
Sub ShowErrMsg(ErrMsg)
MsgBox ErrMsg, vbOKOnly, App.Title
End Sub
'******************************************
'退出系统提示
Sub CloseSystem(UnloadMode, Cancel)
If UnloadMode = vbFormControlMenu Then
    If MsgBox("你真的要退出【" & App.Title & "】吗？", vbQuestion + vbYesNo + vbDefaultButton2, "警告") = vbNo Then
        Cancel = True
    Else
        On Error Resume Next '忽略一切错误，防止系统崩溃
        '关闭数据库
        rs.Close
        Set rs = Nothing
        Call CloseDB
        '退出系统
        End
    End If
End If
End Sub
'******************************************
'关闭窗口提示
Sub Closewindow(UnloadMode, Cancel, ThisForm)
If UnloadMode = vbFormControlMenu Then
    If MsgBox("你真的要关闭本窗口吗？", vbQuestion + vbYesNo + vbDefaultButton2, "警告") = vbNo Then
        Cancel = True
    Else
        Unload ThisForm
    End If
End If
End Sub
'******************************************
'设置窗体居中
Sub SetCenter(ThisForm)
ThisForm.Left = (Screen.Width - ThisForm.Width) / 2
ThisForm.Top = (Screen.Height - ThisForm.Height) / 2
End Sub
'******************************************
'获取ini文件信息
Function GetIni(AppName As String, KeyName As String, FileName As String) As String
   Dim RetStr As String
   RetStr = String(255, Chr(0))
   GetIni = Left(RetStr, ReadIni(AppName, ByVal KeyName, "", RetStr, Len(RetStr), FileName))
End Function
'******************************************
'暂停时间(暂时没用)
Sub delay(ByVal n As Single)
    Dim tm1 As Single, tm2 As Single
    tm1 = Timer
    Do
        tm2 = Timer
        If tm2 < tm1 Then tm2 = tm2 + 86400
        If tm2 - tm1 > n Then Exit Do
        DoEvents
    Loop
End Sub
'******************************************
'登录日志记录
Sub WriteLog()
  Close
  Open App.Path & LogfileName For Append As #1
  Write #1, "用户" & User & "于" & Now & "成功登录！"
  Close #1
End Sub