|
- Option Explicit
-
- Const ForReading = 1
- Const TristateFalse = 0
- Const TristateTrue = -1
-
- Dim fso:Set fso = CreateObject("Scripting.FileSystemObject")
- Dim scriptDir: scriptDir = fso.GetParentFolderName(WScript.ScriptFullName)
- Dim repoRoot: repoRoot = fso.GetParentFolderName(scriptDir)
- Dim sourcePath: sourcePath = fso.BuildPath(repoRoot, "ImportService\\TrackingDataImport.vbs")
- Dim chilkatSerialPath: chilkatSerialPath = fso.BuildPath(scriptDir, "chillkat_serial")
- Dim objFSO
- Dim DataDirectory
- Dim objCSV ' Required for ValidImportCSV
- Dim oConn
- Dim ConnectionString
- Dim ExportDirectory
- Dim integrationMdbPath
- Dim integrationExportDir
- Dim integrationDbAvailable
- Dim integrationDbSkipReason
- Dim wow64CScript
- Dim is64BitHost
- Dim sh
- Dim oExec
- Dim InkjetExportSortDirection
-
- Dim functionNames
- functionNames = Array( _
- "PadLeft", _
- "CheckForFiles", _
- "Truncate", _
- "PadString", _
- "CleanNull", _
- "Assign", _
- "Choice", _
- "CompressArray", _
- "TrimLeadingZeros", _
- "PushNonEmptyToBottom", _
- "GetState", _
- "GetCityFromLine", _
- "CheckStringDoesNotHaveForiegnCountries", _
- "ValidImportCSV", _
- "GetSetting", _
- "ExportInkjetFile" _
- )
-
- LoadFunctions sourcePath, functionNames
-
- Set objFSO = fso
-
- ' Initialize Chilkat CSV if available (required for ValidImportCSV tests)
- Dim chilkatAvailable
- Dim chilkatReason: chilkatReason = ""
- On Error Resume Next
- Dim glob
- Set glob = CreateObject("Chilkat_9_5_0.Global")
- If Err.Number <> 0 Then
- chilkatReason = "Chilkat_9_5_0.Global COM not available"
- Err.Clear
- Else
- Dim serialNumber: serialNumber = LoadChilkatSerial(chilkatSerialPath)
- If Len(serialNumber) = 0 Then
- chilkatReason = "missing serial in " & chilkatSerialPath
- Else
- Dim unlockSuccess: unlockSuccess = glob.UnlockBundle(serialNumber)
- If unlockSuccess <> 1 Then
- chilkatReason = "unlock failed"
- If Len(Trim(glob.LastErrorText & "")) > 0 Then
- chilkatReason = chilkatReason & " - " & Replace(Trim(glob.LastErrorText & ""), vbCrLf, " ")
- End If
- Else
- Set objCSV = CreateObject("Chilkat_9_5_0.Csv")
- If Err.Number = 0 Then
- chilkatAvailable = True
- Else
- chilkatReason = "Chilkat_9_5_0.Csv COM not available"
- Err.Clear
- End If
- End If
- End If
- End If
- On Error GoTo 0
-
- ' === Integration test DB probe ===
- wow64CScript = "C:\Windows\SysWOW64\cscript.exe"
- is64BitHost = (InStr(1, LCase(WScript.FullName), "syswow64") = 0) And fso.FileExists(wow64CScript)
-
- integrationMdbPath = fso.BuildPath(scriptDir, "..\Data\webdata - Copy.mdb")
- integrationExportDir = fso.BuildPath(scriptDir, "export-test-output")
- integrationDbAvailable = False
- integrationDbSkipReason = ""
- If Not fso.FileExists(integrationMdbPath) Then
- integrationDbSkipReason = "MDB fixture not found: " & integrationMdbPath
- Else
- Set oConn = CreateObject("ADODB.Connection")
- On Error Resume Next
- oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & integrationMdbPath & ";"
- If Err.Number <> 0 Then
- Err.Clear
- oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & integrationMdbPath & ";"
- End If
- If Err.Number <> 0 Then
- Dim failDesc : failDesc = Err.Description
- Err.Clear
- On Error GoTo 0
- If is64BitHost Then
- ' 64-bit cscript can't see 32-bit ACE/Jet drivers — re-run as 32-bit and relay output
- WScript.Echo "64-bit cscript: ADODB driver not found. Re-running as 32-bit cscript..."
- Set sh = CreateObject("WScript.Shell")
- Set oExec = sh.Exec("cmd /c " & wow64CScript & " //NoLogo " & Chr(34) & WScript.ScriptFullName & Chr(34) & " 2>&1")
- Do While Not oExec.StdOut.AtEndOfStream
- WScript.Echo oExec.StdOut.ReadLine()
- Loop
- WScript.Quit oExec.ExitCode
- Else
- integrationDbSkipReason = "No ADODB provider available (ACE and Jet both failed): " & failDesc
- End If
- Else
- integrationDbAvailable = True
- ConnectionString = oConn.ConnectionString
- ExportDirectory = integrationExportDir & "\"
- End If
- On Error GoTo 0
- If oConn.State = 1 Then oConn.Close
- End If
-
- Dim passed: passed = 0
- Dim failed: failed = 0
-
- Dim q: q = Chr(34)
- AssertEqual Truncate("abcdef", 3), q & "abc" & q & ",", "Truncate trims and quotes"
- AssertEqual Truncate("ab", 3), q & "ab" & q & ",", "Truncate short string"
-
- AssertEqual PadLeft("7", 3, "0"), "007", "PadLeft pads"
- AssertEqual PadLeft("1234", 3, "0"), "1234", "PadLeft no pad when longer"
-
- AssertEqual PadString("ab", 4), "ab ", "PadString right pads"
- AssertEqual PadString("abcd", 4), "abcd", "PadString same length"
- AssertEqual PadString(Null, 3), " ", "PadString null"
-
- AssertEqual CleanNull(Null), "", "CleanNull null"
- AssertEqual CleanNull("x"), "x", "CleanNull value"
-
- Dim arr
- arr = Array("", "a", "", "b")
- arr = CompressArray(arr)
- AssertArrayEqual arr, Array("a", "b", "", ""), "CompressArray moves blanks to end"
-
- AssertEqual TrimLeadingZeros("000123"), "123", "TrimLeadingZeros removes leading zeros"
- AssertEqual TrimLeadingZeros("0000"), "", "TrimLeadingZeros all zeros"
-
- Dim arr2
- arr2 = Array("a", "", "b", "")
- PushNonEmptyToBottom arr2
- AssertArrayEqual arr2, Array("", "", "a", "b"), "PushNonEmptyToBottom"
-
- AssertEqual GetState("Lansing, MI 48906"), "MI", "GetState matches state"
- AssertEqual GetState("No match"), "", "GetState no match"
-
- AssertEqual GetCityFromLine("Lansing, MI 48906"), "Lansing", "GetCityFromLine with comma"
- AssertEqual GetCityFromLine("NoComma"), "NoComma", "GetCityFromLine no comma"
- AssertEqual GetCityFromLine(Null), "", "GetCityFromLine null"
-
- Dim tempDir
- tempDir = fso.BuildPath(repoRoot, "Tests\\_tmp_checkforfiles")
- If Not fso.FolderExists(tempDir) Then
- fso.CreateFolder tempDir
- End If
- Set objFSO = fso
- DataDirectory = tempDir
- On Error Resume Next
- Dim checkResult
- checkResult = CheckForFiles()
- If Err.Number = 0 Then
- passed = passed + 1
- WScript.Echo "PASS: CheckForFiles runs without error (empty dir)"
- Else
- failed = failed + 1
- WScript.Echo "FAIL: CheckForFiles error " & Err.Number & " - " & Err.Description
- Err.Clear
- End If
- On Error GoTo 0
-
- ' === [P0] CheckStringDoesNotHaveForiegnCountries ===
- AssertEqual CheckStringDoesNotHaveForiegnCountries("123 Main St, Lansing MI 48906"), True, "[P0] CheckStringDoesNotHaveForiegnCountries clean US address"
- AssertEqual CheckStringDoesNotHaveForiegnCountries("123 Main St, CANADA"), False, "[P0] CheckStringDoesNotHaveForiegnCountries CANADA uppercase match"
- AssertEqual CheckStringDoesNotHaveForiegnCountries("Tokyo, JAPAN 12345"), False, "[P0] CheckStringDoesNotHaveForiegnCountries JAPAN uppercase match"
- AssertEqual CheckStringDoesNotHaveForiegnCountries("123 Norway Ave, Lansing MI"), True, "[P0] CheckStringDoesNotHaveForiegnCountries Norway Ave (behavior doc: InStr binary, Norway<>NORWAY)"
- AssertEqual CheckStringDoesNotHaveForiegnCountries("123 canada road"), True, "[P0] CheckStringDoesNotHaveForiegnCountries lowercase canada (behavior doc: case-sensitive, no match)"
- AssertEqual CheckStringDoesNotHaveForiegnCountries(""), True, "[P0] CheckStringDoesNotHaveForiegnCountries empty string"
- AssertEqual CheckStringDoesNotHaveForiegnCountries(Null), True, "[P0] CheckStringDoesNotHaveForiegnCountries null (InStr returns Null, falsy in If)"
-
- ' === [P0] GetState additional ===
- AssertEqual GetState("lansing, mi 48906"), "", "[P0] GetState lowercase state returns empty (behavior doc: IgnoreCase=False, mixed-case CSV misses)"
- AssertEqual GetState(""), "", "[P0] GetState empty string"
-
- ' === [P0] Choice with Null condition ===
- AssertEqual Choice(Null, "yes", "no"), "no", "[P0] Choice null condition evaluates as False branch"
-
- ' === [P0] ValidImportCSV (requires Chilkat_9_5_0.Csv COM) ===
- If chilkatAvailable Then
- Dim csv20col
- csv20col = "H1,H2,H3,H4,H5,H6,H7,H8,H9,H10,H11,H12,H13,H14,H15,H16,H17,H18,H19,H20" & vbCrLf & _
- "v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,v17,v18,v19,v20"
- AssertEqual ValidImportCSV(csv20col), True, "[P0] ValidImportCSV 20 columns accepted"
- Dim csv19col
- csv19col = "H1,H2,H3,H4,H5,H6,H7,H8,H9,H10,H11,H12,H13,H14,H15,H16,H17,H18,H19" & vbCrLf & _
- "v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,v17,v18,v19"
- AssertEqual ValidImportCSV(csv19col), False, "[P0] ValidImportCSV 19 columns rejected"
- AssertEqual ValidImportCSV(""), False, "[P0] ValidImportCSV empty string rejected"
- Else
- WScript.Echo "SKIP: ValidImportCSV tests skipped (" & chilkatReason & ")"
- End If
-
- ' === [P1] TrimLeadingZeros edge cases ===
- AssertEqual TrimLeadingZeros(""), "", "[P1] TrimLeadingZeros empty string"
- AssertEqual TrimLeadingZeros("abc"), "abc", "[P1] TrimLeadingZeros no leading zeros"
- AssertEqual TrimLeadingZeros("0"), "", "[P1] TrimLeadingZeros single zero"
- AssertEqual TrimLeadingZeros(" 007"), " 007", "[P1] TrimLeadingZeros leading space preserved (space is not zero)"
-
- ' === [P1] PadLeft edge cases ===
- AssertEqual PadLeft("007", 3, "0"), "007", "[P1] PadLeft exact length no padding"
- AssertEqual PadLeft("", 3, "0"), "000", "[P1] PadLeft empty string padded"
-
- ' === [P1] PadString edge cases ===
- AssertEqual PadString("abcde", 3), "abcde", "[P1] PadString longer than size returned as-is"
- AssertEqual PadString("", 3), " ", "[P1] PadString empty string padded to spaces"
-
- ' === [P1] CompressArray edge cases ===
- Dim arr3
- arr3 = Array("", "", "")
- arr3 = CompressArray(arr3)
- AssertArrayEqual arr3, Array("", "", ""), "[P1] CompressArray all-empty array unchanged"
-
- Dim arr4
- arr4 = Array("a", "b", "c")
- arr4 = CompressArray(arr4)
- AssertArrayEqual arr4, Array("a", "b", "c"), "[P1] CompressArray all-non-empty no swaps"
-
- Dim arr5
- arr5 = Array("a")
- arr5 = CompressArray(arr5)
- AssertArrayEqual arr5, Array("a"), "[P1] CompressArray single element"
-
- ' === [P2] Assign ===
- Dim v1
- Assign v1, "hello"
- AssertEqual v1, "hello", "[P2] Assign scalar string"
- Assign v1, 42
- AssertEqual v1, 42, "[P2] Assign scalar number"
- Assign v1, ""
- AssertEqual v1, "", "[P2] Assign empty string"
- Assign v1, 0
- AssertEqual v1, 0, "[P2] Assign zero"
-
- ' === [P2] Choice ===
- AssertEqual Choice(True, "yes", "no"), "yes", "[P2] Choice True branch"
- AssertEqual Choice(False, "yes", "no"), "no", "[P2] Choice False branch"
- AssertEqual Choice(1 = 1, "equal", "not"), "equal", "[P2] Choice computed True"
- AssertEqual Choice(1 = 2, "equal", "not"), "not", "[P2] Choice computed False"
-
- ' === ExportInkjetFile Integration Test ===
- If Not chilkatAvailable Then
- WScript.Echo "SKIP: ExportInkjetFile integration test (Chilkat unavailable)"
- ElseIf Not integrationDbAvailable Then
- WScript.Echo "SKIP: ExportInkjetFile integration test (" & integrationDbSkipReason & ")"
- Else
- oConn.Open ConnectionString
-
- Dim kitDiscoverRs
- Set kitDiscoverRs = oConn.Execute( _
- "SELECT TOP 1 ir.KitID FROM ((InkjetRecords ir " & _
- "INNER JOIN Kit k ON ir.KitID = k.ID) " & _
- "INNER JOIN Jurisdiction j ON k.JCode = j.JCode) " & _
- "INNER JOIN Contacts c ON k.JCode = c.JURISCODE WHERE ir.ID IN (SELECT TOP 500 ID FROM InkjetRecords ORDER BY ID);")
- If kitDiscoverRs.EOF Then
- WScript.Echo "SKIP: ExportInkjetFile - no complete Kit+InkjetRecords+Jurisdiction+Contact found in fixture MDB"
- oConn.Close
- Else
- Dim testKitID : testKitID = kitDiscoverRs("KitID").Value
-
- Dim countRs
- Set countRs = oConn.Execute("SELECT COUNT(*) AS N FROM InkjetRecords WHERE KitID=" & testKitID & ";")
- Dim expectedRows : expectedRows = countRs("N").Value
-
- Dim kitRsCheck
- Set kitRsCheck = oConn.Execute("SELECT JCode FROM Kit WHERE ID=" & testKitID & ";")
- Dim testJCode : testJCode = kitRsCheck("JCode").Value
-
- oConn.Close
-
- Dim descCsvPath : descCsvPath = RunExportInkjetScenario(testKitID, "" , "DESC")
- If Len(descCsvPath) > 0 Then
- AssertExportInkjetCsv testKitID, descCsvPath, expectedRows, testJCode, "DESC"
- End If
- Dim ascCsvPath : ascCsvPath = RunExportInkjetScenario(testKitID, "ASC", "ASC")
- If Len(ascCsvPath) > 0 Then
- AssertExportInkjetCsv testKitID, ascCsvPath, expectedRows, testJCode, "ASC"
- End If
- oConn.Open ConnectionString
- Dim sideEffectRs
- Set sideEffectRs = oConn.Execute("SELECT Status, InkJetJob FROM Kit WHERE ID=" & testKitID & ";")
- AssertEqual sideEffectRs("Status").Value, "Done", "[INT] ExportInkjetFile: Kit.Status = Done"
- Dim ijVal : ijVal = sideEffectRs("InkJetJob").Value
- Dim ijSet : ijSet = False
- If Not IsNull(ijVal) Then ijSet = CBool(ijVal)
- AssertEqual ijSet, True, "[INT] ExportInkjetFile: Kit.InkJetJob is set"
- oConn.Close
-
- ' Cleanup - error-suppressed (AV may briefly hold CSV handle)
- On Error Resume Next
- If fso.FolderExists(integrationExportDir) Then fso.DeleteFolder integrationExportDir, True
- If fso.FolderExists(fso.BuildPath(scriptDir, "export-test-output-desc")) Then fso.DeleteFolder fso.BuildPath(scriptDir, "export-test-output-desc"), True
- If fso.FolderExists(fso.BuildPath(scriptDir, "export-test-output-asc")) Then fso.DeleteFolder fso.BuildPath(scriptDir, "export-test-output-asc"), True
- On Error GoTo 0
- End If
- End If
-
- WScript.Echo ""
- WScript.Echo "Passed: " & passed
- WScript.Echo "Failed: " & failed
- If failed > 0 Then
- WScript.Quit 1
- End If
-
- Function RunExportInkjetScenario(ByVal testKitID, ByVal sortDirection, ByVal scenarioName)
- RunExportInkjetScenario = ""
- InkjetExportSortDirection = sortDirection
- Dim scenarioExportDir : scenarioExportDir = fso.BuildPath(scriptDir, "export-test-output-" & LCase(scenarioName))
- Dim originalExportDirectory : originalExportDirectory = ExportDirectory
- ExportDirectory = scenarioExportDir & "\"
- On Error Resume Next
- If fso.FolderExists(scenarioExportDir) Then fso.DeleteFolder scenarioExportDir, True
- On Error GoTo 0
- fso.CreateFolder scenarioExportDir
- On Error Resume Next
- ExportInkjetFile testKitID
- Dim exportErr : exportErr = Err.Number
- Dim exportDesc : exportDesc = Err.Description
- On Error GoTo 0
- If exportErr <> 0 Then
- WScript.Echo "FAIL: [INT] ExportInkjetFile " & scenarioName & " error " & exportErr & " - " & exportDesc
- failed = failed + 1
- ExportDirectory = originalExportDirectory
- InkjetExportSortDirection = ""
- Exit Function
- End If
- Dim exportSubfolders : Set exportSubfolders = fso.GetFolder(scenarioExportDir).SubFolders
- Dim csvFound : csvFound = False
- Dim csvPath : csvPath = ""
- Dim sf
- For Each sf In exportSubfolders
- Dim csvFiles : Set csvFiles = sf.Files
- Dim f
- For Each f In csvFiles
- If LCase(fso.GetExtensionName(f.Name)) = "csv" Then
- csvFound = True
- csvPath = f.Path
- End If
- Next
- Next
- AssertEqual csvFound, True, "[INT] ExportInkjetFile " & scenarioName & ": CSV file created"
- If csvFound Then RunExportInkjetScenario = csvPath
- ExportDirectory = originalExportDirectory
- InkjetExportSortDirection = ""
- End Function
-
- Sub AssertExportInkjetCsv(ByVal testKitID, ByVal csvPath, ByVal expectedRows, ByVal testJCode, ByVal scenarioName)
- Dim verifyCsv : Set verifyCsv = CreateObject("Chilkat_9_5_0.Csv")
- verifyCsv.HasColumnNames = 1
- Dim csvLoaded : csvLoaded = verifyCsv.LoadFile(csvPath)
- AssertEqual csvLoaded, 1, "[INT] ExportInkjetFile " & scenarioName & ": CSV loaded by Chilkat"
- If csvLoaded Then
- AssertEqual verifyCsv.NumColumns, 22, "[INT] ExportInkjetFile " & scenarioName & ": 22 columns"
- AssertEqual verifyCsv.GetColumnName(0), "Full Name", "[INT] ExportInkjetFile " & scenarioName & ": col 0 = Full Name"
- AssertEqual verifyCsv.GetColumnName(5), "IM barcode Characters", "[INT] ExportInkjetFile " & scenarioName & ": col 5 = IM barcode Characters"
- AssertEqual verifyCsv.GetColumnName(8), "Ballot Number", "[INT] ExportInkjetFile " & scenarioName & ": col 8 = Ballot Number"
- AssertEqual verifyCsv.GetColumnName(11), "Combined Pct_Ballot Num", "[INT] ExportInkjetFile " & scenarioName & ": col 11 = Combined Pct_Ballot Num"
- AssertEqual verifyCsv.GetColumnName(19), "Matching Code", "[INT] ExportInkjetFile " & scenarioName & ": col 19 = Matching Code"
- AssertEqual verifyCsv.GetColumnName(20), "ColorFilepath", "[INT] ExportInkjetFile " & scenarioName & ": col 20 = ColorFilepath"
- AssertEqual verifyCsv.GetColumnName(21), "ColorName", "[INT] ExportInkjetFile " & scenarioName & ": col 21 = ColorName"
- AssertEqual verifyCsv.NumRows, expectedRows, "[INT] ExportInkjetFile " & scenarioName & ": row count matches InkjetRecords"
- oConn.Open ConnectionString
- Dim expectedRs
- Set expectedRs = oConn.Execute( _
- "SELECT PRECINCT, BALLOT_NUMBER FROM InkjetRecords WHERE KitID=" & testKitID & " " & _
- "ORDER BY Val(PRECINCT) " & scenarioName & ", PRECINCT " & scenarioName & ", " & _
- "Val(Right(BALLOT_NUMBER, 4)) " & scenarioName & ", Right(BALLOT_NUMBER, 4) " & scenarioName & ";")
- Dim checkRows : checkRows = 10
- If verifyCsv.NumRows < 10 Then checkRows = verifyCsv.NumRows
- Dim r
- For r = 0 To checkRows - 1
- If expectedRs.EOF Then Exit For
- Dim actualPrecinct : actualPrecinct = verifyCsv.GetCell(r, 6)
- Dim actualBallotNum : actualBallotNum = verifyCsv.GetCell(r, 8)
- Dim actualMatchCode : actualMatchCode = verifyCsv.GetCell(r, 19)
- Dim expectedPrecinct : expectedPrecinct = CleanNull(expectedRs("PRECINCT").Value)
- Dim expectedBallotNum : expectedBallotNum = TrimLeadingZeros(CleanNull(expectedRs("BALLOT_NUMBER").Value))
- AssertEqual (Left(actualBallotNum, 1) <> "0" Or actualBallotNum = ""), True, "[INT] ExportInkjetFile " & scenarioName & ": row " & r & " Ballot Number no leading zeros"
- AssertEqual Left(actualMatchCode, Len(testJCode)), testJCode, "[INT] ExportInkjetFile " & scenarioName & ": row " & r & " Matching Code starts with JCode"
- AssertEqual actualPrecinct, expectedPrecinct, "[INT] ExportInkjetFile " & scenarioName & ": row " & r & " precinct order"
- AssertEqual actualBallotNum, expectedBallotNum, "[INT] ExportInkjetFile " & scenarioName & ": row " & r & " ballot order"
- expectedRs.MoveNext
- Next
- expectedRs.Close
- oConn.Close
- End If
- Set verifyCsv = Nothing
- End Sub
-
- Sub LoadFunctions(ByVal filePath, ByVal names)
- Dim fileText, lines, i, line
- Dim capturing: capturing = False
- Dim endKeyword: endKeyword = ""
- Dim block: block = ""
-
- If Not fso.FileExists(filePath) Then
- WScript.Echo "FAIL: Source file not found: " & filePath
- WScript.Quit 1
- End If
-
- With fso.OpenTextFile(filePath, ForReading, False, TristateTrue)
- fileText = .ReadAll
- .Close
- End With
-
- ' Normalize line endings and remove nulls/BOM that can appear in UTF-16 reads
- fileText = Replace(fileText, ChrW(&HFEFF), "")
- fileText = Replace(fileText, Chr(0), "")
- fileText = Replace(fileText, vbTab, " ")
- fileText = Replace(fileText, vbCrLf, vbLf)
- fileText = Replace(fileText, vbCr, vbLf)
- lines = Split(fileText, vbLf)
-
- For i = 0 To UBound(lines)
- line = lines(i)
- If Not capturing Then
- Dim nameIndex
- For nameIndex = 0 To UBound(names)
- Dim kind
- If TryStartLine(line, names(nameIndex), kind) Then
- capturing = True
- endKeyword = "End " & kind
- block = block & line & vbCrLf
- Exit For
- End If
- Next
- Else
- block = block & line & vbCrLf
- If LCase(Trim(line)) = LCase(endKeyword) Then
- capturing = False
- block = block & vbCrLf
- End If
- End If
- Next
-
- If Len(block) = 0 Then
- ' Fallback: simple text scan for each function/sub
- Dim nameIndex2
- For nameIndex2 = 0 To UBound(names)
- Dim extracted
- extracted = ExtractBlock(fileText, names(nameIndex2))
- If Len(extracted) > 0 Then
- block = block & extracted & vbCrLf & vbCrLf
- End If
- Next
- End If
-
- If Len(block) = 0 Then
- WScript.Echo "FAIL: No functions loaded from " & filePath
- WScript.Echo "Debug: file length=" & Len(fileText)
- WScript.Quit 1
- End If
-
- ExecuteGlobal block
- End Sub
-
- Function ExtractBlock(ByVal fileText, ByVal name)
- Dim lowerText, lowerName, startPos, endPos, kind, endToken
- lowerText = LCase(fileText)
- lowerName = LCase(name)
-
- startPos = FindDeclPos(lowerText, lowerName, "function")
- kind = "Function"
- If startPos = 0 Then
- startPos = FindDeclPos(lowerText, lowerName, "sub")
- kind = "Sub"
- End If
-
- If startPos = 0 Then
- ExtractBlock = ""
- Exit Function
- End If
-
- endToken = "end " & LCase(kind)
- endPos = InStr(startPos, lowerText, endToken)
- If endPos = 0 Then
- ExtractBlock = ""
- Exit Function
- End If
-
- endPos = endPos + Len(endToken) - 1
- ExtractBlock = Mid(fileText, startPos, endPos - startPos + 1)
- End Function
-
- Function FindDeclPos(ByVal lowerText, ByVal lowerName, ByVal keyword)
- Dim pos, idx, ch, nameLen, nextChar
- nameLen = Len(lowerName)
- pos = InStr(1, lowerText, keyword)
- Do While pos > 0
- idx = pos + Len(keyword)
- Do While idx <= Len(lowerText)
- ch = Mid(lowerText, idx, 1)
- If IsWs(ch) Then
- idx = idx + 1
- Else
- Exit Do
- End If
- Loop
- If LCase(Mid(lowerText, idx, nameLen)) = lowerName Then
- nextChar = Mid(lowerText, idx + nameLen, 1)
- If nextChar = "" Or Not IsNameChar(nextChar) Then
- FindDeclPos = pos
- Exit Function
- End If
- End If
- pos = InStr(pos + 1, lowerText, keyword)
- Loop
- FindDeclPos = 0
- End Function
-
- Function IsWs(ByVal ch)
- IsWs = (ch = " " Or ch = vbTab Or ch = vbLf Or ch = vbCr Or AscW(ch) = 160)
- End Function
-
- Function IsNameChar(ByVal ch)
- Dim code
- code = AscW(ch)
- IsNameChar = (code >= 48 And code <= 57) Or (code >= 65 And code <= 90) Or (code >= 97 And code <= 122) Or ch = "_"
- End Function
-
- Function TryStartLine(ByVal line, ByVal name, ByRef kind)
- Dim lowerLine, lowerName, pos
- lowerLine = LCase(line)
- lowerName = LCase(name)
-
- pos = FindDeclPos(lowerLine, lowerName, "function")
- If pos > 0 Then
- kind = "Function"
- TryStartLine = True
- Exit Function
- End If
-
- pos = FindDeclPos(lowerLine, lowerName, "sub")
- If pos > 0 Then
- kind = "Sub"
- TryStartLine = True
- Exit Function
- End If
-
- TryStartLine = False
- End Function
-
- Sub AssertEqual(ByVal actual, ByVal expected, ByVal testName)
- If actual = expected Then
- passed = passed + 1
- WScript.Echo "PASS: " & testName
- Else
- failed = failed + 1
- WScript.Echo "FAIL: " & testName & " | expected=" & FormatValue(expected) & " actual=" & FormatValue(actual)
- End If
- End Sub
-
- Sub AssertArrayEqual(ByVal actual, ByVal expected, ByVal testName)
- Dim ok: ok = True
- Dim i
- If (UBound(actual) <> UBound(expected)) Then
- ok = False
- Else
- For i = 0 To UBound(actual)
- If actual(i) <> expected(i) Then
- ok = False
- Exit For
- End If
- Next
- End If
-
- If ok Then
- passed = passed + 1
- WScript.Echo "PASS: " & testName
- Else
- failed = failed + 1
- WScript.Echo "FAIL: " & testName & " | expected=" & ArrayToString(expected) & " actual=" & ArrayToString(actual)
- End If
- End Sub
-
- Function ArrayToString(ByVal arr)
- Dim i, s
- s = "["
- For i = 0 To UBound(arr)
- If i > 0 Then s = s & ", "
- s = s & FormatValue(arr(i))
- Next
- s = s & "]"
- ArrayToString = s
- End Function
-
- Function FormatValue(ByVal v)
- If IsNull(v) Then
- FormatValue = "<null>"
- ElseIf IsObject(v) Then
- FormatValue = "<object>"
- ElseIf IsArray(v) Then
- FormatValue = "<array>"
- Else
- FormatValue = Chr(34) & CStr(v) & Chr(34)
- End If
- End Function
-
- Function LoadChilkatSerial(ByVal filePath)
- LoadChilkatSerial = ""
-
- If Not fso.FileExists(filePath) Then
- Exit Function
- End If
-
- Dim serialFile
- Set serialFile = fso.OpenTextFile(filePath, ForReading, False, TristateFalse)
- LoadChilkatSerial = Trim(serialFile.ReadAll)
- serialFile.Close
- Set serialFile = Nothing
- End Function
|