Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: Кодировка при чтении web страницы Добавлено: 16.02.09 18:14  

Автор вопроса:  gekko | Web-сайт: kalamfur.ru
Для получения кода страницы использовал пример из библиотеки:
http://vbnet.ru/faq/showtopic.asp?id=380

Споткнулся при чтении cwer.ru, т.к. он в UTF-8 и в текстовое поле вбивается чушь полная. Подскажите, как обойти глюк??

Ответить

  Ответы Всего ответов: 2  

Номер ответа: 1
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #1 		Добавлено: 17.02.09 00:44
Воспользуйся чем нибудь из этого:
  1. Option Explicit
  2. '(C)2002
  3. 'MAIL : http://www.geocities.co.jp/SilkRoad/4511/img/mailaddr.png
  4. 'HOME : http://www.geocities.co.jp/SilkRoad/4511/
  5. Public Const ISUTF8_DEFAULT_READSIZE = 1024
  6.  
  7. Public Function Utf8Encode(ByRef strUnicode As String, ByRef bytUtf8() As Byte) As Long
  8.     Dim lngUnicodeLength As Long
  9.     Dim lngUtf8Size As Long
  10.     Dim lngCharCode As Long
  11.     Dim i As Long
  12.  
  13.     lngUnicodeLength = Len(strUnicode)
  14.     If Not CBool(lngUnicodeLength) Then Exit Function
  15.     ReDim bytUtf8((lngUnicodeLength * 3) - 1)
  16.     
  17.     For i = 1 To lngUnicodeLength Step 1
  18.         lngCharCode = CLng(AscW(Mid$(strUnicode, i, 1))) And &HFFFF&
  19.         If lngCharCode <= &H7F& Then
  20.             bytUtf8(lngUtf8Size) = CByte(lngCharCode)
  21.             lngUtf8Size = lngUtf8Size + 1
  22.         ElseIf (lngCharCode >= &H80&) And (lngCharCode <= &H7FF&) Then
  23.             
  24.             bytUtf8(lngUtf8Size) = CByte((lngCharCode \ &H40&) Or &HC0&)
  25.             
  26.             bytUtf8(lngUtf8Size + 1) = CByte((lngCharCode And &H3F&) Or &H80&)
  27.             lngUtf8Size = lngUtf8Size + 2
  28.         ElseIf (lngCharCode >= &H800&) And (lngCharCode <= &HFFFF&) Then
  29.             
  30.             bytUtf8(lngUtf8Size) = CByte((lngCharCode \ &H1000&) Or &HE0&)
  31.             
  32.             bytUtf8(lngUtf8Size + 1) = CByte(((lngCharCode And &HFC0&) \ &H40&) Or &H80&)
  33.             
  34.             bytUtf8(lngUtf8Size + 2) = CByte((lngCharCode And &H3F&) Or &H80&)
  35.             lngUtf8Size = lngUtf8Size + 3
  36.         End If
  37.     Next i
  38.     
  39.     If lngUtf8Size Then
  40.         ReDim Preserve bytUtf8(lngUtf8Size - 1)
  41.         Utf8Encode = lngUtf8Size
  42.     End If
  43. End Function
  44.  
  45. Public Function Utf8Decode(ByRef bytUtf8() As Byte, Optional ByRef strDefaultChar As String) As String
  46.     Dim lngUtf8Size As Long
  47.     Dim lngDefaultCharLength As Long
  48.     Dim strBuffer As String
  49.     Dim lngWriteLength As Long
  50.     Dim bytUcs2Char(1) As Byte
  51.     Dim i As Long
  52.  
  53.     On Error GoTo ExitFunction
  54.     lngUtf8Size = UBound(bytUtf8)
  55.     On Error GoTo 0
  56.     lngDefaultCharLength = Len(strDefaultChar)
  57.     If lngDefaultCharLength Then
  58.         strBuffer = String$((lngUtf8Size + 1) * lngDefaultCharLength, vbNullChar)
  59.     Else
  60.         strBuffer = String$(lngUtf8Size + 1, vbNullChar)
  61.     End If
  62.     lngWriteLength = 1
  63.     
  64.     Do While i <= lngUtf8Size
  65.         If bytUtf8(i) <= &H7F Then
  66.             Mid(strBuffer, lngWriteLength, 1) = ChrW$(bytUtf8(i))
  67.             lngWriteLength = lngWriteLength + 1
  68.             i = i + 1
  69.         ElseIf (bytUtf8(i) >= &HC2 And bytUtf8(i) <= &HDF) Then
  70.             If (i + 1) <= lngUtf8Size Then
  71.                 If (bytUtf8(i + 1) >= &H80 And bytUtf8(i + 1) <= &HBF) Then
  72.                     bytUcs2Char(0) = ((bytUtf8(i) And &H3) * &H40) Or (bytUtf8(i + 1) And &H3F)
  73.                     bytUcs2Char(1) = (bytUtf8(i) And &H1C) \ &H4
  74.                     Mid(strBuffer, lngWriteLength, 1) = bytUcs2Char
  75.                     lngWriteLength = lngWriteLength + 1
  76.                     i = i + 2
  77.                 Else
  78.                     If lngDefaultCharLength Then GoSub SetDefaultChar
  79.                     i = i + 1
  80.                 End If
  81.             Else
  82.                 If lngDefaultCharLength Then GoSub SetDefaultChar
  83.                 i = i + 1
  84.             End If
  85.         ElseIf (bytUtf8(i) >= &HE0 And bytUtf8(i) <= &HEF) Then
  86.             If (i + 2) <= lngUtf8Size Then
  87.                 If (bytUtf8(i + 1) >= &H80 And bytUtf8(i + 1) <= &HBF) And _
  88.                    (bytUtf8(i + 2) >= &H80 And bytUtf8(i + 2) <= &HBF) Then
  89.                     bytUcs2Char(0) = ((bytUtf8(i + 1) And &H3) * &H40) Or (bytUtf8(i + 2) And &H3F)
  90.                     bytUcs2Char(1) = ((bytUtf8(i) And &HF) * &H10) Or ((bytUtf8(i + 1) And &H3C) \ &H4)
  91.                     Mid(strBuffer, lngWriteLength, 1) = bytUcs2Char
  92.                     lngWriteLength = lngWriteLength + 1
  93.                     i = i + 3
  94.                 Else
  95.                     If lngDefaultCharLength Then GoSub SetDefaultChar
  96.                     i = i + 1
  97.                 End If
  98.             Else
  99.                 If lngDefaultCharLength Then GoSub SetDefaultChar
  100.                 i = i + 1
  101.             End If
  102.         Else
  103.             If lngDefaultCharLength Then GoSub SetDefaultChar
  104.             i = i + 1
  105.         End If
  106.     Loop
  107.  
  108.     Utf8Decode = Left$(strBuffer, lngWriteLength - 1)
  109.  
  110.     Exit Function
  111. SetDefaultChar:
  112.     Mid(strBuffer, lngWriteLength, lngDefaultCharLength) = strDefaultChar
  113.     lngWriteLength = lngWriteLength + lngDefaultCharLength
  114.     Return
  115. ExitFunction:
  116. End Function
  117.  
  118. Public Function IsUtf8(ByRef bytArray() As Byte, Optional ByVal lngReadSize As Long = ISUTF8_DEFAULT_READSIZE) As Boolean
  119.     Dim lngArraySize As Long
  120.     Dim lngReadPosition As Long
  121.     Dim lngUtf8ByteSize As Long
  122.     Dim lngIsUtf8 As Long
  123.     Dim i As Long
  124.  
  125.     If Not CBool(lngReadSize) Then GoTo ExitFunction
  126.     On Error GoTo ExitFunction
  127.     lngArraySize = UBound(bytArray) + 1
  128.     On Error GoTo 0
  129.     If lngReadSize > lngArraySize Then lngReadSize = lngArraySize
  130.     
  131.     Do While lngReadPosition < lngReadSize
  132.         If bytArray(lngReadPosition) <= &H7F Then
  133.             lngReadPosition = lngReadPosition + 1
  134.         ElseIf bytArray(lngReadPosition) < &HC0 Then
  135.             Exit Function
  136.         ElseIf (bytArray(lngReadPosition) >= &HC0) And (bytArray(lngReadPosition) <= &HFD) Then
  137.             If (bytArray(lngReadPosition) And &HFC) = &HFC Then
  138.                 lngUtf8ByteSize = 5
  139.             ElseIf (bytArray(lngReadPosition) And &HF8) = &HF8 Then
  140.                 lngUtf8ByteSize = 4
  141.             ElseIf (bytArray(lngReadPosition) And &HF0) = &HF0 Then
  142.                 lngUtf8ByteSize = 3
  143.             ElseIf (bytArray(lngReadPosition) And &HE0) = &HE0 Then
  144.                 lngUtf8ByteSize = 2
  145.             ElseIf (bytArray(lngReadPosition) And &HC0) = &HC0 Then
  146.                 lngUtf8ByteSize = 1
  147.             End If
  148.             If (lngReadPosition + lngUtf8ByteSize) >= lngReadSize Then Exit Do
  149.             For i = (lngReadPosition + 1) To (lngReadPosition + lngUtf8ByteSize) Step 1
  150.                 If Not ((bytArray(i) >= &H80) And (bytArray(i) <= &HBF)) Then Exit Function
  151.             Next i
  152.             lngIsUtf8 = lngIsUtf8 + 1
  153.             lngReadPosition = lngReadPosition + lngUtf8ByteSize + 1
  154.         Else
  155.             lngReadPosition = lngReadPosition + 1
  156.         End If
  157.     Loop
  158.     
  159.     If lngIsUtf8 > 1 Then IsUtf8 = True
  160. ExitFunction:
  161. End Function

  1. Option Explicit
  2. Private Const CP_UTF8 = 65001
  3. Private Const CP_ACP = 0
  4. Private Declare Function GetACP Lib "Kernel32" () As Long
  5. Private Declare Function WideCharToMultiByte Lib "Kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, lpUsedDefaultChar As Long) As Long
  6. Private Declare Function MultiByteToWideChar Lib "Kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
  7.  
  8. Private Function WToA(ByVal st As String, Optional ByVal cpg As Long = -1, Optional lFlags As Long = 0) As String
  9.     Dim stBuffer As String
  10.     Dim cwch As Long
  11.     Dim pwz As Long
  12.     Dim pwzBuffer As Long
  13.     Dim lpUsedDefaultChar As Long
  14.     
  15.     If cpg = -1 Then cpg = GetACP()
  16.     pwz = StrPtr(st)
  17.     cwch = WideCharToMultiByte(cpg, lFlags, pwz, -1, 0&, 0&, ByVal 0&, ByVal 0&)
  18.     stBuffer = String$(cwch + 1, vbNullChar)
  19.     pwzBuffer = StrPtr(stBuffer)
  20.     cwch = WideCharToMultiByte(cpg, lFlags, pwz, -1, pwzBuffer, Len(stBuffer), ByVal 0&, ByVal 0&)
  21.     WToA = Left$(stBuffer, cwch - 1)
  22. End Function
  23.  
  24. Private Function AToW(ByVal st As String, Optional ByVal cpg As Long = -1, Optional lFlags As Long = 0) As String
  25.     Dim stBuffer As String
  26.     Dim cwch As Long
  27.     Dim pwz As Long
  28.     Dim pwzBuffer As Long
  29.         
  30.     If cpg = -1 Then cpg = GetACP()
  31.     pwz = StrPtr(st)
  32.     cwch = MultiByteToWideChar(cpg, lFlags, pwz, -1, 0&, 0&)
  33.     stBuffer = String$(cwch + 1, vbNullChar)
  34.     pwzBuffer = StrPtr(stBuffer)
  35.     cwch = MultiByteToWideChar(cpg, lFlags, pwz, -1, pwzBuffer, Len(stBuffer))
  36.     AToW = Left$(stBuffer, cwch - 1)
  37. End Function
  38.  
  39. Public Function EncodeUTF8(ByVal cnvUni As String) As String
  40.     If cnvUni = vbNullString Then Exit Function
  41.     EncodeUTF8 = StrConv(WToA(cnvUni, CP_UTF8), vbUnicode)
  42. End Function
  43.  
  44. Public Function DecodeUTF8(ByVal cnvUni As String) As String
  45.     If cnvUni = vbNullString Then Exit Function
  46.     DecodeUTF8 = AToW(WToA(cnvUni, CP_ACP), CP_UTF8)
  47. End Function

  1. Option Explicit
  2.  
  3. ' §§§§§§§§§§§§§§§§§§§§§§§§§§ &#202;&#238;&#228;&#232;&#240;&#238;&#226;&#234;&#232; §§§§§§§§§§§§§§§§§§§§§§§§§§
  4.  
  5. '--------------------------------------------------------------------------------
  6. ' &#207;&#240;&#238;&#229;&#234;&#242; : OfflineClient
  7. ' &#207;&#240;&#238;&#246;&#229;&#228;&#243;&#240;&#224; : WinToUTF8
  8. ' &#206;&#239;&#232;&#241;&#224;&#237;&#232;&#229; : &#207;&#229;&#240;&#229;&#226;&#238;&#228; &#241;&#242;&#240;&#238;&#234;&#232; &#226; UTF8 &#234;&#238;&#228;&#232;&#240;&#238;&#226;&#234;&#243;
  9. ' &#202;&#229;&#236; &#241;&#238;&#231;&#228;&#224;&#237; : SNE
  10. ' &#196;&#224;&#242;&#224;-&#194;&#240;&#229;&#236;&#255; : 09.11.2004-11:52:01
  11. '
  12. ' &#207;&#224;&#240;&#224;&#236;&#229;&#242;&#240;&#251; : inString - &#209;&#242;&#240;&#238;&#234;&#224;, &#226; win &#234;&#238;&#228;&#232;&#240;&#238;&#226;&#234;&#229;
  13. ' lMaxSize - &#204;&#224;&#234;&#241;&#232;&#236;&#224;&#235;&#252;&#237;&#251;&#233; &#240;&#224;&#231;&#236;&#229;&#240; &#241;&#242;&#240;&#238;&#234;&#232;
  14. '--------------------------------------------------------------------------------
  15. Private Function WinToUTF8(ByRef inString As String, _
  16.                            ByVal lMaxSize As Long) As String
  17.  
  18.         If inString = vbNullString Then Exit Function
  19.  
  20.         Dim hMemLock1 As Long, hMemLock2 As Long
  21.         Dim iStrSize As Long
  22.  
  23.         hMemLock1 = GlobalAlloc(GPTR, lMaxSize)
  24.         hMemLock2 = GlobalAlloc(GPTR, lMaxSize)
  25.  
  26.         iStrSize = MultiByteToWideChar(0&, 0&, inString, -1, hMemLock1, lMaxSize)
  27.         iStrSize = WideCharToMultiByte(65001, 0&, hMemLock1, iStrSize, hMemLock2, lMaxSize, 0&, 0&) ' CP_UTF8
  28.  
  29.         If Len(iStrSize) Then
  30.             WinToUTF8 = String$(iStrSize - vbNull, 0&)
  31.             Call CopyMemory(ByVal WinToUTF8, ByVal hMemLock2, iStrSize - vbNull)
  32.         End If
  33.  
  34.         Call GlobalFree(hMemLock1)
  35.         Call GlobalFree(hMemLock2)
  36. End Function
  37.  
  38. '--------------------------------------------------------------------------------
  39. ' &#207;&#240;&#238;&#229;&#234;&#242; : OfflineClient
  40. ' &#207;&#240;&#238;&#246;&#229;&#228;&#243;&#240;&#224; : UTF8ToWin
  41. ' &#206;&#239;&#232;&#241;&#224;&#237;&#232;&#229; : &#207;&#229;&#240;&#229;&#226;&#238;&#228; UTF8 &#241;&#242;&#240;&#238;&#234;&#232; &#226; WIN &#234;&#238;&#228;&#232;&#240;&#238;&#226;&#234;&#243;
  42. ' &#202;&#229;&#236; &#241;&#238;&#231;&#228;&#224;&#237; : SNE
  43. ' &#196;&#224;&#242;&#224;-&#194;&#240;&#229;&#236;&#255; : 09.11.2004-11:56:58
  44. '
  45. ' &#207;&#224;&#240;&#224;&#236;&#229;&#242;&#240;&#251; : inString - &#209;&#242;&#240;&#238;&#234;&#224; &#226; utf8 &#234;&#238;&#228;&#232;&#240;&#238;&#226;&#234;&#229;
  46. ' lMaxSize - &#204;&#224;&#234;&#241;&#232;&#236;&#224;&#235;&#252;&#237;&#251;&#233; &#240;&#224;&#231;&#236;&#229;&#240; &#241;&#242;&#240;&#238;&#234;&#232;
  47. '--------------------------------------------------------------------------------
  48. Private Function UTF8ToWin(ByRef inString As String, _
  49.                            ByVal lMaxSize As Long) As String
  50.  
  51.         If inString = vbNullString Then Exit Function
  52.  
  53.         Dim hMemLock1 As Long, hMemLock2 As Long
  54.         Dim iStrSize As Long
  55.  
  56.         hMemLock1 = GlobalAlloc(GPTR, lMaxSize)
  57.         hMemLock2 = GlobalAlloc(GPTR, lMaxSize)
  58.  
  59.         iStrSize = MultiByteToWideChar(CP_UTF8, 0&, inString, -1, hMemLock1, lMaxSize)
  60.         iStrSize = WideCharToMultiByte(0&, 0&, hMemLock1, -1, hMemLock2, iStrSize, 0&, 0&)
  61.  
  62.         If Len(iStrSize) Then
  63.             UTF8ToWin = String$(iStrSize - vbNull, 0&)
  64.             Call CopyMemory(ByVal UTF8ToWin, ByVal hMemLock2, iStrSize - vbNull)
  65.         End If
  66.  
  67.         Call GlobalFree(hMemLock1)
  68.         Call GlobalFree(hMemLock2)
  69. End Function

В последнем нужно добавить нужные объявления апи

Ответить

Номер ответа: 2
Автор ответа:
 gekko



Вопросов: 39
Ответов: 127
  Web-сайт: kalamfur.ru
 Профиль | | #2 		Добавлено: 17.02.09 07:27
Спасибо, Winand, снова выручил. 2 вариант - то, что надо.

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам