Private DecCount As Long
Private SubCount As Long
Private FuncCount As Long
Private ConstCount As Long
Private TypeCount As Long
Private Subs() As String
Private Funcs() As String
Private Consts() As String
Private Types() As String
Private Decs() As String
Private TypeData() As String
Private FuncData() As String
Private ConstData() As String
Private SubData() As String
Private DecData() As String
Private Type VBAPIFileVerInfo
Major As Byte
Minor As Byte
Revision As Byte
End Type
Private Type VBAPIFileInfo
Header As String * 5
Version As VBAPIFileVerInfo
SubAnz As Long
FuncAnz As Long
ConstAnz As Long
TypeAnz As Long
End Type
Private Function LoadAPVFile(Datei As String) As Long
m_CurrentFile = Datei
Dim apiFile As Integer, func_c As Long
Dim FileInfo As VBAPIFileInfo, sub_c As Long
Dim i As Long
On Error Goto ErrHandle
apiFile = FreeFile
Open Datei For Binary As apiFile
Get apiFile, 1, FileInfo
With FileInfo
FuncCount = .FuncAnz
DecCount = .FuncAnz + .SubAnz
SubCount = .SubAnz
ConstCount = .ConstAnz
TypeCount = .TypeAnz
If Not (.Version.Major = 2 And .Version.Minor = 0 And _
.Version.Revision = 0) _
And Not (.Version.Major = 1 And _
.Version.Minor = 0 _
And .Version.Revision = 5) Then
MsgBox "Falsches Dateiformat", vbExclamation, m_AppName
Close
Exit Function
End If
End With
If Not ConstCount <= 1 Then
ReDim Consts(ConstCount - 1)
ReDim ConstData(ConstCount - 1)
End If
If Not TypeCount <= 1 Then
ReDim Types(TypeCount - 1)
ReDim TypeData(TypeCount - 1)
End If
If Not DecCount <= 1 Then
ReDim Decs(DecCount - 1)
ReDim DecData(DecCount - 1)
End If
If Not SubCount <= 1 Then
ReDim Subs(SubCount)
ReDim SubData(SubCount)
End If
If Not FuncCount <= 1 Then
ReDim Funcs(FuncCount)
ReDim FuncData(FuncCount)
End If
If Not DecCount = 0 Then
Get apiFile, , Decs()
Get apiFile, , DecData()
End If
If Not TypeCount = 0 Then
Get apiFile, , Types()
Get apiFile, , TypeData()
End If
If Not ConstCount = 0 Then
Get apiFile, , Consts()
Get apiFile, , ConstData()
End If
func_c& = 0
sub_c& = 0
For i& = 0 To DecCount - 1
If Right$(DecData(i&), 1) = ")" Then
Subs(sub_c&) = Decs(i&)
SubData(sub_c&) = DecData(i&)
sub_c& = sub_c& + 1
Else
Funcs(func_c&) = Decs(i&)
FuncData(func_c&) = DecData(i&)
func_c& = func_c& + 1
End If
Next i&
Close apiFile
Exit Function
ErrHandle:
MsgBox "Datei kann nicht geladen werden", vbCritical
LoadAPVFile = Err.Number
End Function |
