database.bas

自己做的

Attribute VB_Name = "DataBase"
'Public Const Sever = "STARS"
Public Const Sever = "10.105.60.50"
Public Const dbPath = "\pr.mdb"
Public Function ConnString(isWho As String) As String
If isWho = "s" Then
ConnString = "Provider=SQLOLEDB.1;Password=an;Persist Security Info=True;User ID=an;Initial Catalog=BOSS;Data Source=" & Sever
'ConnString = "driver={Microsoft Access Driver (*.mdb)};dbq=" & App.Path & dbPath
ElseIf isWho = "o" Then
ConnString = "DSN=RPTHIS;UID=dz01;PWD=dz01;DBQ=RPTHIS;DBA=W;APA=T;EXC=F;FEN=T;QTO=T;FRC=10;FDL=10;LOB=T;RST=T;GDE=F;FRL=F;BAM=IfAllSuccessful;NUM=NLS;DPM=F;MTS=T;MDI=F;CSR=F;FWC=F;FBS=64000;TLO=0;"
End If
End Function
Public Function ExeSQL(ByVal Sql As String, iflag As String) As ADODB.Recordset
On Error Resume Next
Dim mycon As ADODB.Connection
Dim rst As ADODB.Recordset
Set mycon = New ADODB.Connection
mycon.ConnectionString = ConnString(iflag)
mycon.CommandTimeout = 30
mycon.Open
Dim Stokens() As String
Set rst = New ADODB.Recordset
On Error GoTo exectuesql_error
Stokens = Split(Sql, " ")
If UCase(Stokens(0)) <> "SELECT" Then
      mycon.Execute Sql
Else
  rst.Open Trim(Sql), mycon, 3, 3
 Set ExeSQL = rst
End If
exectuesql_exit:
  Set rst = Nothing
  Set mycon = Nothing
  Exit Function
exectuesql_error:
  Resume exectuesql_exit
End Function