vb6.0/vba [vb6.0/vba] WinHttp로 사이트 파싱시 한글깨질경우 엔코딩 찿는 방법
페이지 정보
본문
Sub program1472()
Dim B() As Byte, T As String, Cookie As String, Referer As String, URL As String, Host As String
Cookie = "PHPSESSID=d4r5mc7clu18cd1bhc0dfm5v86; "
URL = "사이트 주소"
Referer = "사이트 이전주소"
Host = "Host 주소"
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "GET", URL
.SetRequestHeader "Host", Host
.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:50.0) Gecko/20100101 Firefox/50.0"
.SetRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
.SetRequestHeader "Accept-Language", "ko-KR,ko;q=0.8,en-US;q=0.5,en;q=0.3"
.SetRequestHeader "Referer", Referer
.SetRequestHeader "Cookie", Cookie
.SetRequestHeader "Connection", "keep-alive"
.SetRequestHeader "Upgrade-Insecure-Requests", "1"
.send
B = .responseBody
End With
Dim arrCharsets As Variant
arrCharsets = Split("big5,big5-hkscs,euc-jp,euc-kr,gb18030,gb2312,gbk,ibm-thai," & _
"ibm00858,ibm01140,ibm01141,ibm01142,ibm01143,ibm01144," & _
"ibm01145,ibm01146,ibm01147,ibm01148,ibm01149,ibm037," & _
"ibm1026,ibm273,ibm277,ibm278,ibm280,ibm284,ibm285,ibm297," & _
"ibm420,ibm424,ibm437,ibm500,ibm775,ibm850,ibm852,ibm855," & _
"ibm857,ibm860,ibm861,ibm862,ibm863,ibm864,ibm865,ibm866," & _
"ibm869,ibm870,ibm871,iso-2022-jp,iso-2022-kr,iso-8859-1," & _
"iso-8859-13,iso-8859-15,iso-8859-2,iso-8859-3,iso-8859-4," & _
"iso-8859-5,iso-8859-6,iso-8859-7,iso-8859-8,iso-8859-9," & _
"koi8-r,koi8-u,shift_jis,tis-620,us-ascii,utf-16,utf-16be," & _
"utf-16le,utf-7,utf-8,windows-1250,windows-1251,windows-1252," & _
"windows-1253,windows-1254,windows-1255,windows-1256," & _
"windows-1257,windows-1258,unicode", ",")
Dim V As Variant
For Each V In arrCharsets
T = UTF82(B, V)
SaveText ThisWorkbook.Path & "\" & V & ".csv", T
Next
End Sub
Public Function UTF82(ByRef data() As Byte, ByVal Charset As Variant) As String
On Error GoTo ErrPass
With CreateObject("ADODB.Stream")
.Charset = Charset
.Mode = 3
.Type = 1
.Open
.Write data
.Flush
.Position = 0
.Type = 2
UTF82 = .ReadText
.Close
End With
Exit Function
ErrPass:
UTF82 = Nothing
End Function
Public Function SaveText(ByVal FilePath As String, ByVal T As String) As Boolean
On Error GoTo TextERR2
Dim FN As Long
FN = FreeFile()
Open FilePath For Binary Access Write As #FN
Put #FN, , T
Close #FN
If Len(Dir$(FilePath)) Then SaveText = True
TextERR2:
End Function
- 이전글[vb6.0/vba] 서울교차로(newspaper.seoulkcr.com)구인 크롤링 20.07.16
- 다음글[vb6.0/vba] Convert UTF-8 to ANSI 20.07.14
댓글목록
등록된 댓글이 없습니다.