您最多选择25个主题 主题必须以字母或数字开头,可以包含连字符 (-),并且长度不得超过35个字符

602 行
45KB

  1. Option Explicit
  2. Const ForReading = 1
  3. Const TristateFalse = 0
  4. Const TristateTrue = -1
  5. Dim fso:Set fso = CreateObject("Scripting.FileSystemObject")
  6. Dim scriptDir: scriptDir = fso.GetParentFolderName(WScript.ScriptFullName)
  7. Dim repoRoot: repoRoot = fso.GetParentFolderName(scriptDir)
  8. Dim sourcePath: sourcePath = fso.BuildPath(repoRoot, "ImportService\\TrackingDataImport.vbs")
  9. Dim chilkatSerialPath: chilkatSerialPath = fso.BuildPath(scriptDir, "chillkat_serial")
  10. Dim objFSO
  11. Dim DataDirectory
  12. Dim objCSV ' Required for ValidImportCSV
  13. Dim oConn
  14. Dim ConnectionString
  15. Dim ExportDirectory
  16. Dim integrationMdbPath
  17. Dim integrationExportDir
  18. Dim integrationDbAvailable
  19. Dim integrationDbSkipReason
  20. Dim wow64CScript
  21. Dim is64BitHost
  22. Dim sh
  23. Dim oExec
  24. Dim functionNames
  25. functionNames = Array( _
  26. "PadLeft", _
  27. "CheckForFiles", _
  28. "Truncate", _
  29. "PadString", _
  30. "CleanNull", _
  31. "Assign", _
  32. "Choice", _
  33. "CompressArray", _
  34. "TrimLeadingZeros", _
  35. "PushNonEmptyToBottom", _
  36. "GetState", _
  37. "GetCityFromLine", _
  38. "CheckStringDoesNotHaveForiegnCountries", _
  39. "ValidImportCSV", _
  40. "GetSetting", _
  41. "ExportInkjetFile" _
  42. )
  43. LoadFunctions sourcePath, functionNames
  44. Set objFSO = fso
  45. ' Initialize Chilkat CSV if available (required for ValidImportCSV tests)
  46. Dim chilkatAvailable
  47. Dim chilkatReason: chilkatReason = ""
  48. On Error Resume Next
  49. Dim glob
  50. Set glob = CreateObject("Chilkat_9_5_0.Global")
  51. If Err.Number <> 0 Then
  52. chilkatReason = "Chilkat_9_5_0.Global COM not available"
  53. Err.Clear
  54. Else
  55. Dim serialNumber: serialNumber = LoadChilkatSerial(chilkatSerialPath)
  56. If Len(serialNumber) = 0 Then
  57. chilkatReason = "missing serial in " & chilkatSerialPath
  58. Else
  59. Dim unlockSuccess: unlockSuccess = glob.UnlockBundle(serialNumber)
  60. If unlockSuccess <> 1 Then
  61. chilkatReason = "unlock failed"
  62. If Len(Trim(glob.LastErrorText & "")) > 0 Then
  63. chilkatReason = chilkatReason & " - " & Replace(Trim(glob.LastErrorText & ""), vbCrLf, " ")
  64. End If
  65. Else
  66. Set objCSV = CreateObject("Chilkat_9_5_0.Csv")
  67. If Err.Number = 0 Then
  68. chilkatAvailable = True
  69. Else
  70. chilkatReason = "Chilkat_9_5_0.Csv COM not available"
  71. Err.Clear
  72. End If
  73. End If
  74. End If
  75. End If
  76. On Error GoTo 0
  77. ' === Integration test DB probe ===
  78. wow64CScript = "C:\Windows\SysWOW64\cscript.exe"
  79. is64BitHost = (InStr(1, LCase(WScript.FullName), "syswow64") = 0) And fso.FileExists(wow64CScript)
  80. integrationMdbPath = fso.BuildPath(scriptDir, "..\Data\webdata - Copy.mdb")
  81. integrationExportDir = fso.BuildPath(scriptDir, "export-test-output")
  82. integrationDbAvailable = False
  83. integrationDbSkipReason = ""
  84. If Not fso.FileExists(integrationMdbPath) Then
  85. integrationDbSkipReason = "MDB fixture not found: " & integrationMdbPath
  86. Else
  87. Set oConn = CreateObject("ADODB.Connection")
  88. On Error Resume Next
  89. oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & integrationMdbPath & ";"
  90. If Err.Number <> 0 Then
  91. Err.Clear
  92. oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & integrationMdbPath & ";"
  93. End If
  94. If Err.Number <> 0 Then
  95. Dim failDesc : failDesc = Err.Description
  96. Err.Clear
  97. On Error GoTo 0
  98. If is64BitHost Then
  99. ' 64-bit cscript can't see 32-bit ACE/Jet drivers — re-run as 32-bit and relay output
  100. WScript.Echo "64-bit cscript: ADODB driver not found. Re-running as 32-bit cscript..."
  101. Set sh = CreateObject("WScript.Shell")
  102. Set oExec = sh.Exec("cmd /c " & wow64CScript & " //NoLogo " & Chr(34) & WScript.ScriptFullName & Chr(34) & " 2>&1")
  103. Do While Not oExec.StdOut.AtEndOfStream
  104. WScript.Echo oExec.StdOut.ReadLine()
  105. Loop
  106. WScript.Quit oExec.ExitCode
  107. Else
  108. integrationDbSkipReason = "No ADODB provider available (ACE and Jet both failed): " & failDesc
  109. End If
  110. Else
  111. integrationDbAvailable = True
  112. ConnectionString = oConn.ConnectionString
  113. ExportDirectory = integrationExportDir & "\"
  114. End If
  115. On Error GoTo 0
  116. If oConn.State = 1 Then oConn.Close
  117. End If
  118. Dim passed: passed = 0
  119. Dim failed: failed = 0
  120. Dim q: q = Chr(34)
  121. AssertEqual Truncate("abcdef", 3), q & "abc" & q & ",", "Truncate trims and quotes"
  122. AssertEqual Truncate("ab", 3), q & "ab" & q & ",", "Truncate short string"
  123. AssertEqual PadLeft("7", 3, "0"), "007", "PadLeft pads"
  124. AssertEqual PadLeft("1234", 3, "0"), "1234", "PadLeft no pad when longer"
  125. AssertEqual PadString("ab", 4), "ab ", "PadString right pads"
  126. AssertEqual PadString("abcd", 4), "abcd", "PadString same length"
  127. AssertEqual PadString(Null, 3), " ", "PadString null"
  128. AssertEqual CleanNull(Null), "", "CleanNull null"
  129. AssertEqual CleanNull("x"), "x", "CleanNull value"
  130. Dim arr
  131. arr = Array("", "a", "", "b")
  132. arr = CompressArray(arr)
  133. AssertArrayEqual arr, Array("a", "b", "", ""), "CompressArray moves blanks to end"
  134. AssertEqual TrimLeadingZeros("000123"), "123", "TrimLeadingZeros removes leading zeros"
  135. AssertEqual TrimLeadingZeros("0000"), "", "TrimLeadingZeros all zeros"
  136. Dim arr2
  137. arr2 = Array("a", "", "b", "")
  138. PushNonEmptyToBottom arr2
  139. AssertArrayEqual arr2, Array("", "", "a", "b"), "PushNonEmptyToBottom"
  140. AssertEqual GetState("Lansing, MI 48906"), "MI", "GetState matches state"
  141. AssertEqual GetState("No match"), "", "GetState no match"
  142. AssertEqual GetCityFromLine("Lansing, MI 48906"), "Lansing", "GetCityFromLine with comma"
  143. AssertEqual GetCityFromLine("NoComma"), "NoComma", "GetCityFromLine no comma"
  144. AssertEqual GetCityFromLine(Null), "", "GetCityFromLine null"
  145. Dim tempDir
  146. tempDir = fso.BuildPath(repoRoot, "Tests\\_tmp_checkforfiles")
  147. If Not fso.FolderExists(tempDir) Then
  148. fso.CreateFolder tempDir
  149. End If
  150. Set objFSO = fso
  151. DataDirectory = tempDir
  152. On Error Resume Next
  153. Dim checkResult
  154. checkResult = CheckForFiles()
  155. If Err.Number = 0 Then
  156. passed = passed + 1
  157. WScript.Echo "PASS: CheckForFiles runs without error (empty dir)"
  158. Else
  159. failed = failed + 1
  160. WScript.Echo "FAIL: CheckForFiles error " & Err.Number & " - " & Err.Description
  161. Err.Clear
  162. End If
  163. On Error GoTo 0
  164. ' === [P0] CheckStringDoesNotHaveForiegnCountries ===
  165. AssertEqual CheckStringDoesNotHaveForiegnCountries("123 Main St, Lansing MI 48906"), True, "[P0] CheckStringDoesNotHaveForiegnCountries clean US address"
  166. AssertEqual CheckStringDoesNotHaveForiegnCountries("123 Main St, CANADA"), False, "[P0] CheckStringDoesNotHaveForiegnCountries CANADA uppercase match"
  167. AssertEqual CheckStringDoesNotHaveForiegnCountries("Tokyo, JAPAN 12345"), False, "[P0] CheckStringDoesNotHaveForiegnCountries JAPAN uppercase match"
  168. AssertEqual CheckStringDoesNotHaveForiegnCountries("123 Norway Ave, Lansing MI"), True, "[P0] CheckStringDoesNotHaveForiegnCountries Norway Ave (behavior doc: InStr binary, Norway<>NORWAY)"
  169. AssertEqual CheckStringDoesNotHaveForiegnCountries("123 canada road"), True, "[P0] CheckStringDoesNotHaveForiegnCountries lowercase canada (behavior doc: case-sensitive, no match)"
  170. AssertEqual CheckStringDoesNotHaveForiegnCountries(""), True, "[P0] CheckStringDoesNotHaveForiegnCountries empty string"
  171. AssertEqual CheckStringDoesNotHaveForiegnCountries(Null), True, "[P0] CheckStringDoesNotHaveForiegnCountries null (InStr returns Null, falsy in If)"
  172. ' === [P0] GetState additional ===
  173. AssertEqual GetState("lansing, mi 48906"), "", "[P0] GetState lowercase state returns empty (behavior doc: IgnoreCase=False, mixed-case CSV misses)"
  174. AssertEqual GetState(""), "", "[P0] GetState empty string"
  175. ' === [P0] Choice with Null condition ===
  176. AssertEqual Choice(Null, "yes", "no"), "no", "[P0] Choice null condition evaluates as False branch"
  177. ' === [P0] ValidImportCSV (requires Chilkat_9_5_0.Csv COM) ===
  178. If chilkatAvailable Then
  179. Dim csv20col
  180. csv20col = "H1,H2,H3,H4,H5,H6,H7,H8,H9,H10,H11,H12,H13,H14,H15,H16,H17,H18,H19,H20" & vbCrLf & _
  181. "v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,v17,v18,v19,v20"
  182. AssertEqual ValidImportCSV(csv20col), True, "[P0] ValidImportCSV 20 columns accepted"
  183. Dim csv19col
  184. csv19col = "H1,H2,H3,H4,H5,H6,H7,H8,H9,H10,H11,H12,H13,H14,H15,H16,H17,H18,H19" & vbCrLf & _
  185. "v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,v17,v18,v19"
  186. AssertEqual ValidImportCSV(csv19col), False, "[P0] ValidImportCSV 19 columns rejected"
  187. AssertEqual ValidImportCSV(""), False, "[P0] ValidImportCSV empty string rejected"
  188. Else
  189. WScript.Echo "SKIP: ValidImportCSV tests skipped (" & chilkatReason & ")"
  190. End If
  191. ' === [P1] TrimLeadingZeros edge cases ===
  192. AssertEqual TrimLeadingZeros(""), "", "[P1] TrimLeadingZeros empty string"
  193. AssertEqual TrimLeadingZeros("abc"), "abc", "[P1] TrimLeadingZeros no leading zeros"
  194. AssertEqual TrimLeadingZeros("0"), "", "[P1] TrimLeadingZeros single zero"
  195. AssertEqual TrimLeadingZeros(" 007"), " 007", "[P1] TrimLeadingZeros leading space preserved (space is not zero)"
  196. ' === [P1] PadLeft edge cases ===
  197. AssertEqual PadLeft("007", 3, "0"), "007", "[P1] PadLeft exact length no padding"
  198. AssertEqual PadLeft("", 3, "0"), "000", "[P1] PadLeft empty string padded"
  199. ' === [P1] PadString edge cases ===
  200. AssertEqual PadString("abcde", 3), "abcde", "[P1] PadString longer than size returned as-is"
  201. AssertEqual PadString("", 3), " ", "[P1] PadString empty string padded to spaces"
  202. ' === [P1] CompressArray edge cases ===
  203. Dim arr3
  204. arr3 = Array("", "", "")
  205. arr3 = CompressArray(arr3)
  206. AssertArrayEqual arr3, Array("", "", ""), "[P1] CompressArray all-empty array unchanged"
  207. Dim arr4
  208. arr4 = Array("a", "b", "c")
  209. arr4 = CompressArray(arr4)
  210. AssertArrayEqual arr4, Array("a", "b", "c"), "[P1] CompressArray all-non-empty no swaps"
  211. Dim arr5
  212. arr5 = Array("a")
  213. arr5 = CompressArray(arr5)
  214. AssertArrayEqual arr5, Array("a"), "[P1] CompressArray single element"
  215. ' === [P2] Assign ===
  216. Dim v1
  217. Assign v1, "hello"
  218. AssertEqual v1, "hello", "[P2] Assign scalar string"
  219. Assign v1, 42
  220. AssertEqual v1, 42, "[P2] Assign scalar number"
  221. Assign v1, ""
  222. AssertEqual v1, "", "[P2] Assign empty string"
  223. Assign v1, 0
  224. AssertEqual v1, 0, "[P2] Assign zero"
  225. ' === [P2] Choice ===
  226. AssertEqual Choice(True, "yes", "no"), "yes", "[P2] Choice True branch"
  227. AssertEqual Choice(False, "yes", "no"), "no", "[P2] Choice False branch"
  228. AssertEqual Choice(1 = 1, "equal", "not"), "equal", "[P2] Choice computed True"
  229. AssertEqual Choice(1 = 2, "equal", "not"), "not", "[P2] Choice computed False"
  230. ' === ExportInkjetFile Integration Test ===
  231. If Not chilkatAvailable Then
  232. WScript.Echo "SKIP: ExportInkjetFile integration test (Chilkat unavailable)"
  233. ElseIf Not integrationDbAvailable Then
  234. WScript.Echo "SKIP: ExportInkjetFile integration test (" & integrationDbSkipReason & ")"
  235. Else
  236. oConn.Open ConnectionString
  237. Dim kitDiscoverRs
  238. Set kitDiscoverRs = oConn.Execute( _
  239. "SELECT TOP 1 ir.KitID FROM ((InkjetRecords ir " & _
  240. "INNER JOIN Kit k ON ir.KitID = k.ID) " & _
  241. "INNER JOIN Jurisdiction j ON k.JCode = j.JCode) " & _
  242. "INNER JOIN Contacts c ON k.JCode = c.JURISCODE WHERE ir.ID IN (SELECT TOP 500 ID FROM InkjetRecords ORDER BY ID);")
  243. If kitDiscoverRs.EOF Then
  244. WScript.Echo "SKIP: ExportInkjetFile - no complete Kit+InkjetRecords+Jurisdiction+Contact found in fixture MDB"
  245. oConn.Close
  246. Else
  247. Dim testKitID : testKitID = kitDiscoverRs("KitID").Value
  248. Dim countRs
  249. Set countRs = oConn.Execute("SELECT COUNT(*) AS N FROM InkjetRecords WHERE KitID=" & testKitID & ";")
  250. Dim expectedRows : expectedRows = countRs("N").Value
  251. Dim kitRsCheck
  252. Set kitRsCheck = oConn.Execute("SELECT JCode FROM Kit WHERE ID=" & testKitID & ";")
  253. Dim testJCode : testJCode = kitRsCheck("JCode").Value
  254. oConn.Close
  255. ' Delete stale output before call, then recreate
  256. On Error Resume Next
  257. If fso.FolderExists(integrationExportDir) Then fso.DeleteFolder integrationExportDir, True
  258. On Error GoTo 0
  259. fso.CreateFolder integrationExportDir
  260. On Error Resume Next
  261. ExportInkjetFile testKitID
  262. Dim exportErr : exportErr = Err.Number
  263. Dim exportDesc : exportDesc = Err.Description
  264. On Error GoTo 0
  265. If exportErr <> 0 Then
  266. WScript.Echo "FAIL: [INT] ExportInkjetFile error " & exportErr & " - " & exportDesc
  267. failed = failed + 1
  268. End If
  269. Dim exportSubfolders : Set exportSubfolders = fso.GetFolder(integrationExportDir).SubFolders
  270. Dim csvFound : csvFound = False
  271. Dim csvPath : csvPath = ""
  272. Dim sf
  273. For Each sf In exportSubfolders
  274. Dim csvFiles : Set csvFiles = sf.Files
  275. Dim f
  276. For Each f In csvFiles
  277. If LCase(fso.GetExtensionName(f.Name)) = "csv" Then
  278. csvFound = True
  279. csvPath = f.Path
  280. End If
  281. Next
  282. Next
  283. AssertEqual csvFound, True, "[INT] ExportInkjetFile: CSV file created"
  284. If csvFound Then
  285. Dim verifyCsv : Set verifyCsv = CreateObject("Chilkat_9_5_0.Csv")
  286. verifyCsv.HasColumnNames = 1
  287. Dim csvLoaded : csvLoaded = verifyCsv.LoadFile(csvPath)
  288. AssertEqual csvLoaded, 1, "[INT] ExportInkjetFile: CSV loaded by Chilkat"
  289. If csvLoaded Then
  290. AssertEqual verifyCsv.NumColumns, 22, "[INT] ExportInkjetFile: 22 columns"
  291. AssertEqual verifyCsv.GetColumnName(0), "Full Name", "[INT] ExportInkjetFile: col 0 = Full Name"
  292. AssertEqual verifyCsv.GetColumnName(5), "IM barcode Characters", "[INT] ExportInkjetFile: col 5 = IM barcode Characters"
  293. AssertEqual verifyCsv.GetColumnName(8), "Ballot Number", "[INT] ExportInkjetFile: col 8 = Ballot Number"
  294. AssertEqual verifyCsv.GetColumnName(11), "Combined Pct_Ballot Num", "[INT] ExportInkjetFile: col 11 = Combined Pct_Ballot Num"
  295. AssertEqual verifyCsv.GetColumnName(19), "Matching Code", "[INT] ExportInkjetFile: col 19 = Matching Code"
  296. AssertEqual verifyCsv.GetColumnName(20), "ColorFilepath", "[INT] ExportInkjetFile: col 20 = ColorFilepath"
  297. AssertEqual verifyCsv.GetColumnName(21), "ColorName", "[INT] ExportInkjetFile: col 21 = ColorName"
  298. AssertEqual verifyCsv.NumRows, expectedRows, "[INT] ExportInkjetFile: row count matches InkjetRecords"
  299. Dim checkRows : checkRows = 10
  300. If verifyCsv.NumRows < 10 Then checkRows = verifyCsv.NumRows
  301. Dim r
  302. For r = 0 To checkRows - 1
  303. Dim ballotNum : ballotNum = verifyCsv.GetCell(r, 8)
  304. AssertEqual (Left(ballotNum, 1) <> "0" Or ballotNum = ""), True, "[INT] ExportInkjetFile: row " & r & " Ballot Number no leading zeros"
  305. Dim matchCode : matchCode = verifyCsv.GetCell(r, 19)
  306. AssertEqual Left(matchCode, Len(testJCode)), testJCode, "[INT] ExportInkjetFile: row " & r & " Matching Code starts with JCode"
  307. Next
  308. End If
  309. Set verifyCsv = Nothing
  310. End If
  311. oConn.Open ConnectionString
  312. Dim sideEffectRs
  313. Set sideEffectRs = oConn.Execute("SELECT Status, InkJetJob FROM Kit WHERE ID=" & testKitID & ";")
  314. AssertEqual sideEffectRs("Status").Value, "Done", "[INT] ExportInkjetFile: Kit.Status = Done"
  315. Dim ijVal : ijVal = sideEffectRs("InkJetJob").Value
  316. Dim ijSet : ijSet = False
  317. If Not IsNull(ijVal) Then ijSet = CBool(ijVal)
  318. AssertEqual ijSet, True, "[INT] ExportInkjetFile: Kit.InkJetJob is set"
  319. oConn.Close
  320. ' Cleanup - error-suppressed (AV may briefly hold CSV handle)
  321. On Error Resume Next
  322. If fso.FolderExists(integrationExportDir) Then fso.DeleteFolder integrationExportDir, True
  323. On Error GoTo 0
  324. End If
  325. End If
  326. WScript.Echo ""
  327. WScript.Echo "Passed: " & passed
  328. WScript.Echo "Failed: " & failed
  329. If failed > 0 Then
  330. WScript.Quit 1
  331. End If
  332. Sub LoadFunctions(ByVal filePath, ByVal names)
  333. Dim fileText, lines, i, line
  334. Dim capturing: capturing = False
  335. Dim endKeyword: endKeyword = ""
  336. Dim block: block = ""
  337. If Not fso.FileExists(filePath) Then
  338. WScript.Echo "FAIL: Source file not found: " & filePath
  339. WScript.Quit 1
  340. End If
  341. With fso.OpenTextFile(filePath, ForReading, False, TristateTrue)
  342. fileText = .ReadAll
  343. .Close
  344. End With
  345. ' Normalize line endings and remove nulls/BOM that can appear in UTF-16 reads
  346. fileText = Replace(fileText, ChrW(&HFEFF), "")
  347. fileText = Replace(fileText, Chr(0), "")
  348. fileText = Replace(fileText, vbTab, " ")
  349. fileText = Replace(fileText, vbCrLf, vbLf)
  350. fileText = Replace(fileText, vbCr, vbLf)
  351. lines = Split(fileText, vbLf)
  352. For i = 0 To UBound(lines)
  353. line = lines(i)
  354. If Not capturing Then
  355. Dim nameIndex
  356. For nameIndex = 0 To UBound(names)
  357. Dim kind
  358. If TryStartLine(line, names(nameIndex), kind) Then
  359. capturing = True
  360. endKeyword = "End " & kind
  361. block = block & line & vbCrLf
  362. Exit For
  363. End If
  364. Next
  365. Else
  366. block = block & line & vbCrLf
  367. If LCase(Trim(line)) = LCase(endKeyword) Then
  368. capturing = False
  369. block = block & vbCrLf
  370. End If
  371. End If
  372. Next
  373. If Len(block) = 0 Then
  374. ' Fallback: simple text scan for each function/sub
  375. Dim nameIndex2
  376. For nameIndex2 = 0 To UBound(names)
  377. Dim extracted
  378. extracted = ExtractBlock(fileText, names(nameIndex2))
  379. If Len(extracted) > 0 Then
  380. block = block & extracted & vbCrLf & vbCrLf
  381. End If
  382. Next
  383. End If
  384. If Len(block) = 0 Then
  385. WScript.Echo "FAIL: No functions loaded from " & filePath
  386. WScript.Echo "Debug: file length=" & Len(fileText)
  387. WScript.Quit 1
  388. End If
  389. ExecuteGlobal block
  390. End Sub
  391. Function ExtractBlock(ByVal fileText, ByVal name)
  392. Dim lowerText, lowerName, startPos, endPos, kind, endToken
  393. lowerText = LCase(fileText)
  394. lowerName = LCase(name)
  395. startPos = FindDeclPos(lowerText, lowerName, "function")
  396. kind = "Function"
  397. If startPos = 0 Then
  398. startPos = FindDeclPos(lowerText, lowerName, "sub")
  399. kind = "Sub"
  400. End If
  401. If startPos = 0 Then
  402. ExtractBlock = ""
  403. Exit Function
  404. End If
  405. endToken = "end " & LCase(kind)
  406. endPos = InStr(startPos, lowerText, endToken)
  407. If endPos = 0 Then
  408. ExtractBlock = ""
  409. Exit Function
  410. End If
  411. endPos = endPos + Len(endToken) - 1
  412. ExtractBlock = Mid(fileText, startPos, endPos - startPos + 1)
  413. End Function
  414. Function FindDeclPos(ByVal lowerText, ByVal lowerName, ByVal keyword)
  415. Dim pos, idx, ch, nameLen, nextChar
  416. nameLen = Len(lowerName)
  417. pos = InStr(1, lowerText, keyword)
  418. Do While pos > 0
  419. idx = pos + Len(keyword)
  420. Do While idx <= Len(lowerText)
  421. ch = Mid(lowerText, idx, 1)
  422. If IsWs(ch) Then
  423. idx = idx + 1
  424. Else
  425. Exit Do
  426. End If
  427. Loop
  428. If LCase(Mid(lowerText, idx, nameLen)) = lowerName Then
  429. nextChar = Mid(lowerText, idx + nameLen, 1)
  430. If nextChar = "" Or Not IsNameChar(nextChar) Then
  431. FindDeclPos = pos
  432. Exit Function
  433. End If
  434. End If
  435. pos = InStr(pos + 1, lowerText, keyword)
  436. Loop
  437. FindDeclPos = 0
  438. End Function
  439. Function IsWs(ByVal ch)
  440. IsWs = (ch = " " Or ch = vbTab Or ch = vbLf Or ch = vbCr Or AscW(ch) = 160)
  441. End Function
  442. Function IsNameChar(ByVal ch)
  443. Dim code
  444. code = AscW(ch)
  445. IsNameChar = (code >= 48 And code <= 57) Or (code >= 65 And code <= 90) Or (code >= 97 And code <= 122) Or ch = "_"
  446. End Function
  447. Function TryStartLine(ByVal line, ByVal name, ByRef kind)
  448. Dim lowerLine, lowerName, pos
  449. lowerLine = LCase(line)
  450. lowerName = LCase(name)
  451. pos = FindDeclPos(lowerLine, lowerName, "function")
  452. If pos > 0 Then
  453. kind = "Function"
  454. TryStartLine = True
  455. Exit Function
  456. End If
  457. pos = FindDeclPos(lowerLine, lowerName, "sub")
  458. If pos > 0 Then
  459. kind = "Sub"
  460. TryStartLine = True
  461. Exit Function
  462. End If
  463. TryStartLine = False
  464. End Function
  465. Sub AssertEqual(ByVal actual, ByVal expected, ByVal testName)
  466. If actual = expected Then
  467. passed = passed + 1
  468. WScript.Echo "PASS: " & testName
  469. Else
  470. failed = failed + 1
  471. WScript.Echo "FAIL: " & testName & " | expected=" & FormatValue(expected) & " actual=" & FormatValue(actual)
  472. End If
  473. End Sub
  474. Sub AssertArrayEqual(ByVal actual, ByVal expected, ByVal testName)
  475. Dim ok: ok = True
  476. Dim i
  477. If (UBound(actual) <> UBound(expected)) Then
  478. ok = False
  479. Else
  480. For i = 0 To UBound(actual)
  481. If actual(i) <> expected(i) Then
  482. ok = False
  483. Exit For
  484. End If
  485. Next
  486. End If
  487. If ok Then
  488. passed = passed + 1
  489. WScript.Echo "PASS: " & testName
  490. Else
  491. failed = failed + 1
  492. WScript.Echo "FAIL: " & testName & " | expected=" & ArrayToString(expected) & " actual=" & ArrayToString(actual)
  493. End If
  494. End Sub
  495. Function ArrayToString(ByVal arr)
  496. Dim i, s
  497. s = "["
  498. For i = 0 To UBound(arr)
  499. If i > 0 Then s = s & ", "
  500. s = s & FormatValue(arr(i))
  501. Next
  502. s = s & "]"
  503. ArrayToString = s
  504. End Function
  505. Function FormatValue(ByVal v)
  506. If IsNull(v) Then
  507. FormatValue = "<null>"
  508. ElseIf IsObject(v) Then
  509. FormatValue = "<object>"
  510. ElseIf IsArray(v) Then
  511. FormatValue = "<array>"
  512. Else
  513. FormatValue = Chr(34) & CStr(v) & Chr(34)
  514. End If
  515. End Function
  516. Function LoadChilkatSerial(ByVal filePath)
  517. LoadChilkatSerial = ""
  518. If Not fso.FileExists(filePath) Then
  519. Exit Function
  520. End If
  521. Dim serialFile
  522. Set serialFile = fso.OpenTextFile(filePath, ForReading, False, TristateFalse)
  523. LoadChilkatSerial = Trim(serialFile.ReadAll)
  524. serialFile.Close
  525. Set serialFile = Nothing
  526. End Function

Powered by TurnKey Linux.