[M_konst]

Предлагаю на рассмотрение читалку сортамента SCAD. Критика и пояснения приветствуются, т.к. не во всех данных еще разобрался (эти поля названы Reserved(n)). Может кто поможет разобраться.
По вопросам нужна она или нет - на ваше усмотрение, но мне нужна.

Код:

[Выделить все]

Option Explicit

Private Type TSCADUnit
    Name As String * 10
    Factor As Single
End Type

Private Type TProfileData
    Caption As String
    Data() As Single
End Type

Private Type TSCADSortament
    SectionID As Byte
    SectionType As String
    ProgramName As String * 9
    DataCount As Byte
    Reserved As Byte
    count As Integer
    Reserved1 As Integer
    Name As String
    Reserved2 As Byte
    Units() As String
    DataCaptions() As String
    Reserved3 As Byte
    SCADDataShow() As Boolean
    Profiles() As TProfileData
End Type

Private Type TSCADSortamentSet
    FileFormat As String * 8 '**PRFL**
    LangCount As Byte
    UnitsCount As Byte
    SortamentCount As Integer
    Reserved As Long
    Reserved1 As Byte
    Reserved2 As Byte
    Reserved3 As Byte
    Reserved4 As Byte
    NU As Single
    Density As Single
    Name As String
    Units() As TSCADUnit
    Sortaments() As TSCADSortament
End Type

Dim SCADSortamentSet As TSCADSortamentSet

Private Sub ReadSCADSortament(Optional FilePath As String = "")
    Dim pS As String
    If FilePath = "" Then
        Dim fB As FileDialog
        Set fB = Application.FileDialog(msoFileDialogOpen)
        With fB
            .Filters.Clear
            .Filters.Add "SCAD sortament", "*.PRF"
            .FilterIndex = 1
            .Show
            If .SelectedItems.count > 0 Then
                pS = .SelectedItems(1)
            End If
        End With
    Else
        pS = FilePath
    End If
    If pS = "" Then Exit Sub
    Dim i As Long, j As Long, k As Long
    Dim aaa As String, bb As Byte
    Open pS For Binary Access Read As #1
        With SCADSortamentSet
            Get #1, , .FileFormat
            If UCase(.FileFormat) <> "**PRFL**" Then
                MsgBox "Invalid file format", vbCritical
                GoTo 1
            End If
            Get #1, , .LangCount
            Get #1, , .UnitsCount
            Get #1, , .SortamentCount
            Get #1, , .Reserved
            Get #1, , .Reserved1
            Get #1, , .Reserved2
            Get #1, , .Reserved3
            Get #1, , .Reserved4
            Get #1, , .NU
            Get #1, , .Density
            Get #1, , bb: .Name = String(bb, " ")
            Get #1, , .Name
            '=== other languages pass
            For i = 1 To .LangCount - 1
                Get #1, , bb: aaa = String(bb, " ")
                Get #1, , aaa
            Next i
            '=============
            ReDim .Units(.UnitsCount - 1)
            For i = 0 To UBound(.Units)
                Get #1, , .Units(i).Name
                Get #1, , .Units(i).Factor
            Next i
            ReDim .Sortaments(.SortamentCount - 1)
            For i = 0 To UBound(.Sortaments)
                With .Sortaments(i)
                    Get #1, , .SectionID
                    .SectionType = GetSectionByID(.SectionID)
                    Get #1, , .ProgramName
                    Get #1, , .DataCount
                    Get #1, , .Reserved
                    Get #1, , .count
                    Get #1, , .Reserved1
                    Get #1, , bb: .Name = String(bb, " ")
                    Get #1, , .Name
                    '=== other languages pass
                    For j = 1 To SCADSortamentSet.LangCount - 1
                        Get #1, , bb: aaa = String(bb, " ")
                        Get #1, , aaa
                    Next j
                    '=============
                    Get #1, , .Reserved2
                    ReDim .Units(.DataCount - 1)
                    .Units(0) = "Profile"
                    ReDim .DataCaptions(.DataCount - 1)
                    .DataCaptions(0) = "Profile"
                    If .DataCount > 1 Then
                        For j = 1 To UBound(.Units)
                            Get #1, , bb
                            .Units(j) = CStr(SCADSortamentSet.Units(bb - 1).Name)
                        Next j
                        For j = 1 To UBound(.DataCaptions)
                            aaa = ""
                            Get #1, , bb
                            Do While bb <> 0
                                aaa = aaa & Chr(bb)
                                Get #1, , bb
                            Loop
                            .DataCaptions(j) = aaa
                        Next j
                    End If
                    Get #1, , .Reserved3
                    ReDim .SCADDataShow(.DataCount - 1)
                    For j = 0 To UBound(.SCADDataShow)
                        Get #1, , bb
                        .SCADDataShow(j) = CBool(bb)
                    Next j
                    ReDim .Profiles(.count - 1)
                    For j = 0 To UBound(.Profiles)
                        Get #1, , bb: aaa = String(bb, " ")
                        Get #1, , aaa
                        .Profiles(j).Caption = CStr(aaa)
                        If .DataCount > 1 Then
                            ReDim .Profiles(j).Data(.DataCount - 1 - 1)
                            For k = 0 To UBound(.Profiles(j).Data)
                                Get #1, , .Profiles(j).Data(k)
                            Next k
                        End If
                    Next j
                End With
            Next i
        End With
1:    Close #1
End Sub

[Кореш]

Offtop: Братан, хорош, давай давай, вперед, контент в кайф, можно еще? Вообще красавчик!

Спасибо, буду ковырять.

[Сергей812]

Offtop:

Сообщение от M_konst Критика и пояснения приветствуются, т.к. не во всех данных еще разобрался (эти поля названы Reserved(n)). Может кто поможет разобраться.

эта раздел "Готовые программы" вроде...)

[M_konst]

Сообщение от Сергей812 эта раздел "Готовые программы" вроде...)

Все верно. Пользоваться то можно, вроде все работает. Просто надо немного допилить.