mdlpublic.bas

完成企业内部部门人员的联系

Attribute VB_Name = "mdlPublic"
'****************************************
'*      企业内部业务联系系统 1.0版      *
'*                                      *
'*  作者：郭文云(云南电信昭通分公司)    *
'*  日期：2004年8月                     *
'*  版权：Terrificsoft                  *
'*          版权所有  侵权必究          *
'****************************************

Option Explicit

'全局变量声明
Public AdoCon As ADODB.Connection                   '与数据库以ADO方式建立的连接
Public RsAdo As ADODB.Recordset                     '结果集
Public UserDept As String                           '用户所在部门
Public UserName As String                           '用户姓名
Public LoginStat As Integer                         '用户登录情况，0表示正在首次登录，
                                                    '1表示正在重新登录，2表示登录完成
Public GotInfo As Boolean                           '是否已提取信息
'API声明。API是应用程序编程接口(Application Programming Interface)的缩写
'打开执行一个命令的API
Public Declare Function ShellExecute Lib "shell32.dll" _
               Alias "ShellExecuteA" (ByVal hwnd As Long, _
               ByVal lpOperation As String, _
               ByVal lpFile As String, _
               ByVal lpParameters As String, _
               ByVal lpDirectory As String, _
               ByVal nShowCmd As Long) As Long
Public Const SW_SHOW = 5
'播放声音的API和与之有关的常数
Public Declare Function sndPlaySound Lib "winmm.dll" _
               Alias "sndPlaySoundA" (ByVal lpszSoundName As String, _
               ByVal uFlags As Long) As Long
Public Const SND_ASYNC = &H1
Public Const SND_NODEFAULT = &H2
'获得计算机的开机时间（单位：毫秒）的API
Public Declare Function GetTickCount Lib "kernel32" () As Long

'用来播放声音的子过程
Public Sub PlaySound(strSound As String)
  sndPlaySound strSound, SND_ASYNC Or SND_NODEFAULT
End Sub

'为程序进行延时的子过程
Public Sub TimeDelay(delayMilliseconds As Long)
  On Error Resume Next
  Dim sngStartTime As Single                        '该变量用来记录开始时间
  sngStartTime = GetTickCount                       '开始时间为计算机的开机时间
  Do Until (GetTickCount - sngStartTime) > delayMilliseconds
      DoEvents                                      '转让控制权
  Loop
End Sub

'替换字符串中的单引号
Public Function RealString(strOrigional) As String
  RealString = Replace(strOrigional, "'", "''")
End Function

'关闭结果集
Public Sub CloseRsAdo()
  If Not (RsAdo Is Nothing) Then
     If RsAdo.State = adStateOpen Then
        RsAdo.Close
     End If
     Set RsAdo = Nothing
  End If
End Sub