ASP 외부 동영상 (다음팟, 유투브 등) 정보 추출하기

' ***************************************************************************************
' * 함수설명 : 문자열 프린트 (php echo 와 같은 기능)                                                        
' * 변수설명 :
' ***************************************************************************************
Sub Echo( byval Str )
	Response.write Str
END Sub


' ***************************************************************************************
' * 함수설명 : HTMLPUBLISHING 값                                                        
' * 변수설명 :												
' ***************************************************************************************
FUNCTION fnStreamBinaryToString(Binary, CharSet)
	CONST adTypeText = 2
	CONST adTypeBinary = 1

	'//Create Stream object
	DIM BinaryStream 'As New Stream
	SET BinaryStream = CreateObject("ADODB.Stream")

	'//Specify stream type - we want To save text/string data.
	BinaryStream.Type = adTypeBinary

	'//Open the stream And write text/string data To the object
	BinaryStream.Open
	BinaryStream.Write Binary

	'//Change stream type To binary
	BinaryStream.Position = 0
	BinaryStream.Type = adTypeText

	'//Specify charset For the source text (unicode) data.

	IF Len(CharSet) > 0 THEN
		BinaryStream.CharSet = CharSet
	ELSE
		BinaryStream.CharSet = "us-ascii"
	END If
	
	'//Open the stream And get binary data from the object
	fnStreamBinaryToString = BinaryStream.ReadText
END FUNCTION


' ***************************************************************************************
' * 함수설명 : 외부 동영상 정보 가져오기			                                             *
' * 변수설명 : 							                        *
' *	  Temp = getMovie(strUrl)			                                                        *
'	  description	: Temp(0)			                                                        *
'	  type			: Temp(1)			                                        *
'	  title			: Temp(2)			                                        *
'	  url			: Temp(3)			                                        *
'	  image			: Temp(4)			                                        *
'	  video			: Temp(5)			                                        *
'	  site_name		: Temp(6)			                                        *				
'				                                                                                        *
' ***************************************************************************************

   	Function  getMovie(url)
		Dim arrMovie(10)
 	
		If Not url="" Then 

			Set objWinHttp = Server.CreateObject("WinHttp.WinHttpRequest.5.1")
			objWinHttp.Open "GET", url , false
			objWinHttp.SEND()

			sVal = fnStreamBinaryToString(objWinHttp.ResponseBody, "UTF-8")

			set objWinHttp = Nothing
		
			Set oRegexp = New RegExp

			oRegexp.Pattern = "property=.*?(\"".*?\"").*?content=.*?(\"".*?\"")"
			oRegexp.IgnoreCase = True
			oRegexp.Global = True

			Set oSearch = oRegexp.Execute(sVal)
			cnt = 0
			For Each sItem In oSearch
				sTmp = replace(sItem.Value,"""","")
				sTmp = replace(sTmp,"property=","")
				sTmp = replace(sTmp,"""","")

				If cnt=0 then
					sreturn = sTmp
				Else
					sreturn = sreturn & "||" &  sTmp
				End If 

				cnt = cnt + 1
			Next
			
			Set oSearch = Nothing
			SET oRegexp = Nothing
			
			arr_temp = Split(sreturn, "||")

			for i = 0 To ubound(arr_temp)
				 arr_temp1 = Split(arr_temp(i), "content=")
				 For j=0 To UBound(arr_temp1)
					'echo j &":"&arr_temp1(j)&"
"
					'echo arr_temp1(0)

					If Trim(arr_temp1(j))="og:description" Then
						arrMovie(0) = arr_temp1(j+1)
					End If 

					If Trim(arr_temp1(j))="og:type" Then
						arrMovie(1) = arr_temp1(j+1)
					End If 

					If Trim(arr_temp1(j))="og:title" Then
						arrMovie(2) = arr_temp1(j+1)
					End If 

					If Trim(arr_temp1(j))="og:url" Then
						arrMovie(3) = arr_temp1(j+1)
					End If 

					If Trim(arr_temp1(j))="og:image" Then
						arrMovie(4) = arr_temp1(j+1)
					End If 

					If Trim(arr_temp1(j))="og:video" Then
						arrMovie(5) = arr_temp1(j+1)
					End If 

					If Trim(arr_temp1(j))="og:site_name" Then
						arrMovie(6) = arr_temp1(j+1)
					End If 

				 next
			Next
		End If 

	getMovie = arrMovie

	End Function