[vb6.0/vba] WinHttp로 사이트 파싱시 한글깨질경우 엔코딩 찿는 방법 > vb6.0/vba

본문 바로가기

vb6.0/vba

[vb6.0/vba] [vb6.0/vba] WinHttp로 사이트 파싱시 한글깨질경우 엔코딩 찿는 방법

회원사진
하나를하더라도최선을
2020-07-14 16:56 3,932 0

본문



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 StringByVal T As StringAs 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
 
 

댓글목록0

등록된 댓글이 없습니다.
게시판 전체검색