module1.bas

个人收藏的学习类别的

Attribute VB_Name = "Module1"
Option Explicit
 '=====================================
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Public Declare Sub ReleaseCapture Lib "user32" ()

Public Declare Function GetPrivateProfileString Lib _
"kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, _
ByVal nSize As Long, ByVal lpFileName As String) As Long

Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2
Public lngReturnValue As Long

'===========================================
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function GetTickCount Lib "kernel32" () As Long

Public CN As String


Public conn As New ADODB.Connection     '标记连接对象
Public userID As String                 '标记当前用户ID
Public userpow As String                '标记用户权限


Public Loginname As String
Public Access As Single
Public Today As Date
Public Flagrpt As String



Public Function AdoSet(sql As String) As ADODB.Recordset
    On Error Resume Next

    '给一个sql语句返回记录集
    Dim re  As ADODB.Recordset

    On Error GoTo doexit
    Set re = New ADODB.Recordset
    re.Open sql, CN, adOpenStatic, adLockReadOnly
doexit:
    Set AdoSet = re
    Set re = Nothing
    '    MsgBox sql
End Function
Public Sub cnSet()
    On Error Resume Next
    CN = "driver={microsoft access driver (*.mdb)};uid=;dbq=" & App.Path & "\database.mdb"

   
    CN = Trim(CN)
End Sub

 Sub Main()
 Call cnSet
 
 frmlogin.Show
 

End Sub
Public Function exsql(ParamArray sql()) As Boolean

    '事务执行1个sql语句
    Dim cnConn As ADODB.Connection
    Set cnConn = New ADODB.Connection
    Dim Mysql
    On Error GoTo err1

    cnConn.Open CN
    cnConn.BeginTrans '开始一个事务

    For Each Mysql In sql
        cnConn.Execute Mysql
    Next
    cnConn.CommitTrans '提交一个事物

    Set cnConn = Nothing
    exsql = True

   Exit Function

err1:
    cnConn.RollbackTrans '回滚一个事物
    exsql = False
End Function
Public Function Exsql1(sql() As String) As Boolean

    '事务执行1个sql语句
    Dim cnConn As ADODB.Connection
    Set cnConn = New ADODB.Connection
    Dim i As Integer
    On Error GoTo err1

    cnConn.Open CN
    cnConn.BeginTrans '开始一个事务

    For i = 0 To UBound(sql)
        cnConn.Execute sql(i)
    Next
    cnConn.CommitTrans '提交一个事物

    Set cnConn = Nothing
    Exsql1 = True

   Exit Function

err1:
    cnConn.RollbackTrans '回滚一个事物
    Exsql1 = False
    Debug.Print sql(i) & i
End Function
Public Function Exsql2(sql() As String, sql1() As String) As Boolean
    On Error Resume Next

    '事务执行1个sql语句
    Dim cnConn As ADODB.Connection
    Set cnConn = New ADODB.Connection
    Dim i As Integer
    On Error GoTo err1

    cnConn.Open CN
    cnConn.BeginTrans '开始一个事务

    For i = 0 To UBound(sql)
        cnConn.Execute sql(i)
    Next
    For i = 0 To UBound(sql1)
        cnConn.Execute sql1(i)
    Next
    cnConn.CommitTrans '提交一个事物

    Set cnConn = Nothing
    Exsql2 = True

   Exit Function

err1:
    cnConn.RollbackTrans '回滚一个事物
    Exsql2 = False
End Function
Public Function Exsql3(sql() As String, sql1() As String, sql2() As String) As Boolean
    On Error Resume Next

    '事务执行1个sql语句
    Dim cnConn As ADODB.Connection
    Set cnConn = New ADODB.Connection
    Dim i As Integer
    On Error GoTo err1

    cnConn.Open CN
    cnConn.BeginTrans '开始一个事务

    For i = 0 To UBound(sql)
        cnConn.Execute sql(i)
    Next
    For i = 0 To UBound(sql1)
        cnConn.Execute sql1(i)
    Next
    For i = 0 To UBound(sql2)
        cnConn.Execute sql2(i)
    Next
    cnConn.CommitTrans '提交一个事物

    Set cnConn = Nothing
    Exsql3 = True

   Exit Function

err1:
    cnConn.RollbackTrans '回滚一个事物
    Exsql3 = False
End Function



Public Sub Position(pfrm As Form)
    On Error Resume Next

  
    pfrm.Top = 0
    pfrm.Left = (Screen.Width - pfrm.Width) / 2
    '    pfrm.BSE1.SchemeStyle = 2
    '    pfrm.BSE1.EndSubClassing
    '    pfrm.BSE1.InitSubClassing
End Sub