解析DATASTAGE导出文件dsx和congnos的mdl文件
2024-05-11 23:30:27
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 ")
Wend
Else
'Workbooks(ThisWorkbook.Name).Worksheets("TMP").Cells(3, 4).Value = pSql(0)
Call GetTableName(pSql(0))
End If
End Function
Function GetTableName(Str As String)
Dim IxFrom, IxWhere, IxOn, IxUnion, IxGroup, IxOrder
Dim SqlTmp, SqlTmp1
Dim i, j, k, IsSame
Dim TableList, vEndRowNumb
SqlTmp1 = Str
IxFrom = InStr(1, SqlTmp1, " FROM ")
IxWhere = InStr(1, SqlTmp1, " WHERE ")
IxGroup = InStr(1, SqlTmp1, " GROUP ")
IxOrder = InStr(1, SqlTmp1, " ORDER ")
If IxWhere = 0 Then
If IxGroup = 0 Then
If IxOrder = 0 Then
i = Len(SqlTmp1)
Else
i = IxOrder
End If
Else
i = IxGroup
End If
Else
i = IxWhere
End If
If IxFrom <> 0 Then
SqlTmp1 = Mid(SqlTmp1, IxFrom + 5, i - IxFrom - 4)
'Workbooks(ThisWorkbook.Name).Worksheets("TMP").Cells(3, 4).Value = SqlTmp1
TableList = Split(SqlTmp1, ",")
vEndRowNumb = Workbooks(ThisWorkbook.Name).Worksheets("TMP").Range("A65536").End(xlUp).Row
'MsgBox vEndRowNumb
j = 0
For i = 0 To UBound(TableList)
TableList(i) = Trim(TableList(i))
If InStr(1, TableList(i), "=") = 0 And TableList(i) <> "" Then
If InStr(1, TableList(i), " ") <> 0 Then
TableList(i) = Mid(TableList(i), 1, InStr(1, TableList(i), " ") - 1)
End If
'tablelist(i) = Mid(tablelist(i), InStr(1, tablelist(i), ".") + 1)'删除表属主
If Replace(CStr(TableList(i)), "'", "") <> "ZHOULIXIN545" And Replace(CStr(TableList(i)), "'", "") <> "DUAL" Then
TableList(i) = Replace(CStr(TableList(i)), "'", "")
TableList(i) = Replace(CStr(TableList(i)), "}", "")
Workbooks(ThisWorkbook.Name).Worksheets("TMP").Cells(j + vEndRowNumb + 1, 1).Value = TableList(i)
j = j + 1
End If
End If
Next
End If
End Function
Public Function GetTargetCategory(FilePath As String) As String
Dim varDsxFile As String
Dim IxCategory
Dim i, n
Dim TableList(100) As String, reStr As String
Dim tmpstr As String
i = 0
'按顺序读写记录dsx全路径文件，解析获得源和目标
Open FilePath For Input As #2
Do While Not EOF(2)
Line Input #2, varDsxFile
'varDsxFile = PreProcessStr(varDsxFile)
'工程名称
If InStr(varDsxFile, " ToolInstanceID ") <> 0 Then
tmpstr = Mid(varDsxFile, InStr(varDsxFile, " ToolInstanceID ") + 17)
PbProjectName = Mid(tmpstr, 1, InStr(1, tmpstr, Chr(34)) - 1)
End If
IxCategory = InStr(varDsxFile, " Category ")
If IxCategory <> 0 Then
varDsxFile = Mid(varDsxFile, IxCategory + 11)
TableList(i) = Mid(varDsxFile, 1, InStr(1, varDsxFile, Chr(34)) - 1)
i = i + 1
End If
Loop
Close #2
n = Distinct(TableList)
'MsgBox n
reStr = ""
For i = 0 To n - 1
If TableList(i) <> "" Then
reStr = reStr + TableList(i) + vbLf
End If
Next
GetTarget = reStr
End Function
Public Function GetTarget(FilePath As String) As String
Dim varDsxFile As String
Dim IxCategory
Dim i, n
Dim TableList(100) As String, reStr As String
Dim tmpstr As String
Dim FlagA
i = 0
reStr = ""
FlagA = 0
'按顺序读写记录dsx全路径文件，解析获得源和目标
Open FilePath For Input As #2
Do While Not EOF(2)
Line Input #2, varDsxFile
'工程名称
If InStr(varDsxFile, " ToolInstanceID ") <> 0 Then
PbProjectName = Mid(varDsxFile, InStr(varDsxFile, " ToolInstanceID ") + 17)
PbProjectName = Mid(PbProjectName, 1, InStr(1, PbProjectName, Chr(34)) - 1)
End If
'If FlagA = 0 Then
If (InStr(1, varDsxFile, "-insert ") <> 0 Or InStr(1, varDsxFile, "-update ") <> 0) Then
FlagA = 1
tmpstr = ""
'tmpstr = tmpstr + " " + UCase(varDsxFile)
varDsxFile = Mid(varDsxFile, 8)
End If
'End If
If FlagA = 1 Then
tmpstr = tmpstr + " " + UCase(varDsxFile) + " "
If InStr(1, tmpstr, " VALUES ") <> 0 Or InStr(1, tmpstr, " SET ") <> 0 Then
'tmpstr = UCase(tmpstr)
'tmpstr = Application.WorksheetFunction.Substitute(tmpstr, Chr(10), "")
'tmpstr = Application.WorksheetFunction.Substitute(tmpstr, Chr(13), "")
If InStr(1, tmpstr, " INTO ") <> 0 Then
TableList(i) = Mid(tmpstr, InStr(1, tmpstr, " INTO ") + 5)
TableList(i) = LTrim(TableList(i))
TableList(i) = Left(TableList(i), InStr(1, TableList(i), " ") - 1)
i = i + 1
Else
If InStr(1, tmpstr, "UPDATE ") <> 0 Then
TableList(i) = Mid(tmpstr, InStr(1, tmpstr, "UPDATE ") + 7)
TableList(i) = LTrim(TableList(i))
TableList(i) = Left(TableList(i), InStr(1, TableList(i), " ") - 1)
i = i + 1
End If
End If
'tmpstr = ""
FlagA = 0
End If
End If
Loop
Close #2
n = Distinct(TableList)
'MsgBox "b"
'MsgBox n
reStr = ""
For i = 0 To n - 1
If TableList(i) <> "" Then
reStr = reStr + TableList(i) + vbLf
End If
Next
GetTarget = reStr
End Function
Function GetFileList(FilePath As String) As String
Dim Filelist
Dim i As Long, p As Long, r As Long
Dim varBatName As String, varFileList As String, varBatStr As String
Dim varStrDir As String
Dim varStrFind1 As String
Dim varStrFind2 As String
Dim varStrFind3 As String
Dim varStrFind4 As String
Dim varStrFind5 As String
Dim varStrFind6 As String
Dim varStrFind7 As String
Dim varStrFind8 As String
'筛选DS文件名
varStrDir = "dir " + FilePath + " /S /B "
varStrFind1 = " | find " + Chr(34) + ".dsx" + Chr(34)
'varStrFind2 = " | find " + Chr(34) + "\Olap" + Chr(34)
'varStrFind3 = " | find /I /V" + Chr(34) + "初始化JOB作业" + Chr(34)
varStrFind4 = " | find /I /V" + Chr(34) + "Before.dsx" + Chr(34)
varStrFind5 = " | find /I /V" + Chr(34) + "Del.dsx" + Chr(34)
'varStrFind6 = " | find /I " + Chr(34) + "\NOds" + Chr(34)
varStrFind7 = " | find /I /V" + Chr(34) + "EndJob.dsx" + Chr(34)
'varStrFind8 = " | find /I /V" + Chr(34) + "NOlapPaolap" + Chr(34)
'bat脚本名称
varBatName = TmpPath + "\" + "GetDsFileName" + ".bat"
'文件列表名称
varFileList = TmpPath + "\" + "FileList" + ".txt"
'bat脚本内容
varBatStr = "@echo off" + vbCrLf + "cd " + FilePath + vbCrLf + varStrDir + varStrFind1 + varStrFind2 + varStrFind3 + varStrFind4 + varStrFind5 + varStrFind6 + varStrFind7 + varStrFind8 + " > " + varFileList
Call WriteFile(varBatName, varBatStr)
i = Shell(varBatName, 1) '执行bat
p = OpenProcess(SYNCHRONIZE, False, i) '等待
r = WaitForSingleObject(p, INFINITE)
r = CloseHandle(p)
GetFileList = ReadFileVblf(TmpPath + "\" + "FileList" + ".txt")
End Function
Function PreProcessStr(Str As String) As String
Dim vStr As String
Dim tmpstr As String, tmpstr1 As String
vStr = Str
'MsgBox vStr
'MsgBox vStr
'MsgBox InStr(1, vStr, "[&SourceDataOwner].")
vStr = Replace(vStr, Chr(9), " ")
'解决这种情况：FROM N_BAS_LBS_PREM_INFO T1,\(A)N_BAS_LA_POLICY_NETS T2
vStr = Replace(vStr, "\(A)", " ")
vStr = Replace(vStr, "\(D)", " ")
'解决这种情况：substr(CAMP,2,instr(CAMP,\\')\\')-2) AS CAMP_ID
vStr = Replace(vStr, ",\\')\\'", " ")
vStr = Replace(vStr, ",\\'(\\'", " ")
vStr = Replace(vStr, "[&IncEnd]", " ")
vStr = Replace(vStr, "[&IncStart]", " ")
'解决这种情况：FROM [&SourceDataOwner].N_BAS_PC_LST_CONT_CALL_RESULT
vStr = Replace(vStr, "[&SourceDataOwner].", " ")
vStr = Replace(vStr, "[&TargetDataOwner].", " ")
vStr = Replace(Replace(vStr, "[", "("), "]", ")") '特别说明：NParHrmCodedict.dsx中存在这样的情况“[3,6)月”,用于表示是否包含
vStr = Replace(Replace(vStr, "\(FF08)", "("), "\(FF09)", ")") '替换中文的括号
vStr = UCase(vStr)
'MsgBox vStr
vStr = Replace(vStr, " OUTER ", " ")
vStr = Replace(vStr, " INNER ", " ")
vStr = Replace(vStr, " LEFT ", " ")
vStr = Replace(vStr, " RIGHT ", " ")
vStr = Replace(vStr, " ALL ", " ")
vStr = Replace(vStr, " JOIN ", " , ")
vStr = Replace(vStr, " ON ", " , ")
PreProcessStr = vStr
End Function
Function ExtractSubSql(SQL As String, vsql() As String)
Dim ixlbracket, IxRBracket, IxLBracketTmp, IxRBracketTmp
Dim vStrLen, vSubSql
SQL = Trim(SQL)
vStrLen = Len(SQL)
ixlbracket = InStr(1, SQL, "(")
IxLBracketTmp = ixlbracket
IxRBracket = InStr(1, SQL, ")")
IxRBracketTmp = IxRBracket
IxLBracketTmp = InStr(IxLBracketTmp + 1, SQL, "(")
While IxLBracketTmp < IxRBracket And IxLBracketTmp <> 0
IxLBracketTmp = InStr(IxLBracketTmp + 1, SQL, "(")
IxRBracket = InStr(IxRBracket + 1, SQL, ")")
Wend
If ixlbracket = 1 And IxRBracket = vStrLen Then
SQL = Mid(SQL, 2, vStrLen - 2)
vSubSql = SQL
SQL = "ZHOULIXIN545"
Else
'Workbooks(ThisWorkbook.Name).Worksheets("TMP").Cells(3, 3).Value = SQL '重要调试
'Call WriteFile("D:\DS解析工具V1.1\1.txt", SQL)
vSubSql = Mid(SQL, ixlbracket + 1, IxRBracket - ixlbracket - 1)
SQL = Left(SQL, ixlbracket - 1) + " ZHOULIXIN545 " + Right(SQL, vStrLen - IxRBracket)
End If
vsql(0) = SQL
vsql(1) = vSubSql
ExtractSubSql = vsql()
End Function
Function SourceDistinct(TableList() As String) As Integer
Dim vStartRowNumb, vEndRowNumb, vRowCount
Dim i, j, k, IsSame
vStartRowNumb = Workbooks(ThisWorkbook.Name).Worksheets("TMP").Range("A1").End(xlDown).Row
vEndRowNumb = Workbooks(ThisWorkbook.Name).Worksheets("TMP").Range("A65536").End(xlUp).Row
vRowCount = vEndRowNumb - vStartRowNumb + 1
ReDim TableList(vRowCount)
For i = 0 To vRowCount - 1
TableList(i) = Workbooks(ThisWorkbook.Name).Worksheets("TMP").Cells(i + 3, 1).Value
Next i
j = 0
For i = 1 To UBound(TableList)
IsSame = 0
For k = 0 To j
If TableList(i) = TableList(k) Then
IsSame = 1
End If
Next
If IsSame <> 1 Then
j = j + 1
TableList(j) = TableList(i)
End If
Next
SourceDistinct = j
End Function
cognos的mdl解析：
Public Sub mdl()
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, 6) As String
TmpPath = ThisWorkbook.Path '存放临时文件的目录
Call ClearOldValue("TMP", "A3:A10000") '清除临时sheet的数据
Call ClearOldValue("MIS_REPORT_TABLE_RELATION", "B3:G50000")
FilePath = Workbooks(ThisWorkbook.Name).Worksheets("CONFIG").Cells(3, 3).Value '获取用户数据的路径
If Right(FilePath, 1) <> "\" Then
FilePath = FilePath + "\"
End If
Str = GetMdlFileList(FilePath) '获取DS文件列表，以回车分隔
Filelist = Split(Str, vbLf)
m = -1
For i = 0 To UBound(Filelist) - 1
Call ClearOldValue("TMP", "A3:A3000")
TestStr = Mid(Filelist(i), InStrRev(Filelist(i), "\") + 1)
Str = GetMdlSource(CStr(Filelist(i)))
SourceList = Split(Str, vbLf)
For k = 0 To UBound(SourceList) - 1
m = m + 1
ArrContent(m, 0) = "请自己补充"
ArrContent(m, 1) = SourceList(k)
ArrContent(m, 2) = "分析"
ArrContent(m, 3) = Mid(Filelist(i), InStrRev(Filelist(i), "\") + 1)
ArrContent(m, 4) = "请自己补充"
ArrContent(m, 5) = "请自己补充"
Next
Next
Call WriteExcel("ThisWorkbook.Name", "MIS_REPORT_TABLE_RELATION", 3, 2, m + 1, 6, ArrContent())
MsgBox "MIS_REPORT_TABLE_RELATION中共生成：" + CStr(m + 1) + "条记录，请补充备注内容，否则会造成生成的SQL异常"
End Sub
Public Function GetIqdSqlList(FilePath As String, SqlList() As String) As Integer
Dim FileLine As String, MdlLine As String
Dim i, j, FlagA, FlagB
j = -1
FlagA = 0
FlagB = 0
MdlLine = ""
'按顺序读写记录dsx全路径文件，解析获得源和目标
Open FilePath For Input As #2
Do While Not EOF(2)
Line Input #2, FileLine
'If FileLine = Chr(34) + "to_char(trunc(sysdate,'dd'),'yyyymmdd') and T1.NC_FREQ = '4')" Then
'FileLine = FileLine
'End If
If FlagA = 0 Then
If InStr(1, FileLine, "SQL ") <> 0 Then
FlagA = 1
j = j + 1
SqlList(j) = ""
FileLine = Mid(FileLine, InStr(1, FileLine, "SQL ") + 6)
End If
End If
If FlagA = 1 Then
'If InStr(1, MdlLine, "}") <> 0 Then
If InStr(1, FileLine, "Isolation ") = 0 Then
If InStrRev(FileLine, Chr(34) + " ") = Len(FileLine) - 1 And InStrRev(FileLine, Chr(34) + " ") <> 0 Then
FlagB = 1
Else
FlagB = 0
End If
Else
FlagB = 0
FileLine = Mid(FileLine, 1, InStr(1, FileLine, "Isolation ") - 1)
FlagA = 0
End If
MdlLine = MdlLine + FileLine
If FlagB = 0 Then
If InStr(1, MdlLine, "--") <> 0 And (InStr(1, MdlLine, "--") < InStr(1, MdlLine, "\\/*") Or InStr(1, MdlLine, "--") > InStr(1, MdlLine, "*\\/")) Then
MdlLine = Mid(MdlLine, 1, InStr(1, MdlLine, "--") - 1) '去掉SQL中的注释
End If
SqlList(j) = SqlList(j) + " " + MdlLine
MdlLine = ""
End If
End If
Loop
Close #2
'MsgBox SqlList(0)
For i = 0 To j
SqlList(i) = PreProcSql(SqlList(i))
'去除/* */注释
While InStr(1, SqlList(i), "\\/*") <> 0
SqlList(i) = Left(SqlList(i), InStr(1, SqlList(i), "\\/*") - 1) + " " + Mid(SqlList(i), InStr(1, SqlList(i), "*\\/") + 4)
Wend
'Workbooks(ThisWorkbook.Name).Worksheets("TMP").Cells(i + 1, 4).Value = PreProcessStr(SqlList(i)) '重要调试
Next
GetIqdSqlList = i
End Function
Function PreProcSql(Str As String) As String
Dim vStr As String
vStr = Str
'MsgBox vStr
'MsgBox vStr
'MsgBox InStr(1, vStr, "[&SourceDataOwner].")
vStr = Replace(vStr, Chr(9), " ")
vStr = Replace(vStr, Chr(34) + " " + Chr(34), "")
vStr = Replace(vStr, Chr(34) + Chr(34), "")
vStr = UCase(vStr)
'MsgBox vStr
vStr = Replace(vStr, " FULL ", " ")
vStr = Replace(vStr, " OUTER ", " ")
vStr = Replace(vStr, " INNER ", " ")
vStr = Replace(vStr, " LEFT ", " ")
vStr = Replace(vStr, " RIGHT ", " ")
vStr = Replace(vStr, " ALL ", " ")
vStr = Replace(vStr, " JOIN ", " , ")
vStr = Replace(vStr, " ON ", " , ")
PreProcSql = vStr
End Function
Public Function GetMdlSource(FilePath As String) As String
Dim reStr As String
Dim i, j, k, n, m
Dim TableList() As String, AllTableList(1000) As String
Dim SqlList(100) As String
m = GetIqdSqlList(FilePath, SqlList)
n = 0
k = 0
For i = 0 To m - 1
SqlAnalyse (SqlList(i))
k = SourceDistinct(TableList)
For j = 0 To k - 1
AllTableList(n + j) = TableList(j)
Next
n = n + k
Next
n = Distinct(AllTableList)
reStr = ""
For i = 0 To n - 1
If AllTableList(i) <> "" Then
reStr = reStr + AllTableList(i) + vbLf
End If
Next
GetMdlSource = reStr
End Function
Public Function GetMdlTarget(FilePath As String) As String
Dim MdmLine As String
Dim IxCube
Dim i, n
Dim TableList(100) As String, reStr As String
Dim tmpstr As String
i = 0
'按顺序读写记录dsx全路径文件，解析获得源和目标
Open FilePath For Input As #2
Do While Not EOF(2)
Line Input #2, MdmLine
IxCube = InStr(MdmLine, "Cube ")
If IxCube = 1 Then
MdmLine = Mid(MdmLine, InStr(1, MdmLine, Chr(34)) + 1)
TableList(i) = Mid(MdmLine, 1, InStr(1, MdmLine, Chr(34)) - 1)
i = i + 1
End If
Loop
Close #2
n = Distinct(TableList)
reStr = ""
For i = 0 To n - 1
If TableList(i) <> "" Then
reStr = reStr + TableList(i) + vbLf
End If
Next
GetMdlTarget = reStr
End Function
Function GetMdlFileList(FilePath As String) As String
Dim Filelist
Dim i As Long, p As Long, r As Long
Dim varBatName As String, varFileList As String, varBatStr As String
Dim varStrDir As String
Dim varStrFind1 As String
'筛选DS文件名
varStrDir = "dir " + FilePath + " /S /B "
varStrFind1 = " | find " + Chr(34) + ".mdl" + Chr(34)
'bat脚本名称
varBatName = TmpPath + "\" + "GetMdlFileName" + ".bat"
'文件列表名称
varFileList = TmpPath + "\" + "MdlFileList" + ".txt"
'bat脚本内容
varBatStr = "@echo off" + vbCrLf + "cd " + FilePath + vbCrLf + varStrDir + varStrFind1 + " > " + varFileList
Call WriteFile(varBatName, varBatStr)
i = Shell(varBatName, 1) '执行bat
p = OpenProcess(SYNCHRONIZE, False, i) '等待
r = WaitForSingleObject(p, INFINITE)
r = CloseHandle(p)
GetMdlFileList = ReadFileVblf(varFileList)
End Function
生成INSERT语句：
Sub CreateInsert()
Dim vTableName As String
vTableName = "MIS_REPORT_TABLE_RELATION"
Call CreateSqlFile(vTableName)
vTableName = "MIS_TABLE_RELATION"
Call CreateSqlFile(vTableName)
End Sub
Function CreateSqlFile(vTableName As String) As String
Dim iRows, iColumns
Dim vStartRowNumb, vEndRowNumb, vStartColumnNumb, vEndColumnNumb
Dim vInsertSql As String
Dim FileName As String
Dim vUM As String
Dim Flag
Dim tmpstr As String
vUM = Worksheets("CONFIG").Cells(2, 3)
FileName = ThisWorkbook.Path + "\" + vTableName + "_" + vUM + "_" + Replace(CStr(Date), "-", "") + ".SQL"
MsgBox "录入人为：" + vUM
vStartRowNumb = Worksheets(vTableName).Range("C1").End(xlDown).Row
vEndRowNumb = Worksheets(vTableName).Range("C65536").End(xlUp).Row
vStartColumnNumb = Worksheets(vTableName).Range("A2").End(xlToRight).Column
vEndColumnNumb = Worksheets(vTableName).Range("Z2").End(xlToLeft).Column
iRows = vEndRowNumb - vStartRowNumb
iColumns = vEndColumnNumb - vStartColumnNumb + 1
'MsgBox (iRows)
'MsgBox (iColumns)
'MsgBox (vEndRowNumb)
'MsgBox (vStartRowNumb)
'MsgBox (FileName)
vInsertSql = ""
Flag = 0
tmpstr = "insert into " + vTableName + " ("
For i = vStartColumnNumb + 1 To vEndColumnNumb
tmpstr = tmpstr + Worksheets(vTableName).Cells(2, i).Value + ","
Next
tmpstr = tmpstr + " FCU, LCU) values ('"
For i = vStartRowNumb + 1 To vEndRowNumb
vInsertSql = vInsertSql + tmpstr
For j = vStartColumnNumb + 1 To vEndColumnNumb
If Worksheets(vTableName).Cells(i, j).Value = "" Then
Flag = 1
End If
vInsertSql = vInsertSql + Worksheets(vTableName).Cells(i, j).Value + "','"
Next j
'vInsertSql = Left(vInsertSql, Len(vInsertSql) - 3) + "');" + vbCrLf '换行
vInsertSql = Left(vInsertSql, Len(vInsertSql) - 3) + "','" + vUM + "','" + vUM + "');" + vbCrLf '换行
Next i
'MsgBox (vInsertSql)
vInsertSql = vInsertSql + "commit;"
Call WriteFile(FileName, vInsertSql)
'MsgBox ("复制成功")
If Flag = 0 Then
MsgBox "【" + FileName + "】" + "已创建成功！"
Else
MsgBox "【" + FileName + "】" + "已创建成功！" + vbLf + "但是经过检查,部分字段有为空的情况,请核实后再提交INSERT文件"
End If
End Function
文件读写：
Public Function ReadFileVblf(FilePath As String) As String
Dim varDsxFile As String, AllFile As String
Dim varTemp As Integer
Dim IxQuery, IxServer
AllFile = ""
'按顺序读写记录dsx全路径文件，解析获得源和目标
Open FilePath For Input As #2
Do While Not EOF(2)
Line Input #2, varDsxFile
AllFile = AllFile + Trim(varDsxFile) + vbLf
'MsgBox AllFile
Loop
Close #2
ReadFileVblf = AllFile
End Function
Public Function ReadFile(FilePath As String) As String
Dim varDsxFile As String, AllFile As String
Dim varTemp As Integer
Dim IxQuery, IxServer
AllFile = ""
'按顺序读写记录dsx全路径文件，解析获得源和目标
Open FilePath For Input As #2
Do While Not EOF(2)
Line Input #2, varDsxFile
AllFile = AllFile + " " + varDsxFile
'MsgBox AllFile
Loop
Close #2
ReadFile = AllFile
End Function
Function WriteFile(FileName As String, vInsertSql As String)
Dim FileNum
FileNum = FreeFile '提供一个尚未使用的文件号
Open FileName For Output As #FileNum '打开目标文件以提供输出
Print #FileNum, vInsertSql '逐行写入目标文件
Close #FileNum '关闭目标文件
End Function
<pre class="vb" name="code">Function Replace(SQL As String, ssql As String, tsql As String) As String
'MsgBox SQL
While InStr(1, SQL, ssql) <> 0
'MsgBox SQL
SQL = Left(SQL, InStr(1, SQL, ssql) - 1) + tsql + Right(SQL, Len(SQL) - InStr(1, SQL, ssql) - Len(ssql) + 1)
Wend
Replace = SQL
'MsgBox SQL
End Function
Function Distinct(TableList() As String) As Integer
Dim i, j, k, IsSame
j = 0
'MsgBox "UBound(tablelist):" + CStr(UBound(tablelist))
For i = 1 To UBound(TableList)
IsSame = 0
For k = 0 To j
If TableList(i) = TableList(k) Then
IsSame = 1
End If
Next
If IsSame <> 1 Then
j = j + 1
TableList(j) = TableList(i)
'MsgBox "I:" + CStr(i)
'MsgBox "J:" + CStr(j)
'MsgBox "B:" + TableList(j)
End If
Next
Distinct = j + 1
End Function
Function ClearOldValue(SheetName As String, StrRange As String)
'清空旧值 StrRange="A1:A1000"
Workbooks(ThisWorkbook.Name).Sheets(SheetName).Select
Range(StrRange).Select
Selection.ClearContents
Workbooks(ThisWorkbook.Name).Sheets("CONFIG").Select
'Range("A1").Select
End Function
Function WriteExcel(WorkBookName As String, WorkSheetName As String, StartRow As Integer, StartColumn As Integer, RowNum As Integer, ColumnNum As Integer, ArrContent() As String) As String Dim i, j For i = 0 To RowNum - 1 For j = 0 To ColumnNum - 1 'Workbooks(WorkBookName).Worksheets(WorkSheetName).Cells(StartRow + i, StartColumn + j).Value = ArrContent(i, j) Workbooks(ThisWorkbook.Name).Worksheets(WorkSheetName).Cells(StartRow + i, StartColumn + j).Value = ArrContent(i, j) Next NextEnd Function
其他公函：
Function Replace(SQL As String, ssql As String, tsql As String) As String
'MsgBox SQL
While InStr(1, SQL, ssql) <> 0
'MsgBox SQL
SQL = Left(SQL, InStr(1, SQL, ssql) - 1) + tsql + Right(SQL, Len(SQL) - InStr(1, SQL, ssql) - Len(ssql) + 1)
Wend
Replace = SQL
'MsgBox SQL
End Function
Function Distinct(TableList() As String) As Integer
Dim i, j, k, IsSame
j = 0
'MsgBox "UBound(tablelist):" + CStr(UBound(tablelist))
For i = 1 To UBound(TableList)
IsSame = 0
For k = 0 To j
If TableList(i) = TableList(k) Then
IsSame = 1
End If
Next
If IsSame <> 1 Then
j = j + 1
TableList(j) = TableList(i)
'MsgBox "I:" + CStr(i)
'MsgBox "J:" + CStr(j)
'MsgBox "B:" + TableList(j)
End If
Next
Distinct = j + 1
End Function
Function ClearOldValue(SheetName As String, StrRange As String)
'清空旧值 StrRange="A1:A1000"
Workbooks(ThisWorkbook.Name).Sheets(SheetName).Select
Range(StrRange).Select
Selection.ClearContents
Workbooks(ThisWorkbook.Name).Sheets("CONFIG").Select
'Range("A1").Select
End Function
录入人UM：ZHOULIXIN545
待解析文件目录：D:\CCShare\newch_cong\src\前端报表
解析DS按钮 解析mdl按钮 生成INSERT按钮
使用说明：
1.本工具可以用于：测试开始前自动生成导数清单以及全量移交后录入新增报表信息；
2.点击“解析DS文件”按钮，工具对【待解析文件目录】下的DS文件进行解析，获得“DS文件”，“目标表”，“源表”三者的关系；
3.点击“解析MDL文件”按钮，工具对【待解析文件目录】下的MDL文件进行解析，获得“MDL文件”与“源表”的关系；
3.在上一步基础上，用户补充好【MIS_TABLE_RELATION】SHEET中的注释和【MIS_REPORT_TABLE_RELATION】SHEET的内容后，点击“生成INSERT文件”按钮后系统会自动生成INSERT文件，并存放在当前目录下，命名规则：SHEETNAME+UM+DATE.SQL
4.工具局限：
A.现在还无法解析报表与MDL和FM模型间的关系
B.对于以下模式的SQL处理还需要优化，现在会将“AA”作为源表处理
WITH AA AS (SELECT SYSDATE AS NC_DATE FROM DUAL)
SELECT B.NC_DATE FROM AA B
C.源表为落地文件的无法解析
工具测试情况:
对CC上NOlapPaolap目录下的JOB做了解析，抽了几个看了下没什么问题，下面列表是没有解析成功的job，有以下几种情况：落地文件，SEQ，EndJob，调PACKAGE
解析DATASTAGE导出文件dsx和congnos的mdl文件相关推荐
- Ubuntu“无法解析或打开软件包的列表或是状态文件”的解决办法。
安装软件结果出现"无法解析或打开软件包的列表或是状态文件"的错误,具体信息是: 初始化包信息时遇到无法解决的问题. 请汇报这个"update-manager"软 ...
- 解析：如何在 ASP.NET 中下载文件
解析:如何在 ASP.NET 中下载文件 来源:博客园 作者:dotnetWalker 这是笔者常被问到的一个问题,如何通过ASP.NET来下载文件,这个问题可大可小,我们先从小的开始.当我们要让用户 ...
- 读取MDL文件与骨骼控制
---------------------我 读取MDL文件 不知怎么的,我还以为actor直接读取MDL文件会没问题,结果发现读取那个例子中有的青蛙确实没问题, 但是一读取那些半条命啊.反恐啊什么的 ...
- linux 下安装播放器：无法解析或打开软件包的列表或是状态文件
最近准备在ubuntu系统上安装一个播放器,方便学习.可是自带的播放器缺少插件,而且自带的播放器比较鸡肋,所以准备安一个smplayer播放器. ctrl+Ait+T 风骚的打开终端,一行命令潇洒输 ...
- Linux运维系列总结-Linux系统启动过程、WEB工作原理、DHCP工作原理、DNS解析原理、NFS网络文件系统、FTP文件传输协议、PXE+KICKSTART自动安装系统
Linux运维系列总结-Linux系统启动过程.WEB工作原理.DHCP工作原理.DNS解析原理.NFS网络文件系统.FTP文件传输协议.PXE+KICKSTART自动安装系统 1.Linux系统的启 ...
- 无法解析或打开软件包的列表或是状态文件解决方案
无法解析或打开软件包的列表或是状态文件解决方案 正在读取软件包列表... 有错误! E: Encountered a section with no Package: header E: Proble ...
- 前端导出文件 前端导出excel表格 下载文件
导出文件的过程 前端发请求, 后端处理后返回文件流, 前端通过Blob解析并下载 实现过程: 前端发请求 需要将响应类型更改为 arraybuffer 或 blob 不设置响应类型会导致下载的文件看起 ...
- （转）rtmp协议简单解析以及用其发送h264的flv文件
Adobe公司太坑人了,官方文档公布的信息根本就不全,如果只按照他上面的写的话,是没法用的.按照文档上面的流程,server和client连接之后首先要进行握手,握手成功之后进行一些交互,其实就是交互 ...
- Android之解决PC端上传http表单格式文件手机解析文件名乱码问题和PC浏览器下载文件的文件名显示乱码问题
1 问题 问题1. 手机写socket作为服务器,PC浏览器上传http表单格式文件,然后手机端解析携带中文的文件名我解析是乱码. 问题2. 手机写了socket作为服务器,PC浏览器下载文件,但是浏 ...
- Java dom4j解析RESTFull风格发布的WebService的xml文件
公司项目要求解析出RESTFull风格发布的WebService接口的所有请求方法,参数,参数类型,已经方法是返回类型,想来想去都不知道该怎么办,思来想去然后又研究RESTFull风格WebServi ...
最新文章
- ARM 环境下使用azure powershell 从远程blob中拉去vhd 并创建虚拟机
- 第三方控件DevExpress的TreeList绑定XML文件
- Excel 中使用数据透视表 Pivot Table
- 表likp新增第一次过账输入日期字段，vl02n/vl01n/vl03n/vl06o的增强
- Python使用修饰器强制函数只接收关键参数
- python向it新增5个元素_Python序列、元组、列表、集合及字典笔记整理
- 很久没写了，今天兴致来了，写一下！
- undefined reference to `vtable for XXX‘
- GetFileAttributes
- CRUD生成器DBuilder设计与实现
- 施一公等团队登Science封面：AI与冷冻电镜揭示「原子级」NPC结构，生命科学突破...
- edgewin10无法安装_如何解决Win10 Edge浏览器无法下载文件？
- 2022年12月最新快速批量删除微博内容_新版本如何批量删除微博以前发过的博文内容
- 电脑C盘满了怎么办？电脑C盘满了怎么清理？
- 小i聊天机器人自定义应用
- 写作必备文献搜索网大全
- 如何打通微信账号体系？
- IOC和DI到底是什么？
- 07 - Nor Flash
- 【每日早报】2019/09/18