home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 March / Chip_2000-03_cd.bin / zkuste / VBasic / Data / Zdroj / htmltext.bas < prev    next >
BASIC Source File  |  1999-09-01  |  27KB  |  693 lines
  1. Attribute VB_Name = "Module1"
  2. Option Compare Text
  3. Option Explicit
  4. Public Function HTML2Text(HTMLString As String, Optional SaveAsFile As String) As String
  5. 'USAGE:
  6. 'INPUT:  A string containg HTML tags,
  7. 'such as a web page.
  8.  
  9.  
  10.  
  11. 'RETURNS:  The text only, with the HTML tags stripped.
  12.  
  13. 'OPTIONAL PARAMETER: The full path of a file name you
  14. 'want to save the text to.
  15.  
  16.   Const MAX_ROW_LENGTH = 65
  17.   Const MAX_LINE_LENGTH = 75
  18.   
  19.   Dim sHTML As String
  20.   Dim sOut As String
  21.   Dim sWkg As String
  22.   Dim lLen As Long
  23.   Dim lngLoop As Long, lngCtr As Long
  24.  
  25.   Dim sChar As String
  26.   Dim sTag As String
  27.   Dim bBodyStart As Boolean, bBodyTag As Boolean
  28.   
  29.   Dim bPrevSpace As Boolean
  30.   Dim sCharCode As String
  31.   Dim bOL As Boolean, bUL As Boolean
  32.   Dim iPlaceInList As Integer
  33.   
  34.   Dim iFileNum As Integer
  35.   
  36.   Dim bOneCrLf As Boolean
  37.   Dim bTwoCrlf As Boolean
  38.   Dim lTempCtr As Long, iTempCtr As Integer
  39.   Dim lTempCtr2 As Long
  40.  
  41.   Dim bFormatCell As Boolean
  42.   
  43.   Dim lRowLength As Long
  44.   Dim iLineCount As Integer
  45.   
  46.   
  47.   Dim bInComment As Boolean
  48.   Dim sTemp As String, sTemp2 As String
  49.   
  50.   
  51.   Dim bFlag As Boolean
  52.   Dim bSubFlag As Boolean
  53.   
  54.   Dim bOutputCells As Boolean
  55.   Dim lRowCharCount As Long
  56.   Dim sNestedTag As String
  57.   Dim sCharInCell As String
  58.   Dim sTagInCell As String
  59.   Dim sEndTag As String
  60.   
  61.   Dim bInCells As Boolean
  62.   Dim bInScript As Boolean
  63.   
  64.  
  65.   sHTML = HTMLString
  66.   lLen = Len(sHTML)
  67.  
  68.   For lngCtr = 1 To lLen
  69.  
  70.     sTag = ""
  71.     sChar = Mid(sHTML, lngCtr, 1)
  72.     
  73.  
  74.         If sChar = "<" And Not bInComment Then
  75.      
  76.  
  77.                 lngCtr = lngCtr + 1
  78.                 lngLoop = 1
  79.                 sWkg = ""
  80.                 'start new loop to get the tag name
  81.                 Do
  82.                 'if we never find end, then we must exit
  83.                 If lngCtr = lLen Then Exit For
  84.  
  85.                 sChar = Mid(sHTML, lngCtr, 1)
  86.                     If sChar <> ">" Then
  87.                         sWkg = sWkg & sChar
  88.                         
  89.                         lngCtr = lngCtr + 1
  90.                         
  91.                      End If
  92.  
  93.                      If sChar = ">" Or lngCtr >= lLen Then
  94.                         If lngCtr < lLen Then
  95.                             If Mid(sHTML, lngCtr + 1, 1) < 32 Then bPrevSpace = True
  96.                         End If
  97.                         'lTempCtr = lngCtr
  98.  
  99.                         Exit Do
  100.                        End If
  101.                         
  102.                         
  103.                     
  104.                     If RemoveAllSpaces(sWkg = "!--") Then Exit Do
  105.                
  106.                      
  107.                      'lngCtr = lngCtr + 1
  108.                       
  109.                     Loop
  110.                     sTag = Trim(sWkg)
  111.           
  112.                      'determine if another tag is coming because
  113.                         'if so, we don't want to output any spaces.
  114.         
  115.                         bFlag = False
  116.                         bSubFlag = False
  117.                         lTempCtr = lngCtr + 1
  118.                         If lTempCtr >= lLen Then Exit For
  119.                         sTemp = Mid(sHTML, lTempCtr, 1)
  120.                         If Asc(sTemp) <= 32 Then
  121.                             sTemp = ""
  122.                     
  123.                           
  124.                             Do
  125.                       
  126.                                 sTemp = sTemp & Mid(sHTML, lTempCtr, 1)
  127.                                 If sTemp = "<" Then
  128.                                     If bFlag Then bPrevSpace = True
  129.                                     Exit Do
  130.                                 
  131.                                 ElseIf Asc(sTemp) > 32 Then
  132.                             
  133.                                     bPrevSpace = Not (bSubFlag)
  134.                                 
  135.                                     Exit Do
  136.                                 ElseIf Asc(sTemp) <= 32 Then
  137.                                     bFlag = True
  138.                                     bSubFlag = Asc(sTemp) = 32
  139.                             
  140.                                 End If
  141.                        
  142.                             
  143.                                 lTempCtr = lTempCtr + 1
  144.                                 If lTempCtr >= lLen Then Exit For
  145.                                 sTemp = ""
  146.                             Loop
  147.                         End If
  148.     
  149.                     'Certain tags interest us: TITLE, <BR><P>
  150.                   
  151.                     If InStr(Left(sTag, 1), "/") = 0 Then
  152.                          If Left(sTag, 5) = "TITLE" Then
  153.                          lngCtr = lngCtr + 1
  154.                            
  155.                             Do
  156.                                 
  157.                                 sChar = Mid(sHTML, lngCtr, 1)
  158.  
  159.                                 If (sChar = "<" And sChar <> Chr$(13) And sChar <> Chr$(10)) Or lngCtr = lLen Then
  160.                                     If Not bInComment And Not bInScript Then sOut = sOut & vbCrLf & vbCrLf
  161.                                     iLineCount = 0
  162.                                     bTwoCrlf = True
  163.                                     lngCtr = lngCtr - 1
  164.                                     Exit Do
  165.                                 End If
  166.                                
  167.                             sOut = sOut & sChar
  168.                          
  169.                             lngCtr = lngCtr + 1
  170.                             Loop
  171.                         ElseIf Left(sTag, 4) = "BODY" And Not bInScript Then
  172.                             bBodyTag = True
  173.                         ElseIf (sTag = "P" Or Left(sTag, 2) = "P ") And Not bInScript Then
  174.                            If bBodyStart And Not bTwoCrlf And Not bInScript And Not bInComment Then
  175.                                 sOut = sOut & vbCrLf & vbCrLf
  176.                                 iLineCount = 0
  177.                                 bTwoCrlf = True
  178.                             End If
  179.                         ElseIf (sTag = "TR" Or Left(sTag, 3) = "TR ") And Not bInScript Then
  180.                                 
  181.                                 lTempCtr = lngCtr + 1
  182.                                 lRowCharCount = 0
  183.                                 bFlag = False
  184.                                 Do
  185.                                     sTemp = Mid(sHTML, lTempCtr, 1)
  186.                                         If sTemp = "<" Then 'get name of tag
  187.                                             sNestedTag = ""
  188.                                             Do
  189.                                                 lTempCtr = lTempCtr + 1
  190.                                                 If lTempCtr >= lLen Then Exit For
  191.                                                 sTemp2 = Mid(sHTML, lTempCtr, 1)
  192.                                                 If sTemp2 = ">" Then Exit Do
  193.                                                 sNestedTag = sNestedTag & sTemp2
  194.                                             Loop
  195.                                         End If
  196.                                         
  197.                                         If (sNestedTag = "/TR" Or sNestedTag = "/TABLE") And Not bInScript Then
  198.                                             bOutputCells = (lRowCharCount < MAX_ROW_LENGTH)
  199.                                             Exit Do
  200.                                         ElseIf (sNestedTag = "TABLE" Or Left$(sNestedTag, 6) = "TABLE ") And Not bInScript Then
  201.                                             bOutputCells = False
  202.                                             Exit Do
  203.                                         ElseIf (sNestedTag = "TD" Or Left$(sNestedTag, 3) = "TD " _
  204.                                             Or sNestedTag = "TH" Or Left$(sNestedTag, 3) = "TH ") And Not bInScript Then
  205.                                             lTempCtr = lTempCtr + 1
  206.                                             
  207.                                             bFlag = False
  208.                                                 Do
  209.                                                 If lTempCtr >= lLen Then Exit For
  210.                                                 sCharInCell = Mid(sHTML, lTempCtr, 1)
  211.                                                 Select Case sCharInCell
  212.                                                     Case "<" 'nested tag
  213.                                                         lTempCtr = lTempCtr + 1
  214.                                                         sTagInCell = ""
  215.                                                          Do
  216.                                                           If lTempCtr >= lLen Then Exit For
  217.                                                            sTemp2 = Mid(sHTML, lTempCtr, 1)
  218.                                                             If sTemp2 <> ">" Then
  219.                                                              sTagInCell = sTagInCell & sTemp2
  220.                                                            Else
  221.                                                             Exit Do
  222.                                                            End If
  223.                                                            lTempCtr = lTempCtr + 1
  224.                                                          Loop
  225.                                                        
  226.                                                          
  227.                                                         If RemoveAllSpaces(sTagInCell) = "/TD" Then
  228.                                                             sNestedTag = ""
  229.                                                             Exit Do
  230.                                                         ElseIf (sTagInCell = "P" Or Left$(sTagInCell, 2) = "P " _
  231.                                                             Or sTagInCell = "BR" Or Left$(sTagInCell, 3) _
  232.                                                             = "BR ") And Not bInScript Then
  233.                                                                 
  234.                                                                 lRowCharCount = MAX_ROW_LENGTH + 1
  235.                                                                 Exit Do
  236.                                                        End If
  237.                                                         Case Else
  238.                                                             If Not bFlag And Not bInScript Then lRowCharCount = lRowCharCount + 1
  239.                                                         End Select
  240.                                                       lTempCtr = lTempCtr + 1
  241.                                                     Loop
  242.                                                 End If 'td tag
  243.                                                 
  244.                                     If lTempCtr = lLen Then Exit For
  245.                                     lTempCtr = lTempCtr + 1
  246.                                   Loop 'loop begins under the TR condition
  247.                                lRowCharCount = 0
  248.                               
  249.                                 sOut = sOut & vbCrLf
  250.                                 iLineCount = 0
  251.                                 bOneCrLf = True
  252.                            
  253.                                bInCells = False
  254.                         ElseIf sTag = "TD" Or Left(sTag, 3) = "TD " _
  255.                             Or sTag = "TH" Or Left(sTag, 3) = "TH " Then
  256.                                 If bOutputCells Then
  257.                                    If bInCells Then sOut = sOut & Space$(3)
  258.                                    bInCells = True
  259.                                 Else
  260.                                     sOut = sOut & vbCrLf
  261.                                     bOneCrLf = True
  262.                                End If
  263.                         
  264.                         ElseIf sTag = "BR" Or sTag = "TABLE" Or Left$(sTag, 5) = "TABLE" Then
  265.                               If bBodyStart And Not bOneCrLf Then
  266.                                     sOut = sOut & vbCrLf
  267.                                     iLineCount = 0
  268.                                     bOneCrLf = True
  269.                                 End If
  270.                         ElseIf sTag = "OPTION" Or Left(sTag, 7) = "OPTION " Then
  271.                                 sOut = sOut & vbCrLf & vbTab
  272.                                 iLineCount = 0
  273.                         ElseIf sTag = "SCRIPT" Or Left(sTag, 7) = "SCRIPT " Then
  274.                                 bInScript = True
  275.                                 
  276.                         ElseIf Left(sTag, 3) = "!--" And bBodyTag Then
  277.                                 bInComment = True
  278.                         ElseIf sTag = "OL" Or Left(sTag, 3) = "OL " Then
  279.                             bOL = True
  280.                             sOut = sOut & vbCrLf & vbCrLf
  281.                             iLineCount = 0
  282.                         ElseIf sTag = "UL" Or Left(sTag, 3) = "UL " Then
  283.                             bUL = True
  284.                             sOut = sOut & vbCrLf & vbCrLf
  285.                             iLineCount = 0
  286.                         ElseIf sTag = "LI" Or Left(sTag, 3) = "LI " Then
  287.                             'if not in the middle of a numbered list, just add bullet
  288.                             sOut = sOut & vbCrLf
  289.                             iLineCount = 0
  290.                             If bOL Then
  291.                                 iPlaceInList = iPlaceInList + 1
  292.                                 sOut = sOut & iPlaceInList & ". "
  293.                                 iLineCount = iLineCount + 2
  294.                             Else
  295.                                 sOut = sOut & Chr$(149) & " "
  296.                                 iLineCount = iLineCount + 2
  297.                             End If
  298.                             
  299.                         End If
  300.  
  301.                     Else 'end tag
  302.                     
  303.                     If Left(RemoveAllSpaces(sTag), 7) = "/SCRIPT" Then bInScript = False
  304.                       
  305.                       If bBodyStart Then
  306.                         'we need to find the end for bOL and bUL
  307.                         'if you want to process other end tags
  308.                         'do it here.
  309.                         Select Case Left(RemoveAllSpaces(sTag), 3)
  310.                             Case "/OL"
  311.                                 bOL = False
  312.                                 If Not bTwoCrlf Then
  313.                                     sOut = sOut & vbCrLf & vbCrLf
  314.                                     iLineCount = 0
  315.                                     bTwoCrlf = True
  316.                                 End If
  317.                                 iPlaceInList = 0
  318.                             Case "/UL"
  319.                                 bUL = False
  320.                                 If Not bTwoCrlf Then
  321.                                     sOut = sOut & vbCrLf & vbCrLf
  322.                                     iLineCount = 0
  323.                                     bTwoCrlf = True
  324.                                 End If
  325.                             End Select
  326.                     
  327.                     End If 'instr(stag, "/")
  328.                 End If 'bbodystart
  329.  
  330.            Else 'not a tag
  331.             sChar = Mid(sHTML, lngCtr, 1)
  332.            If bBodyTag Then
  333.             Select Case sChar
  334.                 Case "<" 'another new tag
  335.                 If Not bInComment And Not bInScript Then
  336.                     lngCtr = lngCtr - 1 'go back and let top of loop handle tag
  337.                     sTag = ""
  338.                     sWkg = ""
  339.                 End If
  340.  
  341.                 Case " "
  342.                     'only one space is processed in HTML
  343.                     'rest are ignored
  344.                     If bPrevSpace = False Then
  345.                         If Not bInComment And Not bInScript Then sOut = sOut & sChar
  346.                         bPrevSpace = True
  347.                         iLineCount = iLineCount + 1
  348.                         
  349.                         If iLineCount >= MAX_LINE_LENGTH Then
  350.                             sOut = sOut & vbCrLf
  351.                             iLineCount = 0
  352.                         End If
  353.                     End If
  354.                 Case "-" 'see if this is the end of the comment
  355.                 If bBodyStart Then
  356.                     If bInComment Then
  357.                          sTemp = ""
  358.                         
  359.                        
  360.                         lTempCtr = lngCtr
  361.                         lTempCtr2 = 0
  362.                         
  363.                         Do
  364.                             sTemp = sTemp & Mid(sHTML, lTempCtr, 1)
  365.                             
  366.                             If Mid(sHTML, lTempCtr, 1) = ">" Then
  367.                                 sTemp2 = RemoveAllSpaces(sTemp)
  368.                                 If Right$(sTemp2, 3) = "-->" Then
  369.                                     bInComment = False
  370.                                     Exit Do
  371.                                 End If
  372.                             End If
  373.                             If lTempCtr = lLen Then Exit For
  374.                             lTempCtr = lTempCtr + 1
  375.                             lTempCtr2 = lTempCtr2 + 1
  376.                         Loop
  377.                         If lTempCtr < lLen Then lngCtr = lngCtr + lTempCtr2
  378.                     Else
  379.                         
  380.                         bPrevSpace = False
  381.                         sOut = sOut & "-"
  382.                         bOneCrLf = False
  383.                         bTwoCrlf = False
  384.                         iLineCount = iLineCount + 1
  385.                      End If
  386.                  End If
  387.                 Case "&" 'special character code, or maybe just an ampersand
  388.                     
  389.                     sTemp = ""
  390.                     bFlag = False
  391.                    
  392.                         For lTempCtr = (lngCtr + 1) To (lngCtr + 7)
  393.                             sTemp = Mid(sHTML, lTempCtr, 1)
  394.                             If sTemp = ";" Then
  395.                                 bFlag = True
  396.                                 Exit For
  397.                             ElseIf sTemp = "&" Then
  398.                                 bFlag = False
  399.                                 Exit For
  400.                             End If
  401.                         
  402.                         Next
  403.                     
  404.                 If bFlag Then
  405.                     sCharCode = ""
  406.                     lngCtr = lngCtr + 1
  407.                     Do
  408.                         sChar = Mid(sHTML, lngCtr, 1)
  409.                         If sChar = ";" Then Exit Do
  410.                         sCharCode = sCharCode + sChar
  411.                         lngCtr = lngCtr + 1
  412.                         
  413.                     Loop
  414.                     'special character. must end with ";"
  415.                     If Not bInComment And Not bInScript Then
  416.                         sTemp2 = HTMLSpecChar2ASCII(sCharCode)
  417.                         sOut = sOut & sTemp2
  418.                         bPrevSpace = False
  419.                         bOneCrLf = False
  420.                         bTwoCrlf = False
  421.                         iLineCount = iLineCount + Len(sTemp2)
  422.                     End If
  423.                 Else
  424.                     If Not bInComment And Not bInScript Then
  425.                         sOut = sOut & "&"
  426.                         bPrevSpace = False
  427.                         bOneCrLf = False
  428.                         bTwoCrlf = False
  429.                         iLineCount = iLineCount + 1
  430.                     End If
  431.                 End If
  432.  
  433.  
  434.                 Case Else
  435.                     bBodyStart = True
  436.                     'asc below 31 = nonprintable
  437.                   If Asc(sChar) < 31 Then
  438.                     If bPrevSpace = False Then
  439.                          If Not bInComment And Not bInScript Then sOut = sOut & " "
  440.                          iLineCount = iLineCount + 1
  441.                          bPrevSpace = True
  442.                          
  443.                          If iLineCount >= MAX_LINE_LENGTH Then
  444.                             sOut = sOut & vbCrLf
  445.                             iLineCount = 0
  446.                         End If
  447.                     End If
  448.                 Else
  449.                     If Not bInComment And Not bInScript And Asc(sChar) > 31 Then
  450.                         sOut = sOut & sChar
  451.                         
  452.                         bPrevSpace = False
  453.                         bOneCrLf = False
  454.                         bTwoCrlf = False
  455.                         iLineCount = iLineCount + 1
  456.                   
  457.                     End If
  458.                 End If
  459.             End Select
  460.             End If 'bbodystart
  461.         End If 'sChar = "<"
  462.  
  463.     DoEvents
  464.  
  465.    
  466.     Next
  467.  
  468.  
  469.  
  470.   'return output
  471. HTML2Text = sOut
  472.  
  473.   If SaveAsFile <> "" Then
  474.     On Error GoTo ErrorHandler
  475.     'save output to string
  476.     iFileNum = FreeFile
  477.     Open SaveAsFile For Output As #iFileNum
  478.     Print #iFileNum, sOut
  479.     Close #iFileNum
  480.     
  481.   End If
  482.  
  483.  
  484. Exit Function
  485. ErrorHandler:
  486.  
  487. On Error Resume Next
  488. Close #iFileNum
  489. Exit Function
  490.  
  491. End Function
  492.  
  493. Private Function BinaryEqualityTest(String1 As String, _
  494. String2 As String) As Boolean
  495.  
  496.         BinaryEqualityTest = (StrComp(String1, String2, _
  497.            vbBinaryCompare) = 0)
  498.  
  499. End Function
  500. Private Function HTMLSpecChar2ASCII(ByVal HTMLCode As String) As String
  501.  
  502. Dim sAns As String, sInput As String
  503.  
  504. sInput = LCase(HTMLCode)
  505. If Left$(sInput, 1) = "#" Then
  506.    sInput = Mid(sInput, 2)
  507. End If
  508.  
  509. If IsNumeric(sInput) Then
  510.     sAns = Chr$(Val(sInput))
  511. Else
  512.     Select Case sInput
  513.     Case "quot"
  514.         sAns = ""
  515.     Case "amp"
  516.         sAns = "&"
  517.     Case "lt"
  518.         sAns = "<"
  519.     Case "gt"
  520.         sAns = ">"
  521.     Case "nbsp"
  522.         sAns = Chr$(160)
  523.     Case "iexcl"
  524.         sAns = Chr$(161)
  525.     Case "cent"
  526.         sAns = Chr$(162)
  527.     Case "pound"
  528.         sAns = Chr$(163)
  529.     Case "curren"
  530.         sAns = Chr$(164)
  531.     Case "yen"
  532.         sAns = Chr$(165)
  533.     Case "brvbar"
  534.         sAns = Chr$(166)
  535.     Case "sect"
  536.         sAns = Chr$(167)
  537.     Case "uml"
  538.         sAns = Chr$(168)
  539.     Case "copy"
  540.         sAns = Chr$(169)
  541.     Case "ordf"
  542.         sAns = Chr$(170)
  543.     Case "laquo"
  544.         sAns = Chr$(171)
  545.     Case "not"
  546.         sAns = Chr$(172)
  547.     Case "shy"
  548.         sAns = Chr$(173)
  549.     Case "reg"
  550.         sAns = Chr$(174)
  551.     Case "macr"
  552.         sAns = Chr$(175)
  553.     Case "deg"
  554.         sAns = Chr$(176)
  555.     Case "plusmn"
  556.         sAns = Chr$(177)
  557.     Case "sup2"
  558.         sAns = Chr$(178)
  559.     Case "sup3"
  560.         sAns = Chr$(179)
  561.     Case "acute"
  562.         sAns = Chr$(180)
  563.     Case "micro"
  564.         sAns = Chr$(181)
  565.     Case "para"
  566.         sAns = Chr$(182)
  567.     Case "middot"
  568.         sAns = Chr$(183)
  569.     Case "cedil"
  570.         sAns = Chr$(184)
  571.     Case "supl"
  572.         sAns = Chr$(185)
  573.     Case "ordm"
  574.         sAns = Chr$(186)
  575.     Case "raquo"
  576.         sAns = Chr$(187)
  577.     Case "frac14"
  578.         sAns = Chr$(188)
  579.     Case "frac12"
  580.         sAns = Chr$(189)
  581.     Case "frac34"
  582.         sAns = Chr$(190)
  583.     Case "iquest"
  584.         sAns = Chr$(191)
  585.     Case "agrave"
  586.        sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(224), Chr$(192))
  587.     Case "aacute"
  588.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(225), Chr$(193))
  589.     Case "acirc"
  590.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(226), Chr$(194))
  591.     Case "atilde"
  592.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(227), Chr$(195))
  593.     Case "auml"
  594.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(228), Chr$(196))
  595.     Case "aring"
  596.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(229), Chr$(197))
  597.     Case "aelig"
  598.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(230), Chr$(198))
  599.     Case "ccedil"
  600.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(231), Chr$(199))
  601.     Case "egrave"
  602.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(232), Chr$(200))
  603.     Case "eacute"
  604.          sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(233), Chr$(201))
  605.     Case "ecirc"
  606.          sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(234), Chr$(202))
  607.     Case "euml"
  608.          sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(235), Chr$(203))
  609.     Case "igrave"
  610.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(236), Chr$(204))
  611.     Case "iacute"
  612.          sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(237), Chr$(205))
  613.     Case "icirc"
  614.          sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(238), Chr$(206))
  615.     Case "iuml"
  616.          sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(239), Chr$(207))
  617.     Case "eth"
  618.          sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(240), Chr$(208))
  619.     Case "ntilde"
  620.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(241), Chr$(209))
  621.     Case "ograve"
  622.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(242), Chr$(210))
  623.     Case "oacute"
  624.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(243), Chr$(211))
  625.     Case "ocirc"
  626.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(244), Chr$(212))
  627.     Case "otilde"
  628.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(245), Chr$(213))
  629.     Case "otilde"
  630.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(245), Chr$(213))
  631.     Case "ouml"
  632.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(246), Chr$(214))
  633.     Case "times"
  634.         sAns = Chr$(215)
  635.     Case "oslash"
  636.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(248), Chr$(216))
  637.     Case "ugrave"
  638.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(249), Chr$(217))
  639.     Case "uacute"
  640.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(250), Chr$(218))
  641.     Case "ucirc"
  642.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(251), Chr$(219))
  643.      Case "uuml"
  644.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(252), Chr$(220))
  645.      Case "yacute"
  646.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(253), Chr$(221))
  647.      Case "thorn"
  648.         sAns = IIf(BinaryEqualityTest(sInput, HTMLCode) = True, Chr$(254), Chr$(222))
  649.     Case "szlig"
  650.         sAns = Chr$(223)
  651.     Case "divide"
  652.         sAns = Chr$(247)
  653.     Case "yuml"
  654.         sAns = Chr$(255)
  655.     
  656.         
  657.     End Select
  658. End If
  659.  
  660. HTMLSpecChar2ASCII = sAns
  661. End Function
  662.  
  663. Private Function RemoveAllSpaces(ByVal InputString As String) _
  664. As String
  665.  
  666. Dim sAns As String
  667. Dim lLen As String
  668. Dim lCtr As Long, lCtr2 As Long
  669. Dim sChar As String
  670.  
  671.  
  672. lLen = Len(InputString)
  673. sAns = InputString
  674. lCtr2 = 1
  675.  
  676. For lCtr = 1 To lLen
  677.     sChar = Mid(InputString, lCtr, 1)
  678.     If sChar <> " " Then
  679.         Mid(sAns, lCtr2, 1) = sChar
  680.         lCtr2 = lCtr2 + 1
  681.     End If
  682. Next
  683.  
  684. If lCtr2 > 1 Then
  685.     sAns = Left(sAns, lCtr2 - 1)
  686. Else
  687.     sAns = ""
  688. End If
  689.  
  690. RemoveAllSpaces = sAns
  691. End Function
  692.  
  693.