'====================================================
'VB6 Access.mdb + DAO を使ったキュークラス
'====================================================
'DAO 3.6 Object Lib を参照設定します
'VBの開発環境でクラスモジュールに Queue という名前で保存します
'c:\log.mdbというファイルを作成し、logTableというテーブルを追加します
'以下のようなテーブルデザインにします
'
'QueueTable : テーブル
'_________________________
'|  ﾌｨｰﾙﾄﾞ名  |  ﾃﾞｰﾀ型  |
'-------------------------
'|    num     |  通貨型  |←キーにしてもよい
'|    data    |  ﾃｷｽﾄ型  |
'-------------------------
'
'使用方法
'-----------------------------------
'値の追加
'Private Sub Command1_Click()
'    Dim obj As New Queue
'    obj.init ("c:\test.mdb")    'キュークラスの初期設定
'    If (obj.getEmpty()) Then    'キューに値があれば
'        Form1.Caption = obj.pop '値の取り出し
'    End If
'    Set obj=Nothing
'End Sub
'-----------------------------------
'値の取り出し
'Private Sub Command2_Click()
'    Dim obj As New Queue
'    obj.init ("c:\test.mdb")    'キュークラスの初期設定
'    obj.push (Text1.Text)       '値を追加する
'    Set obj=Nothing
'End Sub
'-----------------------------------

Option Explicit

Const tableName As String = "QueueTable"
Private filename As String

Dim MyDB As Database

'クラスの初期化
Public Sub init(FilePath As String)
    filename = FilePath
End Sub

'値がたまっているかどうかの確認
Public Function getEmpty() As Boolean
    Call connect
    Dim count As Integer
    count = MyDB.OpenRecordset(tableName).RecordCount  'レコードの総数を出す
    If count = 0 Then getEmpty = False Else getEmpty = True
    Call unconnect
End Function

'値を追加
Public Sub push(data As String)
    Call connect
    '--------------レコードの追加---------------
    Dim num As String
    num = CStr(MaxNo() + 1)
    
    MyDB.Execute "INSERT INTO " & tableName & " (num,data) VALUES ('" & num & "','" & data & "');"

    Call unconnect
End Sub

'値を取り出し
Public Function pop() As String
    Call connect
        
    Dim RecPos As Recordset
    Set RecPos = MyDB.OpenRecordset("SELECT * FROM " & tableName & " WHERE (((num)=(SELECT MIN(num) AS MinNo FROM " & tableName & ")));")
    pop = RecPos![data]
    RecPos.Delete
    RecPos.Close
    Set RecPos = Nothing
    Call unconnect
End Function

'データベースへの接続
Private Sub connect()
    On Error GoTo start
start:
    Set MyDB = OpenDatabase(filename) 'データーベースファイルのオープン、フルパスの指定が必要
    On Error GoTo 0
End Sub

'データベースの切断
Private Sub unconnect()
    MyDB.Close
    Set MyDB = Nothing
End Sub

'現在のTable.numの最大値を返します
Private Function MaxNo() As Currency
    On Error GoTo err
        Dim RecPos As Recordset
        Set RecPos = MyDB.OpenRecordset("SELECT * FROM " & tableName & " WHERE (((num)=(SELECT MAX(num) AS MinNo FROM " & tableName & ")));")
        MaxNo = RecPos![num]
        RecPos.Close
        Set RecPos = Nothing
errEnd:
    On Error GoTo 0
Exit Function
err:
    MaxNo = 0
    GoTo errEnd
End Function