'====================================================
'VB6 ランダムアクセスファイル を使ったキュークラス
'====================================================
'VisualStudio 6.0 サービスパック6がインストールされてないと
'VBのバグにより実行できない可能性があります。
'開発環境でクラスモジュールに Queue という名前で保存します
'
'値を追加
'Private Sub Command1_Click()
'    Dim obj As New Queue
'    obj.init ("C:\test.txt") 'ファイル名を指定(無ければ新規作成)
'    obj.push ("testData") '終端に値を追加
'    Set obj = Nothing
'End Sub
'
'値の取り出し
'Private Sub Command3_Click()
'    Dim obj As New Queue
'    obj.init ("C:\test.txt") 'ファイル名を指定(無ければ新規作成)
'    If obj.getEmpty Then '値が存在したら
'        MsgBox (obj.front) '先頭の値を取得
'        obj.pop '先頭の値を削除
'    End If
'    Set obj = Nothing
'End Sub
'
'----------------------------------------------
Option Explicit

'値を読み書きする構造体
Private Type ByteData
    byteArr(0 To 1023) As Byte
End Type

Private data As ByteData
Private filenum As Integer
Private filename As String

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

'**********************************************
'値がたまっているかどうかの確認
'**********************************************
Public Function getEmpty() As Boolean
    Call connect
    If MaxNo = 0 Then getEmpty = False Else getEmpty = True
    Call unconnect
End Function

'**********************************************
'終端に値を追加
'**********************************************
Public Sub push(data As String)
    Call connect

    Dim i As Long
    i = MaxNo + 1
    
    Put #filenum, i, toByteData(data)

    Call unconnect
End Sub

'**********************************************
'先頭の値を取り出し
'**********************************************
Public Function front() As String
    Call connect
    '先頭の値を返す
    Get #filenum, 1, data
    
    front = toString(data)
    Call unconnect
End Function

'**********************************************
'先頭の値を削除
'**********************************************
Public Sub pop()
    Call connect
    '値を前に詰める
    Dim i As Long
    For i = 1 To MaxNo - 1
        Get #filenum, i + 1, data
        Put #filenum, i, data
    Next i

    Put #filenum, i, toByteData("")
    Call unconnect
End Sub

'**********************************************
'終端の値を取り出し
'**********************************************
Public Function back() As String
    Call connect
    '先頭の値を返す
    Get #filenum, MaxNo, data
    back = toString(data)
    Call unconnect
End Function

'----------------------------------------------
'接続
'----------------------------------------------
Private Sub connect()
    filenum = FreeFile
    Open filename For Random As #filenum Len = Len(data)
End Sub

'----------------------------------------------
'切断
'----------------------------------------------
Private Sub unconnect()
    Close #filenum
End Sub

'----------------------------------------------
'現在の値の数を返します
'----------------------------------------------
Private Function MaxNo() As Long
    MaxNo = 0
    Dim count As Long
    count = LOF(filenum) / Len(data) '現在のレコ−ド数を計算

    Dim i As Long
    For i = 1 To count
        Get #filenum, i, data
        If Not (toString(data) = "") Then
            MaxNo = i
        Else
            Exit Function
        End If
    Next i
End Function

'----------------------------------------------
'文字列を構造体に変換
'----------------------------------------------
Private Function toByteData(str As String) As ByteData
    Dim bytes() As Byte
    'Shift_jisに変換
    bytes = StrConv(str, vbFromUnicode)
    
    Dim i As Long
    '構造体をスペースで初期化
    For i = 0 To UBound(data.byteArr)
        data.byteArr(i) = AscB(Space(1))
    Next i
    '構造体にバイト配列を複製
    For i = 0 To UBound(bytes)
        data.byteArr(i) = bytes(i)
    Next i
    
    toByteData = data
End Function

'----------------------------------------------
'構造体を文字列に変換
'----------------------------------------------
Private Function toString(ByteDataPos As ByteData) As String
    '構造体から、文字列に変換
    toString = Trim(StrConv(ByteDataPos.byteArr, vbUnicode))
End Function