home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / ProjectX1_562922192002.psc / Modules / modStuffX2.bas < prev    next >
Encoding:
BASIC Source File  |  1997-02-19  |  2.5 KB  |  125 lines
  1. Attribute VB_Name = "modStuffX2"
  2. Option Explicit
  3.  
  4. Public Function TvParseIt(HTMLData As String) As String
  5. '-----------------------------------
  6. '-    TvParseIt(HTMLData)
  7. '-   HTMLData is the string with the HTML code in
  8. '-
  9. '-  It'll return the extracted text
  10. '-
  11. '-   By T-Virus Creations
  12. '- http://www.tvirusonline.be
  13. '- email: tvirus4ever@yahoo.co.uk
  14. '-
  15. '-----------------------------------
  16.  
  17. Dim X As String
  18. Dim p As Long
  19. Dim i As Long
  20. Dim s As String
  21. Dim d As String
  22. Dim q As Long
  23. X = HTMLData
  24. X = X + ">}" 'To Be Sure
  25. p = Len(X)
  26.  
  27.  
  28. For i = 1 To p
  29. s = Mid$(X, i, 1)
  30. If s = "<" Then
  31. For q = i To p
  32. s = Mid$(X, q, 1)
  33. If s = ">" Then
  34. i = i + q - i
  35. GoTo 10
  36. End If
  37.  
  38. Next
  39. End If
  40. If s = "{" Then
  41. For q = i To p
  42. s = Mid$(X, q, 1)
  43. If s = "}" Then
  44. i = i + q - i
  45. GoTo 10
  46. End If
  47.  
  48. Next
  49. End If
  50. d = d + s
  51. 10
  52. Next
  53. d = Replace(d, "<", "", 1, Len(d), vbTextCompare)
  54. d = Replace(d, ">", "", 1, Len(d), vbTextCompare)
  55. d = Replace(d, "{", "", 1, Len(d), vbTextCompare)
  56. d = Replace(d, "}", "", 1, Len(d), vbTextCompare)
  57. TvParseIt = d
  58. End Function
  59.  
  60. Public Sub SaveHTML2TXT(HTMLText As String, TXTLocation As String)
  61. '-----------------------------------
  62. '-    SaveHTML2TXT(HTMLText,TXTLocation)
  63. '-   HTMLText is the string with the HTML code in
  64. '- TXTLocation is a string pointing to the location where to save to
  65. '-
  66. '-  It'll save the extracted text to a file
  67. '- It needs the TvParseIt Function to work
  68. '-
  69. '-   By T-Virus Creations
  70. '- http://www.tvirusonline.be
  71. '- email: tvirus4ever@yahoo.co.uk
  72. '-
  73. '-----------------------------------
  74. On Error GoTo 10
  75. Open TXTLocation For Output As #1
  76.  Print #1, TvParseIt(HTMLText)
  77. Close #1
  78. Exit Sub
  79. 10
  80. On Error Resume Next
  81. Close #1
  82. End Sub
  83.  
  84.  
  85. Public Sub SaveHTMLFile2TXTFile(HTMLLocation As String, TXTLocation As String)
  86. '-----------------------------------
  87. '-    SaveHTML2TXT(HTMLText,TXTLocation)
  88. '-   HTMLText is the location of the HTML file(a string)
  89. '- TXTLocation is a string pointing to the location where to save to
  90. '-
  91. '-  It'll save the extracted text to a file
  92. '- It needs the TvParseIt Function to work
  93. '-
  94. '-   By T-Virus Creations
  95. '- http://www.tvirusonline.be
  96. '- email: tvirus4ever@yahoo.co.uk
  97. '-
  98. '-----------------------------------
  99. Dim X As String
  100. Dim d As String
  101. Dim z As String
  102. Open HTMLLocation For Input As #1
  103. While EOF(1) = False
  104. Line Input #1, z
  105. If d = "" Then
  106. d = z
  107. End If
  108. Debug.Print z
  109. d = d + vbCrLf + z
  110. 'Debug.Print d
  111. '
  112. Wend
  113.  
  114.  
  115. Close #1
  116.  
  117. Open TXTLocation For Output As #1
  118.  Print #1, TvParseIt(d)
  119. Close #1
  120. Exit Sub
  121.  
  122. Close #1
  123. End Sub
  124.  
  125.