当前位置:编程学习 > VB >>

aaaaaa

Public Sub UpdateRecord(pstrStatement As String)
Dim cn As ADODB.Connection
Dim rsUpdRec As ADODB.Recordset

Dim PintCnt As Integer

PintCnt = 0

Set cn = New ADODB.Connection

cn.Open gstrConn

Set rsUpdRec = Nothing
Set rsUpdRec = New ADODB.Recordset
        
rsUpdRec.CursorLocation = adUseServer
Set rsUpdRec.ActiveConnection = cn
    
On Error GoTo ErrHandle
Ex:
rsUpdRec.Open (pstrStatement), cn, adOpenForwardOnly, adLockOptimistic


Set rsUpdRec.ActiveConnection = Nothing
cn.Close
Set cn = Nothing

On Error GoTo 0
Exit Sub

ErrHandle:

PintCnt = PintCnt + 1
If PintCnt > 3 Then
   MsgBox "Timeout during select data!", 48, "Error Message"
   Set rsUpdRec = Nothing
Else
    GoTo Ex
End If
On Error GoTo 0

End Sub

Public Sub SelectRecordForGrid(rsGetRecord As ADODB.Recordset, SQLStatement As String)
Dim cn As ADODB.Connection
Dim PintCnt As Integer
Dim pintCntConn As Integer
Dim pintCnttime As Long

PintCnt = 0
pintCntConn = 0
ConnAgain:
PintCnt = PintCnt + 1
Do
   If pintCntConn > 0 Then
      ' for time delay purpose
      For pintCnttime = 0 To 1000000
          DoEvents
      Next
   End If
   Set cn = New ADODB.Connection
   cn.CommandTimeout = 0
   On Error Resume Next
   cn.Open gstrConn
   pintCntConn = pintCntConn + 1
Loop Until err.Number = 0 Or (err.Number <> 0 And pintCntConn > 2)
Set rsGetRecord = Nothing
Set rsGetRecord = New ADODB.Recordset

rsGetRecord.CursorLocation = adUseClient
rsGetRecord.CacheSize = 100
Set rsGetRecord.ActiveConnection = cn

If PintCnt > 5 Then
   MsgBox "Server Error, please try again, if still have same matter, please call MIS colleague.", 64, "Information"
   End
End If
On Error GoTo ConnAgain
rsGetRecord.Open SQLStatement, cn, adOpenStatic, adLockReadOnly

Set rsGetRecord.ActiveConnection = Nothing
cn.Close
Set cn = Nothing

On Error GoTo 0
Exit Sub

End Sub

gstrConn = "Provider=SQLOLEDB; Data Source=10.2.1.99;" & _
    "Initial Catalog = Dummy_Development; User Id=Dummy; Password=mn"
补充:VB ,  非技术类
CopyRight © 2022 站长资源库 编程知识问答 zzzyk.com All Rights Reserved
部分文章来自网络,