Option Explicit
Public adocn As New ADODB.Connection
Public adocn2 As New ADODB.Connection
Public adocn3 As New ADODB.Connection
Public adocn4 As New ADODB.Connection
Public adors As New ADODB.Recordset
Public adoPara As New ADODB.Parameter
Public AdoCmd As New ADODB.Command
Public Result As Integer
Public nMPointer As Integer
Public rowindicator As Long
Public strMsg As String
Public strSQL As String
Public GstrSysDate As String
Public GstrSysTime As String
Public Const ORACLE As Integer = 1
Public Const MSSQL As Integer = 2
Public Const DB2 As Integer = 3
Public Const MYSQL As Integer = 4
Public Const DIRECT As Integer = 6
Public Const STAFF As Integer = 7
Type Password
IdNumber As String
Name As String
Password As String
End Type
Public CI As Password
'//MS_SQL DB Connection ID / PASS Check
Public Function IdConnect(ByVal Id As String, ByVal PASS As String) As Boolean
Dim rsUsm As ADODB.Recordset
Set rsUsm = New ADODB.Recordset
strSQL = "select UserId, Passwd" _
& " from USR" _
& " where UserId = '" & Id & "'" _
& " and Passwd = '" & PASS & "'"
Result = AdoOpenSet(rsUsm, strSQL, MSSQL, True)
If Result = 0 Then
If AdoGetString(rsUsm, "UserId", 0) <> "" Then
IdConnect = True
Else
IdConnect = False
End If
Else
IdConnect = False
End If
rsUsm.Close
Set rsUsm = Nothing
End Function
'//MS_SQL DB Connection
Public Function DbAdoConnect(ByVal IP As String, ByVal DBID As String, ByVal DBPASS As String, ByVal DB As String) As Boolean
Dim ConnectStr As String
On Error GoTo dbConnErr:
DbAdoConnect = True
nMPointer = Screen.MousePointer
Screen.MousePointer = vbHourglass
ConnectStr = "Driver={SQL Server};" _
& "Server=" & IP & "; " _
& "UID=" & DBID & "; " _
& "PWD=" & DBPASS & ";" _
& "Database=" & DB
Set adocn2 = New ADODB.Connection
adocn2.CursorLocation = adUseClient
adocn2.Open ConnectStr
Screen.MousePointer = nMPointer
Exit Function
'/===================================================================
dbConnErr:
Screen.MousePointer = nMPointer
MsgBox "MS_SQL에 연결하지 못했습니다" & vbCrLf & vbCrLf _
& "Error Number : " & Err.Number & vbCrLf _
& "Description : " & Err.Description, vbCritical, "DB Connect Error"
DbAdoConnect = False
End Function
'//MY_SQL DB Connection
Public Function MySqlAdoConnect(ByVal IP As String, ByVal DBID As String, ByVal DBPASS As String, ByVal DB As String) As Boolean
Dim ConnectStr As String
On Error GoTo dbConnErr:
MySqlAdoConnect = True
nMPointer = Screen.MousePointer
Screen.MousePointer = vbHourglass
' ConnectStr = "Driver={MySQL};" _
' & "Server=" & IP & "; " _
' & "UID=" & DBID & "; " _
' & "PWD=" & DBPASS & ";" _
' & "DataBase=" & DB
ConnectStr = "driver={MySQL ODBC 3.51 Driver};" _
& "Server=" & IP & "; " _
& "UID=" & DBID & "; " _
& "PWD=" & DBPASS & ";" _
& "Database=biomedy;" _
& "Dsn=" & DB
Set adocn4 = New ADODB.Connection
adocn4.CursorLocation = adUseClient
adocn4.Open ConnectStr
Screen.MousePointer = nMPointer
Exit Function
'/===================================================================
dbConnErr:
Screen.MousePointer = nMPointer
MsgBox "MYSQL에 연결하지 못했습니다" & vbCrLf & vbCrLf _
& "Error Number : " & Err.Number & vbCrLf _
& "Description : " & Err.Description, vbCritical, "DB Connect Error"
MySqlAdoConnect = False
End Function
'// DB2 DB Connection
Public Function Db2AdoConnect(ByVal DBID As String, ByVal DBPASS As String, ByVal DB As String) As Boolean
Dim ConnectStr As String
On Error GoTo dbConnErr:
Db2AdoConnect = True
nMPointer = Screen.MousePointer
Screen.MousePointer = vbHourglass
ConnectStr = "DSN=" & DB & ";UID=" & DBID & ";PWD=" & DBPASS & ";"
Set adocn3 = New ADODB.Connection
adocn3.CursorLocation = adUseClient
adocn3.Provider = "MSDASQL"
adocn3.Open ConnectStr
Screen.MousePointer = nMPointer
Exit Function
'/===================================================================
dbConnErr:
Screen.MousePointer = nMPointer
MsgBox "DB2에 연결 하지 못했습니다" & vbCrLf & vbCrLf _
& "Error Number : " & Err.Number & vbCrLf _
& "Description : " & Err.Description, vbCritical, "DB Connect Error"
Db2AdoConnect = False
End Function
'//Oracle DB Connection
Public Function OraAdoConnect(ByVal DBID As String, ByVal DBPASS As String, ByVal DB As String) As Boolean
Dim ConnectStr As String
On Error GoTo dbConnErr:
OraAdoConnect = True
nMPointer = Screen.MousePointer
Screen.MousePointer = vbHourglass
ConnectStr = "Provider=MSDAORA.1;" _
& "User ID=" & DBID & ";" _
& "Password=" & DBPASS & ";" _
& "Data Source=" & DB
' Set adocn = New ADODB.Connection 'temp
' adocn.CursorLocation = adUseClient
' adocn.Open ConnectStr
adocn.Open ConnectStr
adocn.CursorLocation = adUseClient
' adocn.Open ConnectStr
Screen.MousePointer = nMPointer
Exit Function
'/===================================================================
dbConnErr:
Screen.MousePointer = nMPointer
MsgBox "Oracle에 Connection(ADO)을 하지 못했습니다" & vbCrLf & vbCrLf _
& "Error Number : " & Err.Number & vbCrLf _
& "Description : " & Err.Description, vbCritical, "DB Connect Error"
OraAdoConnect = False
End Function
'// ADO DB DisConnection
Sub DbAdoDisConnect() 'ADO DB DisConnect
On Error Resume Next
adors.Close
Set adors = Nothing
Set AdoCmd = Nothing
If adocn.State = 1 Then
adocn.Close
Set adocn = Nothing
MsgBox "ADO1 Disconnection OK!"
End If
If adocn2.State = 1 Then
adocn2.Close
Set adocn2 = Nothing
MsgBox "ADO2 Disconnection OK!"
End If
If adocn3.State = 1 Then
adocn3.Close
Set adocn3 = Nothing
MsgBox "ADO3 Disconnection OK!"
End If
End Sub
'// RecordSet
Public Function AdoOpenSet(ByRef Rs As Object, ByVal SQL As String, ByVal FLG As Integer, Optional ByVal nRowCnt As Boolean = True) As Integer
Dim nMPointer As Integer
nMPointer = Screen.MousePointer
Screen.MousePointer = vbHourglass
On Error GoTo OpenError:
AdoOpenSet = 0
rowindicator = 0
If FLG = ORACLE Then
Rs.Open SQL, adocn, adOpenStatic, adLockOptimistic, adCmdText
ElseIf FLG = MSSQL Then
Rs.Open SQL, adocn2, adOpenStatic, adLockOptimistic, adCmdText
ElseIf FLG = DB2 Then
Rs.Open SQL, adocn3, adOpenStatic, adLockOptimistic, adCmdText
End If
Rs.CacheSize = 50
If Not Rs.EOF Then
If nRowCnt = True Then
rowindicator = Rs.RecordCount
Else
rowindicator = -1
End If
End If
Screen.MousePointer = nMPointer
Exit Function
'/===================================================================
OpenError:
AdoOpenSet = -1
If Err.Number = 40002 Then '응용 프로그램 정의 오류 또는 개체 정의 오류
'strMsg = adoErrors(0).Description
strMsg = Mid(strMsg, InStr(1, strMsg, "ORA-", vbBinaryCompare), Len(strMsg)) & vbCrLf & vbCrLf & SQL
MsgBox strMsg, vbCritical, "Error - " '& Trim(Str(AdoErrors(0).Number))
ElseIf Err.Number = 3704 Then
ElseIf Err.Number = -2147217900 Then
AdoOpenSet = 3
Else
MsgBox Err.Description, vbCritical, "VB Error - " & Trim(Str(Err.Number))
End If
Set Rs = Nothing
Screen.MousePointer = nMPointer
End Function
'//Record에서 문자열 Return 받기
Public Function AdoGetString(ByRef Rs As Object, ByVal AdoCol As String, ByVal AbsPos As Long) As String
On Error GoTo ReadError
Rs.AbsolutePosition = AbsPos + 1
AdoGetString = Trim(Rs.Fields(AdoCol).Value & "")
Exit Function
'/===================================================================
ReadError:
Dim strTemp As String
AdoGetString = ""
strTemp = ", Form Name : " & Screen.ActiveForm.Name & "-" & Screen.ActiveForm.ActiveControl.Name
Select Case Err.Number
Case Else
Debug.Print "AdoGetString Error - " & RTrim(Str(Err.Number)), Err.Description & strTemp
End Select
End Function
'//Record에서 숫자 Return 받기
Public Function AdoGetNumber(ByRef Rs As Object, ByVal AdoCol As String, ByVal AbsPos As Long) As Double
On Error GoTo ReadError
Rs.AbsolutePosition = AbsPos + 1
AdoGetNumber = IIf(IsNull(Rs.Fields(AdoCol).Value), 0, Rs.Fields(AdoCol).Value)
Exit Function
'/========================================================================================================================================
ReadError:
Dim strTemp As String
AdoGetNumber = 0
strTemp = ", Form Name : " & Screen.ActiveForm.Name & "-" & Screen.ActiveForm.ActiveControl.Name
Select Case Err.Number
Case Else
Debug.Print "AdoGetNumber Error - " & RTrim(Str(Err.Number)), Err.Description & strTemp
End Select
End Function
'//SQL문 실행시 ERROR MESSAGE 보여줌
Public Function AdoExecute(ByVal SQL As String, Optional FLG As Integer = ORACLE) As Integer 'SQL문 실행시 ERROR MESSAGE 보여줌
Dim nMPointer As Integer
nMPointer = Screen.MousePointer
Screen.MousePointer = vbHourglass
On Error GoTo ExecError:
AdoExecute = 0
rowindicator = 0
Set AdoCmd = New ADODB.Command
Set adors = New ADODB.Recordset
AdoCmd.CommandType = adCmdText
AdoCmd.CommandText = SQL
AdoCmd.ActiveConnection = IIf(FLG = ORACLE, adocn, IIf(FLG = MSSQL, adocn2, IIf(FLG = DB2, adocn3, adocn4)))
Set adors = AdoCmd.Execute
' rowindicator = AdoRs.RecordCount ' 한번의 Transaction 에 의해 처리된 행의 숫자
Screen.MousePointer = nMPointer
Exit Function
'/===================================================================
ExecError:
If Err.Number = 40002 Then '응용 프로그램 정의 오류 또는 개체 정의 오류
MsgBox strMsg, vbCritical, "Error - " '& Trim(Str(adoerrors(0).Number))
Else
MsgBox Err.Description, vbCritical, "VB Error - " & Trim(Str(Err.Number))
End If
AdoExecute = -1
Screen.MousePointer = nMPointer
End Function
Public Function Db2Execute(ByVal SQL As String, Optional FLG As Integer = MSSQL) As Integer 'SQL문 실행시 ERROR MESSAGE 보여줌
Dim nMPointer As Integer
nMPointer = Screen.MousePointer
Screen.MousePointer = vbHourglass
On Error GoTo ExecError:
Db2Execute = 0
rowindicator = 0
Set AdoCmd = New ADODB.Command
Set adors = New ADODB.Recordset
AdoCmd.CommandType = adCmdText
AdoCmd.CommandText = SQL
' AdoCmd.ActiveConnection = IIf(FLG = MSSQL, adocn, IIf(FLG = ORACLE, adocn2, adocn3))
Select Case FLG
Case MSSQL: AdoCmd.ActiveConnection = adocn
Case ORACLE: AdoCmd.ActiveConnection = adocn2
Case Else
AdoCmd.ActiveConnection = adocn3
End Select
Set adors = AdoCmd.Execute
' rowindicator = AdoRs.RecordCount ' 한번의 Transaction 에 의해 처리된 행의 숫자
Screen.MousePointer = nMPointer
Exit Function
'/===================================================================
ExecError:
If Err.Number = 40002 Then '응용 프로그램 정의 오류 또는 개체 정의 오류
MsgBox strMsg, vbCritical, "Error - " '& Trim(Str(adoerrors(0).Number))
Else
MsgBox Err.Description, vbCritical, "VB Error - " & Trim(Str(Err.Number))
End If
Db2Execute = -1
Screen.MousePointer = nMPointer
End Function
Public Function AdoExecute1(ByVal SQL As String, Optional FLG As Integer = ORACLE) As Integer 'SQL문 실행시 ERROR MESSAGE 보여줌
Dim nMPointer As Integer
nMPointer = Screen.MousePointer
Screen.MousePointer = vbHourglass
On Error GoTo ExecError:
AdoExecute1 = 0
rowindicator = 0
Set AdoCmd = New ADODB.Command
Set adors = New ADODB.Recordset
AdoCmd.CommandType = adCmdText
AdoCmd.CommandText = SQL
AdoCmd.ActiveConnection = IIf(FLG = ORACLE, adocn, IIf(FLG = MSSQL, adocn2, IIf(FLG = DB2, adocn3, adocn4)))
Set adors = AdoCmd.Execute
Screen.MousePointer = nMPointer
Exit Function
'/================================================================
ExecError:
AdoExecute1 = -1
Screen.MousePointer = nMPointer
End Function
Public Sub AdoCloseSet(ByRef Rs As Object)
If Not Rs Is Nothing Then
Rs.Close
Set Rs = Nothing
End If
End Sub
'//SYSTEM DATE & TIME 읽어온 후 PC
Public Sub SetDateTime(ByVal DbGubun As Integer) 'SYSTEM DATE & TIME 읽어온 후 PC 날짜Set
Dim rsDate As ADODB.Recordset
Set rsDate = New ADODB.Recordset
Select Case DbGubun
Case ORACLE
strSQL = "select TO_CHAR(SYSDATE,'yyyy-MM-dd') SDate, TO_CHAR(SYSDATE,'hh24miss') STime" _
& " from DUAL"
Case MSSQL
strSQL = "select convert(CHAR(8), GetDate(), 112) as SDate, convert(CHAR(8), GetDate(), 108) as STime"
End Select
Result = AdoOpenSet(rsDate, strSQL, DbGubun, True)
'// 날짜 변환 형태에 맞춰서 주석 처리
' GstrSysDate = Format(AdoGetString(rsDate, "SDate", 0), "####-##-##")
GstrSysDate = Format(AdoGetString(rsDate, "SDate", 0), "YYYYMMDD")
GstrSysTime = AdoGetString(rsDate, "STime", 0)
AdoCloseSet rsDate
Set rsDate = Nothing
End Sub
'//DB Transaction / Commit / Rollback
Public Sub BeginTrans(ByVal DbGubun As Integer)
Select Case DbGubun
Case ORACLE: adocn.BeginTrans
Case MSSQL: adocn2.BeginTrans
Case DB2: adocn3.BeginTrans
Case MYSQL: adocn4.BeginTrans
End Select
End Sub
Public Sub CommitTrans(ByVal DbGubun As Integer)
Select Case DbGubun
Case ORACLE: adocn.CommitTrans
Case MSSQL: adocn2.CommitTrans
Case DB2: adocn3.CommitTrans
Case MYSQL: adocn4.CommitTrans
End Select
End Sub
Public Sub RollbackTrans(ByVal DbGubun As Integer)
Select Case DbGubun
Case ORACLE: adocn.RollbackTrans
Case MSSQL: adocn2.RollbackTrans
Case DB2: adocn3.RollbackTrans
Case MYSQL: adocn4.RollbackTrans
End Select
End Sub
'// DB Query 작성시 ' 포함 모듈
Public Function Quot(ByVal strString As String) As String
' 텍스트입력시 " ' " 간편하게 입력할때 사용
Dim i As Integer ' 텍스트 자료입력시 중간에 "'" 를 "''"로 변환시켜 줌
Dim nPos As Integer
strString = Trim(strString)
If InStr(strString, "'") = 0 Then Quot = strString: Exit Function
nPos = 1
Do
For i = nPos To Len(strString)
If Mid(strString, i, 1) = "'" Then
strString = Left(strString, i - 1) & "''" & Mid(strString, i + 1)
Exit For
End If
Next i
nPos = i + 2
If nPos > Len(strString) Then Exit Do
Loop While (True)
Quot = strString
End Function
'SMH > Module' 카테고리의 다른 글
| PB_DLL File Exists Check (0) | 2011.01.01 |
|---|---|
| PB_File log make (0) | 2011.01.01 |
| VB_주민번호체크(내국인+외국인) (0) | 2011.01.01 |
| VB_file write (0) | 2011.01.01 |
| VB_farpoint Initailize (0) | 2011.01.01 |