Nelze vybrat více než 25 témat Téma musí začínat písmenem nebo číslem, může obsahovat pomlčky („-“) a může být dlouhé až 35 znaků.

lib.Helpers.asp 11KB

před 8 měsíci
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361
  1. <%
  2. '=======================================================================================================================
  3. ' IO Helpers
  4. '=======================================================================================================================
  5. Sub put(v)
  6. Select Case typename(v)
  7. Case "LinkedList_Class" : response.write join(v.TO_Array, ", ")
  8. Case "DynamicArray_Class" : response.write JoinList(v)
  9. Case "Variant()" : response.write join(v, ", ")
  10. Case else : response.write v
  11. End Select
  12. End Sub
  13. Sub put_
  14. put "<br>"
  15. End Sub
  16. Sub putl(v)
  17. put v
  18. put_
  19. End Sub
  20. 'accepts anything that can have an iterator, including lists, arrays, and recordsets
  21. Sub putlist(col, prefix, suffix)
  22. dim it : set it = IteratorFor(col)
  23. Do While it.HasNext
  24. put prefix & it.GetNext & suffix
  25. Loop
  26. End Sub
  27. 'same as join() for arrays, but for any arbitrary collection
  28. Function JoinList(col)
  29. dim s : s = ""
  30. dim it : set it = IteratorFor(col)
  31. Do While it.HasNext
  32. s = s & ", "
  33. Loop
  34. JoinList = Left(s, Len(s) - 2)
  35. End Function
  36. '---------------------------------------------------------------------------------------------------------------------
  37. 'Wrapper for Server.HTMLEncode() -- makes it easier on the eyes when reading the HTML code
  38. Function H(s)
  39. If Not IsEmpty(s) and Not IsNull(s) then
  40. H = Server.HTMLEncode(s)
  41. Else
  42. H = ""
  43. End If
  44. End Function
  45. '-----------------------------------------------------------------------------------------------------------------------
  46. 'allows tracing of output on demand without interfering with layout
  47. Sub trace(s)
  48. comment s
  49. End Sub
  50. '-----------------------------------------------------------------------------------------------------------------------
  51. 'outputs an HTML comment, useful for tracing etc
  52. Sub Comment(text)
  53. response.write vbcrlf & vbcrlf & "<!--" & vbcrlf & H(text) & vbcrlf & "-->" & vbcrlf & vbcrlf
  54. End Sub
  55. '-----------------------------------------------------------------------------------------------------------------------
  56. 'pseudo-design-by-contract capability, allows strong-typing of methods and views
  57. Sub ExpectType(obj_type, obj)
  58. if typename(obj) <> obj_type then Err.Raise 1, "lib.Helpers:ExpectType", "View expected object of type '" & obj_type & "' but received type '" & typename(obj) & "'."
  59. End Sub
  60. '=======================================================================================================================
  61. ' Dump* functions for dumping variables, objects, lists, etc for debugging purposes
  62. '=======================================================================================================================
  63. Class DataDumper_Class
  64. Public Sub Dump(V)
  65. put "<pre>"
  66. DumpIt V
  67. put "</pre>"
  68. End Sub
  69. Private m_indent
  70. Private Sub Indent
  71. m_indent = m_indent + 1
  72. 'putl "INDENT: " & m_indent
  73. 'puti m_indent
  74. 'put_
  75. End Sub
  76. Private Sub Dedent
  77. m_indent = m_indent - 1
  78. 'putl "INDENT: " & m_indent
  79. End Sub
  80. Private Sub Class_Initialize
  81. m_indent = -1 'first indent takes it to 0
  82. End Sub
  83. 'prepends indents
  84. Private Sub puti(v)
  85. put Spaces(m_indent) & v
  86. End Sub
  87. Private Sub DumpIt(V)
  88. If Typename(V) = "LinkedList_Class" then
  89. DumpList V
  90. ElseIf Instr(Typename(V), "_Class") > 0 then
  91. DumpClass V
  92. ElseIf Typename(V) = "Variant()" then
  93. DumpArray V
  94. ElseIf Typename(V) = "Recordset" then
  95. DumpRecordset V
  96. Else
  97. put "&laquo;" & H(V) & "&raquo;"
  98. End If
  99. End Sub
  100. Private Sub DumpList(V)
  101. Indent
  102. dim it : set it = V.Iterator
  103. dim item
  104. dim i : i = 1
  105. put_
  106. puti "[List:" & vbCR
  107. While it.HasNext
  108. Indent
  109. set item = it.GetNext()
  110. puti i & " => "
  111. DumpIt item
  112. put_
  113. Dedent
  114. i = i + 1
  115. Wend
  116. puti "]"
  117. Dedent
  118. End Sub
  119. Private Sub DumpArray(V)
  120. Indent
  121. dim i
  122. put_
  123. puti "[Array:" & vbCR
  124. Indent
  125. For i = 0 to UBound(V)
  126. puti i & " => "
  127. DumpIt V(i)
  128. put_
  129. Next
  130. Dedent
  131. puti "]"
  132. Dedent
  133. End Sub
  134. Private Sub DumpClass(C)
  135. Indent
  136. dim i
  137. put_
  138. puti "{" & Typename(C) & ": " & vbCR
  139. Indent
  140. On Error Resume Next
  141. If Ubound(C.Class_Get_Properties) > 0 then
  142. dim property_name, the_property
  143. For i = 0 to UBound(C.Class_Get_Properties)
  144. property_name = C.Class_Get_Properties(i)
  145. Execute "Assign the_property, C." & C.Class_Get_Properties(i)
  146. 'put "property_name: " & property_name & " (" & typename(the_property) & ")" & vbCR
  147. If typename(the_property) = "LinkedList_Class" then
  148. puti " " & property_name & " : LinkedList_Class => "
  149. DumpList(the_property)
  150. ElseIf InStr(typename(the_property), "_Class") then
  151. puti " " & property_name & " : " & typename(the_property) & " => "
  152. DumpClass(the_property)
  153. Else
  154. puti " " & property_name & " : " & typename(the_property) & " => " '& Eval("C." & property_name)
  155. DumpIt(the_property)
  156. If i <> UBound(C.Class_Get_Properties) then put ", "
  157. put vbCR
  158. End If
  159. Next
  160. Else
  161. End If
  162. On Error Goto 0
  163. Dedent
  164. puti "}" & vbCR & vbCR
  165. Dedent
  166. End Sub
  167. Sub DumpRecordset(R)
  168. Indent
  169. dim field
  170. put "<table border='1' cellpadding='5' >"
  171. put "<tr style='background-color: #333; color: white'>"
  172. For each field in R.Fields
  173. put "<th>" & field.Name & "</th>"
  174. Next
  175. put "</tr>"
  176. Do until R.EOF
  177. put "<tr style='background-color: white'>"
  178. For each field in R.Fields
  179. put "<td>" & H(R(field.Name)) & "</td>"
  180. Next
  181. put "</tr>"
  182. R.MoveNext
  183. Loop
  184. put "</table>"
  185. Dedent
  186. End Sub
  187. Private Function Spaces(num)
  188. dim s : s = ""
  189. dim i
  190. For i = 1 to num
  191. s = s & " "
  192. Next
  193. Spaces = s
  194. End Function
  195. End Class
  196. dim DataDumper_Class__Singleton
  197. Sub Dump(V)
  198. If IsEmpty(DataDumper_Class__Singleton) then
  199. set DataDumper_Class__Singleton = new DataDumper_Class
  200. End If
  201. DataDumper_Class__Singleton.Dump V
  202. End Sub
  203. '=======================================================================================================================
  204. ' Strings
  205. '=======================================================================================================================
  206. 'Capitalizes first word of the_string, leaves rest as-is
  207. Function Capitalize(the_string)
  208. Capitalize = ucase(left(the_string, 1)) & mid(the_string, 2)
  209. End Function
  210. '-----------------------------------------------------------------------------------------------------------------------
  211. Function Wrap(s, prefix, suffix)
  212. Wrap = prefix & s & suffix
  213. End Function
  214. '=======================================================================================================================
  215. ' Logic (i.e. decisions, searches, etc)
  216. '=======================================================================================================================
  217. 'TODO: Expand this to accept arbitrary sets, e.g. string, recordset, dictionary, list, etc.
  218. Function Contains(data, value)
  219. Contains = false
  220. dim idx
  221. select case typename(data)
  222. case "String"
  223. Contains = Choice(instr(data, value) > 0, true, false)
  224. case "Variant()"
  225. for idx = lbound(data) to ubound(data)
  226. if value = data(idx) then
  227. Contains = true
  228. exit for
  229. end if
  230. next
  231. case else
  232. Err.Raise 9, "mvc.helpers#Contains", "Unexpected type 'data', received: " & typename(data)
  233. end select
  234. End Function
  235. '-----------------------------------------------------------------------------------------------------------------------
  236. 'Boolean type checkers
  237. 'Don't forget IsArray is built-in!
  238. Function IsString(value)
  239. IsString = Choice(typename(value) = "String", true, false)
  240. End Function
  241. Function IsDict(value)
  242. IsDict = Choice(typename(value) = "Dictionary", true, false)
  243. End Function
  244. Function IsRecordset(value)
  245. IsRecordset = Choice(typename(value) = "Recordset", true, false)
  246. End Function
  247. Function IsLinkedList(value)
  248. IsLinkedList = Choice(typename(value) = "LinkedList_Class", true, false)
  249. End Function
  250. '-----------------------------------------------------------------------------------------------------------------------
  251. Sub Destroy(o)
  252. if isobject(o) then
  253. if not o is nothing then
  254. on error resume next
  255. o.close
  256. on error goto 0
  257. set o = nothing
  258. end if
  259. end if
  260. End Sub
  261. '-----------------------------------------------------------------------------------------------------------------------
  262. Sub Quit
  263. response.end
  264. End Sub
  265. Sub Die(msg)
  266. put "<span style='color: #f00'>" & msg & "</span>"
  267. Quit
  268. End Sub
  269. '-----------------------------------------------------------------------------------------------------------------------
  270. Sub DumpSession
  271. put "SESSION" & "<br>"
  272. dim session_item
  273. for each session_item in session.contents
  274. put "<b>" & session_item & "</b> : " & session.contents(session_item) & "<br>"
  275. next
  276. End Sub
  277. '=======================================================================================================================
  278. ' Adapted from Tolerable library
  279. '=======================================================================================================================
  280. ' This subroutine allows us to ignore the difference
  281. ' between object and primitive assignments. This is
  282. ' essential for many parts of the engine.
  283. Public Sub Assign(ByRef var, ByVal val)
  284. If IsObject(val) Then
  285. Set var = val
  286. Else
  287. var = val
  288. End If
  289. End Sub
  290. ' This is similar to the ? : operator of other languages.
  291. ' Unfortunately, both the if_true and if_false "branches"
  292. ' will be evalauted before the condition is even checked. So,
  293. ' you'll only want to use this for simple expressions.
  294. Public Function Choice(ByVal cond, ByVal if_true, ByVal if_false)
  295. If cond Then
  296. Assign Choice, if_true
  297. Else
  298. Assign Choice, if_false
  299. End If
  300. End Function
  301. ' Allows single-quotes to be used in place of double-quotes.
  302. ' Basically, this is a cheap trick that can make it easier
  303. ' to specify Lambdas.
  304. Public Function Q(ByVal input)
  305. Q = Replace(input, "'", """")
  306. End Function
  307. %>

Powered by TurnKey Linux.