一个生成COBOL测试数据的小程序——解释数据中的数据类型

上篇说到Explanation，其实这是分析部分的重点，现在就开始说明一下

COBOL的数据格式常用的就那么几种，9、X、BIT、S9COMP3、9COMP，在用上篇的Analysis处理后，数据声明语句就被分割成了下面这种字符串数组的形式

"05","ＸＸＸ号","PIC","S9 COMP-3","3",OCCURS","2","TIMES"

"05","ＸＸＸＸ種別","PIC","X","1","OCCURS","4","TIMES"

"05","あああ","OCCURS","5","TIMES"

"05","いいい","REDEFINES","ＸＸＸ種別"

上面列举了几种比较难分析的数据类型，在COBOL中由于OCCURS关键字的使用，所以分析时还要考虑后面数据的层数。

于是就有了下面的函数

Function FindOccurs()Function FindOccurs(tmpArr) As Long‘查找OCCURS所在的下标
Dim pos As Long
pos = 0
For i = 0 To UBound(tmpArr)
    If tmpArr(i) = "OCCURS" Then pos = i
Next i
FindOccurs = pos
End Function

Function FindDiffLevel()Function FindDiffLevel(startIndex, occLevel)’查找从STARTINDEX开始，层数与STARTINDEX中不一样的层的下标
Dim flag As Boolean
flag = False
i = startIndex
Do While flag = False
    tmpArr = varData(i)
    If tmpArr(0) = occLevel Then
        flag = True
        i = i - 2
    End If
    If i = varData.Count Then
        flag = True
        i = i - 1
    End If
    i = i + 1
Loop
FindDiffLevel = i
End Function

这样就解决了OCCURS的分析，然后在下面的分析中加入对PIC的处理就可以了。再下来就是REDEFINES，这个东西基本上没有分析的必要，所以用FindDiffLevel找到下一组层，直接忽略掉就成。

于是，最终代码出炉

 

Sub Explanation()Sub Explanation()
Dim level, dataName, dataType, DataLong, occLevel As String
Dim occurs, endIndex As Long
On Error Resume Next
ReDim Preserve varDataExpEd(UBound(varDataExpEd) + 1)
Set varDataExpEd(UBound(varDataExpEd)) = New Collection
For i = 1 To varData.Count
    pointIndex = i‘这东西当指针用了
    tmpArr = varData(i)
    Classify tmpArr, i, ""
    i = pointIndex
Next i
End Sub

Sub Classify()Sub Classify(tmpArr, curIndex, suffix)‘其实这才是重点，嘿嘿
Dim level, dataName, dataType, DataLong, occLevel, occPos As String
If UBound(tmpArr) = 1 Then
    level = tmpArr(0)
    dataName = tmpArr(1)
    AddData level, dataName, dataType, DataLong
Else
    If tmpArr(2) = "PIC" Then
        occPos = FindOccurs(tmpArr)
        If occPos <> 0 Then
            occurs = Val(tmpArr(occPos + 1))
            occLevel = tmpArr(0)
            For j = 1 To occurs
                level = tmpArr(0)
                dataName = tmpArr(1) & Str(j)
                dataType = Left(tmpArr(3), InStr(1, tmpArr(3), "(") - 1)
                DataLong = Str(Val(Mid(tmpArr(3), InStr(1, tmpArr(3), "(") + 1, Len(tmpArr(3)) - InStr(1, tmpArr(3), "(") - 1)))
                If occPos <> 4 Then
                    dataType = dataType & " " & tmpArr(4)
                End If
                AddData level, dataName, dataType, DataLong
            Next j
        Else
            level = tmpArr(0)
            dataName = tmpArr(1) & suffix
            dataType = Left(tmpArr(3), InStr(1, tmpArr(3), "(") - 1)
            DataLong = Str(Val(Mid(tmpArr(3), InStr(1, tmpArr(3), "(") + 1, Len(tmpArr(3)) - InStr(1, tmpArr(3), "(") - 1)))
            If UBound(tmpArr) = 4 Then
                dataType = dataType & " " & tmpArr(4)
            End If
            AddData level, dataName, dataType, DataLong
        End If
    Else
        If FindOccurs(tmpArr) = 2 Then
            occurs = Val(tmpArr(3))
            occLevel = tmpArr(0)
            endIndex = FindDiffLevel(curIndex + 1, occLevel)
            For j = 1 To occurs
                For k = curIndex + 1 To endIndex
                    tmpArr1 = varData(k)
                    Classify tmpArr1, k, Trim(Str(j))
                Next k
            Next j
            pointIndex = endIndex
        Else
            If tmpArr(2) = "REDEFINES" Then
                rdfLevel = tmpArr(0)
                endIndex = FindDiffLevel(curIndex + 1, rdfLevel)
                pointIndex = endIndex
            End If
        End If
    End If
End If
End Sub

Sub AddData()Sub AddData(level, dataName, dataType, DataLong)’将处理后的数据放到varDataExpEd里，以便后用
    Dim tmpArr(7) As String
    tmpArr(0) = level
    tmpArr(1) = dataName
    tmpArr(2) = dataType
    tmpArr(3) = DataLong
    tmpArr(4) = "R"
    tmpArr(5) = "R"
    tmpArr(6) = "R"
    "4-From
    "5-To
    "6-Amount of changes
    "7-CurrentValue
    varDataExpEd(UBound(varDataExpEd)).Add tmpArr
End Sub