Строки фиксированной длины в модуле класса

[Ruslan Demidow]

Решил сделать систему закладок в вьювере.
Организовать её хочу через коллекцию.
Принцип таков: в программе все ссылки будут храниться в коллекции.
Элементами коллекции хочу сделать экземпляры класса, т.к. коллекции не поддерживают работу с пользовательскими типами записи.
Элементы класса имеют несколько свойств:

Код: Выделить всё

Public Key As String
Public MarkDate As Date
Public Area As String
Public Comment As String


Но... для сохранения в файл bin мне нужно иметь записи одинаковой длины (для более удобной работы с записями: чтение/запись в файл).
В качестве Key будет использоваться ID сообщения, в качестве MarkDate будет использоваться дата добавления закладки в формате "dd mmm yyyy hh:mm:ss", в качестве Area будет использоваться название конференции (длина 101 байт), в качестве Comment будет использоваться текст комментария введёный пользователем в процессе добавления закладки (максимум 255 байт).
Т.к. все свойства (кроме даты) могут иметь различную длину при добавлении, хочу сделать строки фиксированного размера.
Но если я пишу в модуле класса Public Comment As String * 255 или в любой другой строковой переменной, то VB ругается, что строки фиксированной длины не могут использоваться в модуле класса.
Вопрос: как быть? Может, кто-нибудь посоветует пути решения?

[alibek]

Public Type помоему подойдет

[alibek]

Стой, в модуле или в модуле класса?
Если в модуле класса, то зачем строки фиксированной длины? Организуй не через Public-переменные, а через Public Property.

[Ruslan Demidow]

Стой, в модуле или в модуле класса?

Стою... В модуле класса.

Если в модуле класса, то зачем строки фиксированной длины?

Для приведения всех закладок к одной длине записи.

Организуй не через Public-переменные, а через Public Property.

Уже. Выглядит так:

Код: Выделить всё

Option Explicit

Private m_sComment As String * 255
Private m_sArea As String * 101
Private m_sKey As String * 50
Private m_sMarkDate As String
Private m_dtMarkDate As Date


Public Property Get Comment() As String
    Comment = Trim$(m_sComment)
End Property

Public Property Let Comment(ByVal sComment As String)
    If Len(sComment) >= 255 Then
        sComment = Left(sComment, 255)
    End If
    m_sComment = Trim$(sComment)
End Property

Public Property Get Area() As String
    Area = Trim$(m_sArea)
End Property

Public Property Let Area(ByVal sArea As String)
    If Len(sArea) >= 101 Then
        sArea = Left$(sArea, 101)
    End If
    m_sArea = Trim$(sArea)
End Property

Public Property Get Key() As String
    Key = m_sKey
End Property

Public Property Let Key(ByVal sKey As String)
    If Len(sKey) >= 50 Then
        sKey = Left$(sKey, 50)
    End If
    m_sKey = Trim$(sKey)
End Property

Public Property Get MarkDate() As Date
    MarkDate = m_dtMarkDate
End Property

Public Property Let MarkDate(ByVal dtMarkDate As Date)
    m_dtMarkDate = Format(dtMarkDate, "dd mmm yyyy hh:mm:ss")
End Property


Всё работает. Только вот не возращает длину.

Т.е. делаю:

Код: Выделить всё

    Dim CurBookMark As clsBookMark
    Set CurBookMark = New clsBookMark
    With CurBookMark
        .Area = "Тру-ля-ля"
        .Key = "12345"
        .MarkDate = Now
        .Comment = "Коментарий"
    End With
    Debug.Print Len(CurBookMark)


Недопустимое использование свойства или метода.

[alibek]

Добавь свойство .StructSize
Т.к. класс это объект, а не структура, с него размер не возьмешь.

[Ruslan Demidow]

Добавь свойство .StructSize
Т.к. класс это объект, а не структура, с него размер не возьмешь.

Хорошо, сделал. Спасибо.
А как запихнуть в файл?
Если использую

Код: Выделить всё

Sub SaveBookMarks()
    Dim Fnum As Integer
    Dim i As Integer
    Dim sName As String
    Dim CurBookMark As clsBookMark
    Set CurBookMark = New clsBookMark
    If colBookM.Count = 0 Then Exit Sub
    sName = "Bookmarks.bin"
    Fnum = FreeFile
    Open gAppPath & sName For Binary As Fnum
    For i = 1 To colBookM.Count
        Set CurBookMark = colBookM(i)
        Put #Fnum, , CurBookMark
    Next
    Close Fnum
End Sub



Ругается на то что нельзя с помощью Put сохранять ссылку на объект.
Я не пойму, я же сохраняю объект. Почему ссылка? Мне нужно-то сохранить экземляр класса как одну целую запись.
Где-то туплю?

[GSerg]

Ээээ, батенька
Сериализацией занимаешься?

Для этого нуно объявить класс в activex dll и присвоить ему в дизайнере проперть persistable=true. Да ещё и реакцию на появившиеся события предусмотреть

Если не хочешь, то напиши в модуле две функции: save да load. Пусть они принимают параметром класс и сохраняют. Формат сам придумывай, но сохранять и считывать придётся по пропертям, по отдельности.

[Ruslan Demidow]

Ээээ, батенька
Сериализацией занимаешься?

В смысле? Я не понял.

Для этого нуно объявить класс в activex dll и присвоить ему в дизайнере проперть persistable=true. Да ещё и реакцию на появившиеся события предусмотреть
Если не хочешь, то напиши в модуле две функции: save да load. Пусть они принимают параметром класс и сохраняют. Формат сам придумывай, но сохранять и считывать придётся по пропертям, по отдельности.

Сделал по второму варианту: отдельно Save и отдельно Load. В модуле формы объявил тип записи по структуре такой же как и класс.
А в процедурах использую этот тип как промежуточный при сохранении и чтении. В общем использую как прокладку.

Код: Выделить всё


Private Bookmark As clsBookMark
Private Type BkMrk
        m_sComment As String * 255
        m_sArea As String * 101
        m_sKey As String * 50
        m_dtMarkDate As Date
        m_iStructLen As Integer
        End Type
Private Const BookMarkFileName = "Bookmarks.bin"
Option Explicit

Sub SaveBookMarks(ByVal sFileName As String)
    Dim Fnum As Integer
    Dim i As Integer
    Dim sName As String
    Dim CurBookMark As clsBookMark
    Dim BM As BkMrk

    If blnIniOnlyRead Then Exit Sub
    If colBookM.Count = 0 Then Exit Sub

    Set CurBookMark = New clsBookMark
    If bFileExist(gAppPath & BookMarkFileName) Then
        FSO.deletefile gAppPath & BookMarkFileName, True
    End If
    On Error GoTo ErrSub
    Fnum = FreeFile
    Open sFileName For Binary As Fnum Len = CurBookMark.StructLen
    For i = 1 To colBookM.Count
        Set CurBookMark = colBookM(i)
        With CurBookMark
            BM.m_dtMarkDate = .MarkDate
            BM.m_iStructLen = .StructLen
            BM.m_sArea = .Area
            BM.m_sComment = .Comment
            BM.m_sKey = .Key
        End With
        Put #Fnum, , BM
    Next
    Close Fnum
    Exit Sub
ErrSub:
    MsgBox "Ошибка записи в файл: " & vbCrLf & sFileName, vbCritical + vbOKOnly
End Sub

Sub LoadBookmarks(ByVal sFileName As String)
    Dim Fnum As Integer
    Dim i As Integer
    Dim Fil As Object
    Dim FileSize As Long
    Dim CurRow As Long
    Dim CurBookMark As clsBookMark
    Dim BM As BkMrk

    Set CurBookMark = New clsBookMark
    Set colBookM = Nothing
    Fnum = FreeFile
    Set Fil = FSO.getfile(sFileName)
    FileSize = Fil.Size
    If FileSize = 0 Then Exit Sub
    Open sFileName For Binary As Fnum Len = CurBookMark.StructLen
    For i = 1 To FileSize / CurBookMark.StructLen
        Get #Fnum, , BM
        On Error Resume Next
        With CurBookMark
            .MarkDate = Format(BM.m_dtMarkDate, "dd mmm yyyy hh:mm:ss")
            .Area = BM.m_sArea
            .Comment = BM.m_sComment
            .Key = BM.m_sKey
        End With
       
        colBookM.Add CurBookMark, Trim$(CurBookMark.Key)
            With vbaBookMarkGrid
                CurRow = .Rows + 1
                .CellDetails CurRow, .ColumnIndex("Date"), CurBookMark.MarkDate, DT_LEFT
                .CellDetails CurRow, .ColumnIndex("Area"), Trim$(CurBookMark.Area), DT_LEFT
                .CellDetails CurRow, .ColumnIndex("Comment"), Trim$(CurBookMark.Comment), DT_LEFT
                .CellDetails CurRow, .ColumnIndex("Key"), Trim$(CurBookMark.Key), DT_LEFT
                .AutoHeightRow CurRow
                .AutoWidthColumn ("Date")
                .AutoWidthColumn ("Area")
                .AutoWidthColumn ("Comment")
                .SetHeaders
                .Redraw = True
            End With
    Next i
    Close Fnum
End Sub


Много "воды", конечно, но работает.
А вообще я думал, что экземпляр класса в файл сохранить так же легко как и пользовательский тип записи.

Спасибо за помощь.

[alibek]

А вообще я думал, что экземпляр класса в файл сохранить так же легко как и пользовательский тип записи.

Ну... Мечтать не вредно

[Ruslan Demidow]

Чего-то у меня не получается. Где-то ошибка, а отловить никак не могу.
При открытии формы я загружаю закладки, при закрытии записываю.
Так вот, при первом открытии - список закладок пуст. Добавляем закладки. Закрываем форму. При закрытии закладки сохраняются. Всё нормально.
При следующем открытии формы закладки загружаются - тут тоже всё нормально. НО.... если теперь закрыть форму - то все закладки становятся одинаковыми (равными последней закладке).
Т.е. при закрытии формы с загруженными закладками вся коллекция оказывается забитой одной и той же закладкой (последней добавленной).
Уже пол-часа сижу, смотрю в код и никак не могу найти где ошибка. Может быть кто-нибудь свежим взглядом увидит?

Код: Выделить всё

Private Bookmark As clsBookMark
Private Type BkMrk
        m_sComment As String * 255
        m_sArea As String * 101
        m_sKey As String * 50
        m_dtMarkDate As Date
        m_iStructLen As Integer
        End Type
Private Const BookMarkFileName = "Bookmarks.bin"
Private colBookM As New Collection


Option Explicit

Sub SaveBookMarks(ByVal sFileName As String)
    Dim Fnum As Integer
    Dim i As Integer
    Dim sName As String
    Dim CurBookMark As New clsBookMark
    Dim BM As BkMrk
    If blnIniOnlyRead Then Exit Sub
   
    If colBookM.Count = 0 Then Exit Sub
   
    For Each CurBookMark In colBookM
        Debug.Print CurBookMark.Comment
    Next
    If bFileExist(gAppPath & BookMarkFileName) Then
        FSO.deletefile gAppPath & BookMarkFileName, True
    End If
    Fnum = FreeFile
    Open sFileName For Binary As Fnum
    For i = 1 To colBookM.Count
        Set CurBookMark = colBookM(i)
        With BM
            .m_dtMarkDate = Format(colBookM(i).MarkDate, "dd mmm yyyy hh:mm:ss")
            .m_iStructLen = colBookM(i).StructLen
            .m_sArea = colBookM(i).Area
            .m_sComment = colBookM(i).Comment
            .m_sKey = colBookM(i).Key
        End With
        Put #Fnum, , BM
        Set CurBookMark = Nothing
    Next
    Close Fnum
    Exit Sub
ErrSub:
    MsgBox "Ошибка записи в файл: " & vbCrLf & sFileName, vbCritical + vbOKOnly
End Sub

Sub LoadBookmarks(ByVal sFileName As String)
    Dim Fnum As Integer
    Dim i As Integer
    Dim Fil As Object
    Dim FileSize As Long
    Dim CurRow As Long
    Dim CurBookMark As clsBookMark
    Dim BM As BkMrk
    Set CurBookMark = New clsBookMark
    Call ClearColBookM
    Fnum = FreeFile
    Set Fil = FSO.getfile(sFileName)
    FileSize = Fil.Size
    If FileSize = 0 Then Exit Sub
    Open sFileName For Binary As Fnum Len = CurBookMark.StructLen
    For i = 1 To FileSize / CurBookMark.StructLen
        Get #Fnum, , BM
        With CurBookMark
            .MarkDate = Format(BM.m_dtMarkDate, "dd mmm yyyy hh:mm:ss")
            .Area = BM.m_sArea
            .Comment = BM.m_sComment
            .Key = BM.m_sKey
        End With
       
        colBookM.Add CurBookMark, Trim$(CurBookMark.Key)
            With vbaBookMarkGrid
                CurRow = .Rows + 1
                .CellDetails CurRow, .ColumnIndex("Date"), CurBookMark.MarkDate, DT_LEFT
                .CellDetails CurRow, .ColumnIndex("Area"), Trim$(CurBookMark.Area), DT_LEFT
                .CellDetails CurRow, .ColumnIndex("Comment"), Trim$(CurBookMark.Comment), DT_LEFT
                .CellDetails CurRow, .ColumnIndex("Key"), Trim$(CurBookMark.Key), DT_LEFT
                .AutoHeightRow CurRow
                .AutoWidthColumn ("Date")
                .AutoWidthColumn ("Area")
                .AutoWidthColumn ("Comment")
                .SetHeaders
                .Redraw = True
            End With
    Next i
    Set Fil = Nothing
    Set CurBookMark = Nothing
    Close Fnum
End Sub
Private Sub ClearColBookM()
    While colBookM.Count > 0
        colBookM.Remove (colBookM.Count)
    Wend
End Sub


[Ruslan Demidow]

Всё, разобрался сам.
Теперь можно тред считать закрытым.

[ANDLL]

Кстати, тут один писал. На эту тему полезную ссылочку
http://dt0.danasoft.ru/index2.html...

[Ruslan Demidow]

Кстати, тут один писал. На эту тему полезную ссылочку
http://dt0.danasoft.ru/index2.html...

Спасибо конечно за ссылочку - интересно, но зачем прикручивать XML да ещё и с библиотекой, если всё нормально решается тремя процедурами?
Но всё равно спасибо.

[tyomitch]

А вообще я думал, что экземпляр класса в файл сохранить так же легко как и пользовательский тип записи.

Ну... Мечтать не вредно

Да нет, именно так легко всё и есть с ReadProperties/WriteProperties...

Ruslan, а почему ты дату хранишь в виде строки? Чем стандартный тип Date тебя не устроил?

[alibek]

tyomitch, мы с PropBag разговариваем на разных языках и друг друга понимаем плохо
Покажи, как можно сохранять проперти во внешний файл?

[tyomitch]

Примерно так:

Код: Выделить всё

Dim PropBag As PropertyBag
PropBag.WriteProperty "Root", Any_Persistable_Object
Put #1, 1, PropBag.Contents

Dim Buffer As String: Get #1, 1, Buffer
PropBag.Contents = Buffer
Set New_Persistable_Object = PropBag.ReadProperty("Root")


[alibek]

Хм... Прикольно

[Ruslan Demidow]

А вообще я думал, что экземпляр класса в файл сохранить так же легко как и пользовательский тип записи.

Ну... Мечтать не вредно

Да нет, именно так легко всё и есть с ReadProperties/WriteProperties...

Ruslan, а почему ты дату хранишь в виде строки? Чем стандартный тип Date тебя не устроил?

Уже переделал на Date.