VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "DBC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private m_conn		As ADODB.Connection	' DB接続
Private m_columns	As Collection		' フィールド名を格納
Private m_rows()	As Collection		' 結果レコードを格納
Private m_sql_list	As Collection		' SQL文を格納

'コンストラクタ
Public Sub Class_initialize()
    Set m_conn = New ADODB.Connection

    ' DB接続文字列
    m_conn.ConnectionString = _
        "Provider=SQLOLEDB.1;" & _
        "User ID=[UserID];" & _
        "Password=[Password];" & _
        "Initial Catalog=[DatabaseName];" & _
        "Data Source=[ServerIPAddress];"

    ' 接続時タイムアウト時間
    m_conn.ConnectionTimeout = 5

    ' 実行時タイムアウト時間
    m_conn.CommandTimeout = 60

    ' 接続オープン
    m_conn.Open
End Sub

'デストラクタ
Public Sub Class_Terminate()
    If m_conn.State = 1 Then m_conn.Close
    Set m_conn = Nothing
End Sub

'データベースでSQL文を実行し、結果をdataコレクション配列に蓄積する
Public Function Execute(ByVal sql As String) As Boolean
    Dim rs	As New ADODB.Recordset
    Dim i	As Integer
    Dim row	As Long

On Error GoTo Catch
    m_conn.BeginTrans
    Set rs = cn.Execute(sql)

    'データベースエラーチェック
    If m_conn.Errors.Count > 0 Then
        GoTo Catch
    End If
    
    ReDim m_rows(0)  '一度クリアする
    Set m_columns = New Collection
    row = 0
    Do While Not rs.EOF
        If row = 0 Then
            For i = 0 To rs.Fields.Count - 1
                Call m_columns.Add(rs(i).Name)
            Next i
        End If
        row = row + 1
        ReDim Preserve m_rows(row)
        Set m_rows(row) = New Collection
        For i = 0 To rs.Fields.Count - 1
            Call m_rows(row).Add(rs(i).Value, rs(i).Name)
        Next i
        rs.MoveNext
    Loop
    
    m_conn.CommitTrans
    Execute = True
    GoTo Finally
Catch:
    Execute = False
    If m_conn.State = 1 Then m_conn.RollbackTrans
    MsgBox ("DBC ERROR!" & vbCrLf & Err.Description & vbCrLf & sql)
Finally:
    If rs.State = 1 Then rs.Close: Set rs = Nothing
End Function

Public Function Columns() As Collection
    Set Columns = m_columns
End Function

'現在蓄積しているデータ数を返す
Public Function Count() As Integer
    Count = UBound(m_rows)
End Function

'キーや行数を元に値を返す
Public Function Item(ByVal key As String, Optional ByVal row As Integer = 1) As String

On Error GoTo Catch
    Item = CStr(m_rows(row).Item(key))
    GoTo Finally
Catch:
    Item = ""
Finally:

End Function

'データベースを更新するSQLを蓄積する
Public Function Add(ByVal sql As String)
    If m_sql_list Is Nothing Then
        Set m_sql_list = New Collection
    End If
    Call sql_list.Add(sql)
End Function

'データベースにINSERTまたはUPDATEをかけて変更が起きた行数を返す
Public Function Commit(Optional ByVal sql As String = "") As Integer
    Dim result  As Long
    Dim tmp     As Long
    Dim i       As Integer
    
    If sql <> "" Then
        Call Add(sql)
    End If
    
On Error GoTo Catch
    result = 0
    cn.BeginTrans
    For i = 1 To m_sql_list.Count
        Call m_conn.Execute(m_sql_list(i), tmp) 'tmpは参照
        result = result + tmp

        'データベースエラーチェック
        If m_conn.Errors.Count > 0 Then
            GoTo Catch
        End If
    Next

    m_conn.CommitTrans
    
    GoTo Finally
Catch:
    If m_conn.State = 1 Then m_conn.RollbackTrans
    MsgBox ("DBC ERROR!" & vbCrLf & Err.Description & vbCrLf & sql)
Finally:
    Set m_sql_list = Nothing
    Commit = result
End Function