解析DATASTAGE导出文件dsx和congnos的mdl文件

DS源表和目标表解析：

Option Explicit

Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Const INFINITE = -1&
Public Const SYNCHRONIZE = &H100000
Public PbProjectName As String

Public TmpPath As String


    
Public Sub CreateList()
Dim Str As String
Dim FilePath As String
Dim pSql(2) As String
Dim Filelist, TargetList, SourceList
Dim i, j, k, m, n, s
Dim TestStr

Dim WorkBookName As String, WorkSheetName As String, StartRow As Integer, StartColumn As String, RowNum As Integer, ColumnNum As Integer, ArrContent(50000, 4) As String

TmpPath = ThisWorkbook.Path '存放临时文件的目录
Call ClearOldValue("TMP", "A3:A10000")  '清除临时sheet的数据
Call ClearOldValue("MIS_TABLE_RELATION", "B3:F50000")

FilePath = Workbooks(ThisWorkbook.Name).Worksheets("CONFIG").Cells(3, 3).Value '获取用户数据的路径
If Right(FilePath, 1) <> "\" Then
    FilePath = FilePath + "\"
End If

Str = GetFileList(FilePath) '获取DS文件列表，以回车分隔
Filelist = Split(Str, vbLf)

m = -1
n = -1
PbProjectName = ""
'MsgBox "dsfile:" + Str
'MsgBox CStr(UBound(Filelist))

For i = 0 To UBound(Filelist) - 1
     Call ClearOldValue("TMP", "A3:A3000")
     TestStr = Mid(Filelist(i), InStrRev(Filelist(i), "\") + 1)
     
     Str = GetTarget(CStr(Filelist(i)))
     TargetList = Split(Str, vbLf)
     'Workbooks(ThisWorkbook.Name).Worksheets("TMP").Cells(3, 4).Value = PreProcessStr(Str)
     Str = GetSource(CStr(Filelist(i)))
     SourceList = Split(Str, vbLf)
     
     
     'MsgBox "target:" + Str
     'MsgBox "dsfile:" + Filelist(i)
     n = m + 1
     
     'MsgBox "target:" + CStr(UBound(TargetList))
    'MsgBox "source:" + CStr(UBound(SourceList))
    For j = 0 To UBound(TargetList) - 1
     
        
        
        'MsgBox "ZHOULX:" + Str
        'Workbooks(ThisWorkbook.Name).Worksheets("TMP").Cells(3, 4).Value = Str
        'MsgBox "target:" + TargetList(j)
        
        For k = 0 To UBound(SourceList) - 1
            'MsgBox "source:" + SourceList(k)
            m = n + k + UBound(SourceList) * j
            '(UBound(SourceList) - 1) * (UBound(TargetList) - 1) * i
            ArrContent(m, 0) = PbProjectName
            ArrContent(m, 3) = Mid(Filelist(i), InStrRev(Filelist(i), "\") + 1)
            ArrContent(m, 1) = TargetList(j)
            ArrContent(m, 2) = SourceList(k)
            ArrContent(m, 4) = "请补充备注"
        Next
    Next
Next
       
Call WriteExcel("ThisWorkbook.Name", "MIS_TABLE_RELATION", 3, 2, m + 1, 5, ArrContent())
MsgBox "共生成：" + CStr(m + 1) + "条记录，请补充备注内容，否则会造成生成的SQL异常"
End Sub


Public Function GetSource(FilePath As String) As String

    Dim vStr As String, vStr1 As String, reStr As String
    Dim i, j, k, n, m
    Dim IxCategory
    Dim TableList() As String, AllTableList(1000) As String
    Dim tmpstr As String, tmpstr1 As String
    
    Dim SqlList(100) As String
    m = GetSourceSqlList(FilePath, SqlList)

    n = 0
    k = 0
    For i = 0 To m - 1
         
             '去除/*  */注释
        While InStr(1, SqlList(i), "\\/*") <> 0
            tmpstr = ""
            tmpstr1 = ""
            tmpstr = Left(SqlList(i), InStr(1, SqlList(i), "\\/*") - 1)
            tmpstr1 = Mid(SqlList(i), InStr(1, SqlList(i), "*\\/") + 4)
            SqlList(i) = tmpstr + " " + tmpstr1
        Wend
        
        ' Call WriteFile("D:\DS解析工具V1.1\2.txt", SqlList(i))
        'Workbooks(ThisWorkbook.Name).Worksheets("TMP").Cells(3, 4).Value = PreProcessStr(SqlList(i)) '重要调试
        SqlAnalyse (PreProcessStr(SqlList(i)))
        k = SourceDistinct(TableList)
        For j = 0 To k - 1
            AllTableList(n + j) = TableList(j)
        Next
        n = n + k
    Next
    
    n = Distinct(AllTableList)
    'MsgBox "n:"
    'MsgBox n
    reStr = ""
    For i = 0 To n - 1
       If AllTableList(i) <> "" Then
         reStr = reStr + AllTableList(i) + vbLf
        End If
    Next
    GetSource = reStr
End Function

Public Function GetSourceSqlList(FilePath As String, SqlList() As String) As Integer
    Dim varDsxFile As String, AllFile As String
    Dim varTemp  As Integer
    Dim IxQuery, IxServer
    Dim i, j, k
    AllFile = ""
    Dim FlagA, FlagB
    Dim tmpstr As String, tmpstr1 As String
    
    i = 0
    FlagA = 0
    FlagB = 0
    '按顺序读写记录dsx全路径文件，解析获得源和目标
     Open FilePath For Input As #2
    Do While Not EOF(2)
        Line Input #2, varDsxFile
        
        tmpstr = ""
        tmpstr1 = ""
        
        If FlagA = 0 Then
                If InStr(1, varDsxFile, "-query ") <> 0 Then
                    FlagA = 1
                    SqlList(i) = ""
                End If
        Else
            If InStr(1, varDsxFile, "-server ") <> 0 Or InStr(1, varDsxFile, "-use_strings") <> 0 Then
                FlagA = 0
                i = i + 1
            End If
        End If
        
        If FlagA = 1 Then
                If InStr(1, varDsxFile, "--") <> 0 And (InStr(1, varDsxFile, "--") < InStr(1, varDsxFile, "\\/*") Or InStr(1, varDsxFile, "--") > InStr(1, varDsxFile, "*\\/")) Then
                    varDsxFile = Mid(varDsxFile, 1, InStr(1, varDsxFile, "--") - 1) '去掉SQL中的注释
                End If
                
                'varDsxFile = Replace(Replace(varDsxFile, "[", "("), "]", ")") '特别说明：NParHrmCodedict.dsx中存在这样的情况“[3,6)月”,用于表示是否包含
                'varDsxFile = Replace(Replace(varDsxFile, "\(FF08)", "("), "\(FF09)", ")")  '替换中文的括号
                SqlList(i) = SqlList(i) + " " + varDsxFile

        End If
    Loop
    Close #2
    'MsgBox SqlList(0)
    GetSourceSqlList = i

End Function


Function SqlAnalyse(SQL As String)

    Dim pSql(2) As String
    Dim ixlbracket
    Dim IxFrom, IxWhere, IxOn, IxUnion, IxGroup, IxOrder
    Dim SqlTmp, SqlTmp1 As String
    Dim i
    Dim TableList() As String
    
    pSql(0) = SQL
    ixlbracket = InStr(1, pSql(0), "(")
    i = 0
    While ixlbracket <> 0
    'Workbooks(ThisWorkbook.Name).Worksheets("TMP").Cells(i + 3, 4).Value = pSql(1) '重要调试语句
    i = i + 1
        Call ExtractSubSql(pSql(0), pSql)
        ixlbracket = InStr(1, pSql(0), "(")
        Call SqlAnalyse(pSql(1))
    Wend
    '处理有UNION的情况
    IxUnion = InStr(1, pSql(0), " UNION ")
    'MsgBox IxUnion
    If IxUnion <> 0 Then
        SqlTmp = pSql(0) + " UNION "
        'MsgBox SqlTmp
        While IxUnion <> 0
            SqlTmp1 = Mid(SqlTmp, 1, IxUnion)
            Call GetTableName(SqlTmp1)
            SqlTmp = Mid(SqlTmp, IxUnion + 6)
            IxUnion = InStr(1, SqlTmp, " UNION ")