Class ADO Connection di VB6.0

==========================START==========================

‘/*instance fields declaration*/
‘/*Author by Yanto Hariyono*/

‘/*Setting.INI Files

‘/*Support database type*/
‘/* 0 = MySQL
‘/* 1 = Oracle
‘/* 2 = Access
‘/* 3 = PostgreSQL
‘/* 4 = SQLServer
‘/* 5 = ODBC
‘==================================================================================

Private m_con As New ADODB.Connection
Private m_com As New ADODB.Command
Private m_cons As New ADODB.Connection
Private m_coms As New ADODB.Command
Private rst As New ADODB.Recordset
Private rst2 As New ADODB.Recordset
Private rst3 As New ADODB.Recordset
Private SQL As String, SQLS As String
Private strconnection As String
Public KoneksiStr As String

Private Const ODBC_ADD_DSN = 1        ‘ Add data source
Private Const ODBC_CONFIG_DSN = 2     ‘ Configure (edit) data source
Private Const ODBC_REMOVE_DSN = 3     ‘ Remove data source
Private Const vbAPINull As Long = 0   ‘ NULL Pointer

Public Enum dbType
MySQL = 0
Oracle = 1
MsAccess = 2
PostgreSQL = 3
SQLServer = 4
ODBC = 5
End Enum

Private 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

Private Declare Function GetPrivateProfileInt Lib “kernel32” Alias “GetPrivateProfileIntA” _
(ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, _
ByVal lpFileName As String) As Long

Private Declare Function WritePrivateProfileString Lib “kernel32” Alias “WritePrivateProfileStringA” _
(ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, _
ByVal lpFileName As String) As Long

Private buffer As String * 255
Private str As String

‘Function Declare
#If Win32 Then
Private Declare Function SQLConfigDataSource Lib “ODBCCP32.DLL” _
(ByVal hWndParent As Long, ByVal fRequest As Long, _
ByVal lpszDriver As String, ByVal lpszAttributes As String) _
As Long
#Else
Private Declare Function SQLConfigDataSource Lib “ODBCINST.DLL” _
(ByVal hWndParent As Integer, ByVal fRequest As Integer, ByVal _
lpszDriver As String, ByVal lpszAttributes As String) As Integer
#End If

Private app_ini As String

‘/*MySQL*/
‘/*————————————————————————–*/
Public Sub createmyodbc(ByVal pserver As String, ByVal pdatabase As String, _
ByVal puser As String, ByVal ppasswd As String, ByVal pport As Integer)
#If Win32 Then
Dim intRet As Long
#Else
Dim intRet As Integer
#End If
Dim strDriver As String
Dim strAttributes As String

strDriver = “MySQL ODBC 3.51 Driver”
strAttributes = “SERVER=” & pserver & Chr$(0)
strAttributes = strAttributes & “DESCRIPTION=Connection to MyODBC / MySQL” & Chr$(0)
strAttributes = strAttributes & “DSN=TITMySQL” & Chr$(0)
strAttributes = strAttributes & “DATABASE=” & pdatabase & Chr$(0)
strAttributes = strAttributes & “USER=” & puser & Chr$(0)
strAttributes = strAttributes & “PASSWORD=” & ppasswd & Chr$(0)
strAttributes = strAttributes & “PORT=” & pport & Chr$(0)
intRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_DSN, strDriver, strAttributes)

If intRet = 0 Then
MsgBox “gagal dibuat”
End If
End Sub

Public Sub deletemyodbc()
#If Win32 Then
Dim intRet As Long
#Else
Dim intRet As Integer
#End If
Dim strDriver As String
Dim strAttributes As String

strDriver = “MySQL ODBC 3.51 Driver”
strAttributes = strAttributes & “DSN=TITMySQL” & Chr$(0)
intRet = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_DSN, strDriver, strAttributes)

If intRet = 0 Then
MsgBox “gagal dihapus”
End If
End Sub
‘/*————————————————————————–*/

Public Sub Mykoneksi()
On Error GoTo errkoneksi

If m_con.State = adStateOpen Then
m_con.Close
End If

app_ini = App.Path & “\setting.ini”

Dim dbtype_ As dbType
dbtype_ = getstringinifiles(“dbtype”, “type”, “0”, app_ini)

Select Case dbtype_
Case 0: m_con.ConnectionString = “DSN=TITMySQL”
Case 1: m_con.ConnectionString = “Provider=OraOLEDB.Oracle.1;User ID=” & Decrypt(getstringinifiles(“dbconfig”, “user”, “”, app_ini)) & “;” & _
“Data Source=” & getstringinifiles(“dbconfig”, “dbname”, “”, app_ini) & “;” & _
“Password=” & Decrypt(getstringinifiles(“dbconfig”, “pwd”, “”, app_ini))

Case 2: m_con.ConnectionString = “Provider=Microsoft.Jet.OLEDB.4.0;Data Source=” & getstringinifiles(“dbconfig”, “dbname”, “”, app_ini) & “;JET OLEDB:DATABASE PASSWORD=password”

Case 3: m_con.ConnectionString = “Driver={PostgreSQL ANSI};Server=” & getstringinifiles(“dbconfig”, “server”, “”, app_ini) & “;” & _
“Uid=” & Decrypt(getstringinifiles(“dbconfig”, “user”, “”, app_ini)) & “;Pwd=” & Decrypt(getstringinifiles(“dbconfig”, “pwd”, “”, app_ini)) & “;” & _
“Port=” & getstringinifiles(“dbconfig”, “port”, “”, app_ini) & “;Database=” & getstringinifiles(“dbconfig”, “dbname”, “”, app_ini)
Case 4: m_con.ConnectionString = “Provider=SQLOLEDB.1;Password=” & Decrypt(getstringinifiles(“dbconfig”, “pwd”, “”, app_ini)) & “;Persist Security Info=True;User ID=” & Decrypt(getstringinifiles(“dbconfig”, “user”, “”, app_ini)) & “;Initial Catalog=” & getstringinifiles(“dbconfig”, “dbname”, “”, app_ini) & “;Data Source=” & getstringinifiles(“dbconfig”, “server”, “”, app_ini) & “”

Case 5: m_con.ConnectionString = “DSN=” & getstringinifiles(“dbconfig”, “dbname”, “”, app_ini)

End Select

strconnection = m_con.ConnectionString
KoneksiStr = strconnection
m_con.Open

errkoneksi:
If Err <> 0 Then
MsgBox “[” & Err.Number & “] ” & Err.Description, vbExclamation, “Konfigurasi error!!!”

setstringinifiles “dbconfig”, “server”, “”, app_ini
setstringinifiles “dbconfig”, “dbname”, “”, app_ini
setstringinifiles “dbconfig”, “user”, “”, app_ini
setstringinifiles “dbconfig”, “pwd”, “”, app_ini
setstringinifiles “dbconfig”, “port”, “”, app_ini

m_con.Close
Set m_con = Nothing
Err.Clear
Exit Sub
End If
End Sub

Public Function teskoneksi() As Boolean
On Error GoTo errkoneksi

If m_con.State = adStateOpen Then
m_con.Close
End If

app_ini = App.Path & “\setting.ini”

Dim dbtype_ As dbType
dbtype_ = getstringinifiles(“dbtype”, “type”, “0”, app_ini)

Select Case dbtype_
Case 0: m_con.ConnectionString = “DSN=TITMySQL”
Case 1: m_con.ConnectionString = “Provider=OraOLEDB.Oracle.1;User ID=” & Decrypt(getstringinifiles(“dbconfig”, “user”, “”, app_ini)) & “;” & _
“Data Source=” & getstringinifiles(“dbconfig”, “dbname”, “”, app_ini) & “;” & _
“Password=” & Decrypt(getstringinifiles(“dbconfig”, “pwd”, “”, app_ini))
Case 2: m_con.ConnectionString = “Provider=Microsoft.Jet.OLEDB.4.0;Data Source=” & getstringinifiles(“dbconfig”, “dbname”, “”, app_ini) & “;JET OLEDB:DATABASE PASSWORD=password”
Case 3: m_con.ConnectionString = “Driver={PostgreSQL ANSI};Server=” & getstringinifiles(“dbconfig”, “server”, “”, app_ini) & “;” & _
“Uid=” & Decrypt(getstringinifiles(“dbconfig”, “user”, “”, app_ini)) & “;Pwd=” & Decrypt(getstringinifiles(“dbconfig”, “pwd”, “”, app_ini)) & “;” & _
“Port=” & getstringinifiles(“dbconfig”, “port”, “”, app_ini) & “;Database=” & getstringinifiles(“dbconfig”, “dbname”, “”, app_ini)
Case 4: m_con.ConnectionString = “Provider=SQLOLEDB.1;Password=” & Decrypt(getstringinifiles(“dbconfig”, “pwd”, “”, app_ini)) & “;Persist Security Info=True;User ID=” & Decrypt(getstringinifiles(“dbconfig”, “user”, “”, app_ini)) & “;Initial Catalog=” & getstringinifiles(“dbconfig”, “dbname”, “”, app_ini) & “;Data Source=” & getstringinifiles(“dbconfig”, “server”, “”, app_ini) & “”
Case 5: m_con.ConnectionString = “DSN=” & getstringinifiles(“dbconfig”, “dbname”, “”, app_ini)
End Select

m_con.Open
teskoneksi = True
KoneksiStr = m_con.ConnectionString
MsgBox “Koneksi tersambung.”, vbInformation, “Konfigurasi berhasil”

errkoneksi:
If Err <> 0 Then
MsgBox “Koneksi gagal!”, vbExclamation, “Konfigurasi error!!!”
Err.Clear

setstringinifiles “dbconfig”, “server”, “”, app_ini
setstringinifiles “dbconfig”, “dbname”, “”, app_ini
setstringinifiles “dbconfig”, “user”, “”, app_ini
setstringinifiles “dbconfig”, “pwd”, “”, app_ini
setstringinifiles “dbconfig”, “port”, “”, app_ini
setstringinifiles “basic”, “config”, “0”, app_ini
teskoneksi = False
KoneksiStr = “”
Exit Function
End If
End Function

Public Function ExecuteQuery(ByVal SQL As String) As Boolean
On Error GoTo errExec

Mykoneksi
If rst.State = adStateOpen Then
rst.Close
Set rst = Nothing
End If

rst.Open SQL, m_con, adOpenDynamic, adLockOptimistic, adCmdText

If Not rst.EOF Then
ExecuteQuery = True
Else
ExecuteQuery = False
End If

errExec:
If Err <> 0 Then
MsgBox “[” & Err.Number & “] ” & Err.Description, vbExclamation, “Query error!!!”
Err.Clear
End If
End Function

Public Function ExecuteQueryrst(ByVal SQL As String) As ADODB.Recordset
On Error GoTo errExec

Mykoneksi
If rst.State = adStateOpen Then
rst.Close
Set rst = Nothing
End If

rst.CursorLocation = adUseClient
rst.Open SQL, m_con, adOpenDynamic, adLockOptimistic, adCmdText

Set ExecuteQueryrst = rst

errExec:
If Err <> 0 Then
MsgBox “[” & Err.Number & “] ” & Err.Description, vbExclamation, “Query error!!!”
Err.Clear
End If
End Function

Public Function ExecuteQueryrstAdd(ByVal SQL As String) As ADODB.Recordset
On Error GoTo errExec

If m_con.State = adStateClosed Then
Mykoneksi
End If

If rst2.State = adStateOpen Then
rst2.Close
Set rst2 = Nothing
End If

rst2.CursorLocation = adUseClient
rst2.Open SQL, m_con, adOpenDynamic, adLockOptimistic, adCmdText

Set ExecuteQueryrstAdd = rst2

errExec:
If Err <> 0 Then
MsgBox “[” & Err.Number & “] ” & Err.Description, vbExclamation, “Query error!!!”
Err.Clear
End If
End Function

Public Sub CloseConnection()
On Error Resume Next
m_con.Close
Set m_con = Nothing
End Sub

Public Sub ExecuteUpdate(ByVal SQL As String)
On Error GoTo errExec

Mykoneksi
If m_com.State = adStateOpen Then
Set m_com = Nothing
End If
m_com.ActiveConnection = m_con
m_com.CommandText = SQL
m_com.CommandType = adCmdText
m_com.Execute

errExec:
If Err <> 0 Then
MsgBox “[” & Err.Number & “] ” & Err.Description, vbExclamation, “Update error!!!”
Err.Clear
End If
End Sub

Public Function cekkoneksi() As Boolean
On Error GoTo errkoneksi

If m_con.State = adStateOpen Then
m_con.Close
End If

app_ini = App.Path & “\setting.ini”

Dim dbtype_ As dbType
dbtype_ = getstringinifiles(“dbtype”, “type”, “0”, app_ini)

Select Case dbtype_
Case 0: m_con.ConnectionString = “DSN=TITMySQL”
Case 1: m_con.ConnectionString = “Provider=OraOLEDB.Oracle.1;User ID=” & Decrypt(getstringinifiles(“dbconfig”, “user”, “”, app_ini)) & “;” & _
“Data Source=” & getstringinifiles(“dbconfig”, “dbname”, “”, app_ini) & “;” & _
“Password=” & Decrypt(getstringinifiles(“dbconfig”, “pwd”, “”, app_ini))
Case 2: m_con.ConnectionString = “Provider=Microsoft.Jet.OLEDB.4.0;Data Source=” & getstringinifiles(“dbconfig”, “dbname”, “”, app_ini) & “;JET OLEDB:DATABASE PASSWORD=password”
Case 3: m_con.ConnectionString = “Driver={PostgreSQL ANSI};Server=” & getstringinifiles(“dbconfig”, “server”, “”, app_ini) & “;” & _
“Uid=” & Decrypt(getstringinifiles(“dbconfig”, “user”, “”, app_ini)) & “;Pwd=” & Decrypt(getstringinifiles(“dbconfig”, “pwd”, “”, app_ini)) & “;” & _
“Port=” & getstringinifiles(“dbconfig”, “port”, “”, app_ini) & “;Database=” & getstringinifiles(“dbconfig”, “dbname”, “”, app_ini)
Case 4: m_con.ConnectionString = “Provider=SQLOLEDB.1;Password=” & Decrypt(getstringinifiles(“dbconfig”, “pwd”, “”, app_ini)) & “;Persist Security Info=True;User ID=” & Decrypt(getstringinifiles(“dbconfig”, “user”, “”, app_ini)) & “;Initial Catalog=” & getstringinifiles(“dbconfig”, “dbname”, “”, app_ini) & “;Data Source=” & getstringinifiles(“dbconfig”, “server”, “”, app_ini) & “”
Case 5: m_con.ConnectionString = “DSN=” & getstringinifiles(“dbconfig”, “dbname”, “”, app_ini)
End Select

m_con.Open
cekkoneksi = True
KoneksiStr = m_con.ConnectionString

errkoneksi:
If Err <> 0 Then
MsgBox “Koneksi gagal!”, vbExclamation, “Konfigurasi error!!!”
Err.Clear

setstringinifiles “dbconfig”, “server”, “”, app_ini
setstringinifiles “dbconfig”, “dbname”, “”, app_ini
setstringinifiles “dbconfig”, “user”, “”, app_ini
setstringinifiles “dbconfig”, “pwd”, “”, app_ini
setstringinifiles “dbconfig”, “port”, “”, app_ini
setstringinifiles “basic”, “config”, “0”, app_ini
cekkoneksi = False
KoneksiStr = “”
Exit Function
End If
End Function

Public Function getstringinifiles(ByVal psection As String, ByVal pkey As String, _
ByVal pdefault As String, ByVal ppath As String) As String
Dim x As Long

x = GetPrivateProfileString(psection, pkey, pdefault, buffer, 255, ppath)
str = Left(buffer, x)

If Trim(str) <> “” Then
getstringinifiles = str
End If
End Function

Public Function getintinifiles(ByVal psection As String, ByVal pkey As String, _
ByVal pdefault As String, ByVal ppath As String) As Integer
Dim xint As Long
xint = GetPrivateProfileInt(psection, pkey, pdefault, ppath)
getintinifiles = xint
End Function

Public Sub setstringinifiles(ByVal psection As String, ByVal pkey As String, _
ByVal pValue As String, ByVal ppath As String)
WritePrivateProfileString psection, pkey, pValue, ppath
End Sub

Public Function Decrypt(ByVal str As String) As String
Decrypt = DecryptText(str, “mrthx89”)
End Function
Public Function Encrypt(ByVal str As String) As String
Encrypt = EncryptText(str, “mrthx89”)
End Function

‘Encrypt text
Public Function EncryptText(strText As String, ByVal strPwd As String)
Dim i As Integer, c As Integer
Dim strBuff As String

#If Not CASE_SENSITIVE_PASSWORD Then

‘Convert password to upper case
‘if not case-sensitive
strPwd = UCase$(strPwd)

#End If

‘Encrypt string
If Len(strPwd) Then
For i = 1 To Len(strText)
c = Asc(Mid$(strText, i, 1))
c = c + Asc(Mid$(strPwd, (i Mod Len(strPwd)) + 1, 1))
strBuff = strBuff & Chr$(c And &HFF)
Next i
Else
strBuff = strText
End If
EncryptText = strBuff
End Function

‘Decrypt text encrypted with EncryptText
Public Function DecryptText(strText As String, ByVal strPwd As String)
Dim i As Integer, c As Integer
Dim strBuff As String

#If Not CASE_SENSITIVE_PASSWORD Then

‘Convert password to upper case
‘if not case-sensitive
strPwd = UCase$(strPwd)

#End If

‘Decrypt string
If Len(strPwd) Then
For i = 1 To Len(strText)
c = Asc(Mid$(strText, i, 1))
c = c – Asc(Mid$(strPwd, (i Mod Len(strPwd)) + 1, 1))
strBuff = strBuff & Chr$(c And &HFF)
Next i
Else
strBuff = strText
End If
DecryptText = strBuff
End Function

Public Sub SetDatabase(ByRef TypeName As dbType, ByRef server As String, ByRef dbname As String, ByRef user As String, _
ByRef pass As String, ByRef port As String)
app_ini = App.Path & “\setting.ini”
‘  Dim i As Integer

‘    MySQL = 0
‘    Oracle = 1
‘    MsAccess = 2
‘    PostgreSQL = 3
‘    SQLServer = 4
‘    ODBC = 5

‘  Select Case TypeName
‘    Case TypeName = MySQL
‘      i = 0
‘    Case TypeName = Oracle
‘      i = 1
‘    Case TypeName = MsAccess
‘      i = 2
‘    Case TypeName = PostgreSQL
‘      i = 3
‘    Case TypeName = SQLServer
‘      i = 4
‘    Case TypeName = ODBC
‘      i = 4
‘  End Select

setstringinifiles “dbtype”, “type”, TypeName, app_ini
setstringinifiles “dbconfig”, “server”, server, app_ini
setstringinifiles “dbconfig”, “dbname”, dbname, app_ini
setstringinifiles “dbconfig”, “user”, Encrypt(user), app_ini
setstringinifiles “dbconfig”, “pwd”, Encrypt(pass), app_ini
setstringinifiles “dbconfig”, “port”, port, app_ini

If teskoneksi Then
setstringinifiles “basic”, “config”, 1, app_ini
If getintinifiles(“basic”, “cTime”, 0, app_ini) = 0 Then
setstringinifiles “basic”, “cTime”, 1, app_ini
End If
End If
End Sub

==========================END==========================

  1. No trackbacks yet.

Tinggalkan Balasan

Isikan data di bawah atau klik salah satu ikon untuk log in:

Logo WordPress.com

You are commenting using your WordPress.com account. Logout / Ubah )

Gambar Twitter

You are commenting using your Twitter account. Logout / Ubah )

Foto Facebook

You are commenting using your Facebook account. Logout / Ubah )

Foto Google+

You are commenting using your Google+ account. Logout / Ubah )

Connecting to %s

%d blogger menyukai ini: