masalibの日記

システム開発、運用と猫の写真ブログです

ClassicASPで外部のファイルを保存する

ミスというかワケガワカラナイヨの状態なのでメモを残す

ClassicASPという超絶古い言語があります
Active Server Pages - Wikipedia

ライブラリーがそろっていないので有名です
ソケット通信するのですら、標準ではできません

フリーのライブラリーのbasp21を使って外部の画像を取得して保存していました
外部の画像の部分が変更になったので修正したらなぜか動きません・・・

bsocket.readline datas
の部分で -3 : データなしになってしまいました

Set bobj = WScript.CreateObject("basp21")
Set bsocket = WScript.CreateObject("basp21.socket")
Set WshShell = Wscript.CreateObject("Wscript.Shell")
WshShell.Run ("notepad")
rc1 = bsocket.Connect("www.hi-ho.ne.jp", 80, 10)
if rc1 <> 0 then
  bobj.debug "connect error " & rc1
  WScript.quit
end if
cmd = "GET /xxxxx/x.jpg HTTP/1.0"
host = "Host: getsitedomain.com" & vbCrLf  ' Hostヘッダをつけること
rc1 = bsocket.write (cmd & vbCrLf & host & vbCrLf)
if rc1 <> 0 then
  bobj.debug "write error " & rc1
  WScript.quit
end if
bsocket.readline datas
bobj.debug datas
While rc1 = 0 And Len(datas) > 0  ' ヘッダーを読み飛ばす
    rc1 = bsocket.readline(datas)
    bobj.debug datas
Wend
rc1 = bsocket.read(datax, 1)      ' イメージをバイナリ読込み
mode = 0: lenx = 0
While rc1 = 0                    
  lenx = lenx + UBound(datax) + 1
  rc1 = bobj.BinaryWrite(datax, savetopath, mode)
  mode = mode + 1
  rc1 = bsocket.read(datax, 1)
Wend
bobj.debug lenx

wgetとかcurlとかで調査してもわからずこのプログラムを破棄して

gist.github.com

を参考にして作りかえました

Dim getURL
Dim objXMLHTTP
Dim objADOStream
Dim saveTo
Dim objFSO
Dim strHost			'ホスト名
Dim strPort			'ポート番号
Dim strRequest


Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
strHost = SERVER_XXXX		'直うちでもドメインでもOK		
strPort = SERVER_XXXX_PORT	'省略はできないみたい
strRequest = "/xxx/image.jpg"
getURL = "http://" & strHost & ":" & strPort  & strRequest

objXMLHTTP.open "GET", getURL, false
objXMLHTTP.send()
saveTo = strCreateImagePath & ".jpg" 
If objXMLHTTP.Status = 200 Then
	Set objADOStream = CreateObject("ADODB.Stream")
	objADOStream.Open
	objADOStream.Type = 1 'adTypeBinary

	objADOStream.Write objXMLHTTP.ResponseBody
	objADOStream.Position = 0    'Set the stream position to the start

	Set objFSO = Createobject("Scripting.FileSystemObject")
	If objFSO.Fileexists(saveTo) Then 
		objFSO.DeleteFile saveTo
	End IF
	Set objFSO = Nothing

	objADOStream.SaveToFile saveTo
	objADOStream.Close
	Set objADOStream = Nothing
End if

問題なく保存できた・・・・
ワケガワカラナイヨ

ライブラリーが揃っていない
ClassicASPは本当にやめたいです