다른 사이트의 HTML소스를 불러오기 . (XMLHTTP 를 활용한 VB, ASP)

프로그램을 만들다보면.. php에는 있지만 asp에는 없는 다른 서버의 데이터를 긁어오는 기능이 필요할 때가 많을 겁니다.
MS에서는 XML기반의 데이터 처리 콤포넌트인 MSXML에서 지원을 해주고 있습니다.
사실 그런 목적보단 XML데이터를 가져와서 처리하는 것을 목적으로 하고 있습니다만..
암튼.. 이것을 이용해서 아래 소스를 그대로 사용하면 원하는 홈페이지의 내용을 그대로 출력하게 됩니다.

예를 들어 a = LWGetHTTP("http://www.littleworld.net")이라고 입력하면 해당 홈페이지의소스가 a란 변수에 들어가게 됩니다. 소스안에는 50kb로 제한을 두었는데 이것은 임의로 조정하시면 됩니다.

MSXML을 설치하려면 MSDN홈페이지에서 MSXML설치 파일을 받아서 설치하시면 됩니다.
요즘은 기본으로 지원되는 경우도 있으니 우선 해보시고 안되면 설치하시면 됩니다.

form값에 데이터를 넣어서 던지는 경우
Function lwGetHTTP(url, meth, fv)
 Dim xmlHttp
 Set xmlHttp = CreateObject("MSXML2.serverXMLHTTP")
 xmlHttp.Open meth, url, False
 xmlHttp.setRequestHeader "Content-Type", " text/html; charset=utf-8"
 'xmlHttp.setRequestHeader "Content-Type", " text/html"
 'xmlHttp.setRequestHeader "Content-Length", "length"
 if fv = empty then
   xmlHttp.Send
 else
   xmlHttp.Send fv
 end if
 xmlData = xmlHttp.responseText
 'binData = xmlHttp.responsebody
 lwGetHTTP = xmlData
End Function

form값에 값을 넣어 던지고 HTML로 리턴을 받는 경우
Function lwGetHTTPhtml(url, meth, fv)
 Dim xmlHttp
 Set xmlHttp = CreateObject("MSXML2.serverXMLHTTP")
 xmlHttp.Open meth, url, False
 xmlHttp.setRequestHeader "Content-Type", " text/html; charset=utf-8"
 'xmlHttp.setRequestHeader "Content-Type", " text/html"
 'xmlHttp.setRequestHeader "Content-Length", "length"
 if fv = empty then
   xmlHttp.Send
 else
   xmlHttp.Send fv
 end if
 'xmlData = xmlHttp.responseText
 binData = xmlHttp.responsebody
 lwGetHTTPhtml = binData
End Function

그냥 URL로 던지는 경우
Function LWGetHTTP(url)
      Dim xmlHttp
      Set xmlHttp = CreateObject("MSXML2.serverXMLHTTP")
      xmlHttp.Open "GET", url, False
      xmlHttp.Send
      binData = xmlHttp.responsebody
      Const adFldLong = &H00000080
      Const adVarChar = 200
      Set objRS = CreateObject("ADODB.Recordset")
      objRS.Fields.Append "txt", adVarChar, 60000, adFldLong
      objRS.Open
      objRS.AddNew
      objRS.Fields("txt").AppendChunk catalog
      LWGetHTTP = objRS("txt").Value
      objRS.Close
      Set objRS = Nothing
End Function

간단 버전..
Function lwGetHTTP2(url, qs)
      Dim xmlHttp
      Set xmlHttp = CreateObject("MSXML2.serverXMLHTTP")
      xmlHttp.Open "POST", url, False
      xmlHttp.Send qs
      txtData = xmlHttp.responseText
      lwGetHTTP2 = txtData
End Function

POST방식 추가했습니다.
처음에는 윗함수를 썼는데, 아래 함수를 써도 됩니다.
적절하게 이용하세요.




Free Infrastructure information management tool
Global Infrastructure Information Platform
http://giip.littleworld.net

Subscribe and publish your links as a book with friends
My Favorite Link Share
http://link.littleworld.net