Option Explicit Const ForReading = 1 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 objFSO Dim DataDirectory Dim functionNames functionNames = Array( _ "PadLeft", _ "CheckForFiles", _ "Truncate", _ "PadString", _ "CleanNull", _ "Assign", _ "Choice", _ "CompressArray", _ "TrimLeadingZeros", _ "PushNonEmptyToBottom", _ "GetState", _ "GetCityFromLine" _ ) LoadFunctions sourcePath, functionNames 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 WScript.Echo "" WScript.Echo "Passed: " & passed WScript.Echo "Failed: " & failed If failed > 0 Then WScript.Quit 1 End If 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 = "" Else FormatValue = "\"" & CStr(v) & "\"" End If End Function