Option Explicit

Dim oHttpRequest, strUrl, userPassword
Dim strExpr, MyArray
Dim stm, strResult
Dim RegExCd, RegExBody
Set RegExCd = New RegExp
RegExCd.Pattern = "(Curr Dir:)" & "(.+)\n"
RegExCd.Global = True
Set RegExBody = New RegExp
RegExBody.Global = true
RegExBody.Pattern = "</B>((.|\n)*)</PRE>"
Dim cwd
Dim Match,mc,Matches,m
Dim Get_Data
Dim fso
Dim strFolderName


WScript.StdOut.Write "'telnet.cgi'がある場所を入力してください。 (例:example.com/hoge/telnet.cgi):"
strUrl =Wscript.StdIn.ReadLine
If strUrl = "" Then
	Wscript.Echo "Cancelled."
	Wscript.Quit
End If
If Left(strUrl, 7) <> "http://" Then
	strUrl = "http://" & strUrl
End If
On Error Resume Next
Set oHttpRequest = CreateObject("Microsoft.XMLHTTP")
oHttpRequest.Open "GET", strUrl, False
If Err.Number <> 0 Then
	WScript.echo strUrl & "は有効なアドレスではありません。"
	'WScript.echo "Error : " & Err.Number & ": " & Err.Description
	WScript.Quit
End If
On Error Goto 0
oHttpRequest.Send
'失敗した場合は関数を終了します。
If (oHttpRequest.Status < 200 Or oHttpRequest.Status >= 300) Then Wscript.Quit
WScript.StdOut.Write "パスワードを入力してください:" 
userPassword = Wscript.StdIn.ReadLine

' パスワード送信とカレントディレクトリ取得
Set oHttpRequest = WScript.CreateObject("Microsoft.XMLHTTP")
Call oHttpRequest.Open("POST", strUrl, False)
Call oHttpRequest.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
Call oHttpRequest.Send("pass="&userPassword)
Set Matches = RegExCd.Execute(oHttpRequest.responseText) 
If Err.Number <> 0 Or Matches.Count = 0 Then
	WScript.echo "アドレスまたはパスワードが有効ではありません。"
	WScript.Quit
End If
On Error Goto 0
For Each Match in Matches
Get_Data = Replace(Replace(Replace(Match.Value, vbCr, ""), vbLf, ""), vbCrLf, "")
If InStr(Get_Data,"Curr Dir:") <> 0 Then cwd=right(Get_Data, len(Get_Data)-9)
Next

Do
WScript.StdOut.Write cwd&"：>"
strExpr = Wscript.StdIn.ReadLine
If strExpr <> "" Then
	MyArray = Split(strExpr, " ", -1, 1)
	Select Case LCase(Trim(MyArray(0)))
	Case "exit"
		WScript.Quit
	Case "get"
		dtmGet MyArray(1)
	Case "put"
		dtmPut MyArray(1)
	Case Else

' 要求
	Set oHttpRequest = WScript.CreateObject("Microsoft.XMLHTTP")
	Call oHttpRequest.Open("POST", strUrl, False)
	Call oHttpRequest.setRequestHeader("Accept-Encoding", "gzip,deflate,compress")
	Call oHttpRequest.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
	Call oHttpRequest.Send("pass="&userPassword&"&dir="&cwd&"&cmd="&strExpr)

'返答をShift_Jisのテキストにする
	Set stm = CreateObject("ADODB.Stream")
	stm.Type = 1   'バイナリモード
	stm.Open
	stm.Write oHttpRequest.responseBody  'バイナリを書き込み
	stm.Position = 0  '先頭に戻してから
	stm.Type = 2   'テキストモードに変更
	stm.Charset = "Shift_JIS"
	strResult = stm.ReadText(-1)   'データ全体を読み込む
	stm.Close

	Set mc = RegExBody.Execute(strResult)
	WScript.Echo Replace(Replace(mc(0).SubMatches(0), "&lt;", "<"), "&gt;", ">")
	End Select

	Set stm = Nothing
	Set oHttpRequest = Nothing 
	Set strExpr = Nothing
	Set Matches = RegExCd.Execute(strResult) 
	For Each Match in Matches
		Get_Data = Replace(Replace(Replace(Match.Value, vbCr, ""), vbLf, ""), vbCrLf, "")
		If InStr(Get_Data,"Curr Dir:") <> 0 Then cwd=right(Get_Data, len(Get_Data)-9)
	Next
End If
Loop
Wscript.Quit

Sub dtmGet(file)
Dim yn
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(file)) Then
	WScript.StdOut.Write "同名のファイルがあります。上書きしますか？(はい(y)/いいえ(n)): "
	yn = Wscript.StdIn.ReadLine
	If yn = "" Or LCase(yn) = "n" Then
		WScript.Echo "ダウンロードを中止しました。"
		Set fso = Nothing
		Set yn = Nothing
		Exit Sub
	End If
End If
Dim data, xmldom, node
Set xmldom = WScript.CreateObject("Microsoft.XMLDOM")
Set node = xmldom.CreateElement("base64-node")
node.DataType = "bin.base64"
Set oHttpRequest = WScript.CreateObject("Microsoft.XMLHTTP")
Call oHttpRequest.Open("POST", strUrl, False)
Call oHttpRequest.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
Call oHttpRequest.setRequestHeader("Accept-Encoding", "gzip,deflate")
Call oHttpRequest.Send("pass="&userPassword&"&dir="&cwd&"&cmd=perl -MMIME::Base64 -0777 -ne 'print encode_base64($_)'  < "&cwd&"/"&file)
Set stm = CreateObject("ADODB.Stream")
stm.Type = 1   'バイナリモード
stm.Open
stm.Write oHttpRequest.responseBody  'バイナリを書き込み
stm.Position = 0
stm.Type = 2   'テキストモードに変更
stm.Charset = "Shift_JIS"
stm.LineSeparator = 10
Set oHttpRequest = Nothing

Dim records, i
i = 0
Do While stm.EOS = False
	records = stm.ReadText(-2)
	strResult = strResult & records
	If InStr(records,"</PRE>") Then i = 0
	If i = 1 Then node.text = node.text & records
	If InStr(records,"</B>") Then i = 1
Loop

stm.Close
Set stm = Nothing

If IsNull(node.NodeTypedValue) Then
	Wscript.Echo "ファイルが存在しません"
	Wscript.Echo node.text
	Wscript.Echo strResult
	Exit Sub
End If

' SaveOptionsEnum Values
Const adSaveCreateNotExist  = 1 ' ファイルがないとき作成する
Const adSaveCreateOverWrite = 2 ' ファイルがあるとき上書きする

Set stm = CreateObject("ADODB.Stream")
stm.Type = 1
stm.Open
stm.write node.NodeTypedValue
stm.saveToFile file, adSaveCreateOverWrite
stm.Close
Set stm = Nothing
Set node = Nothing
Set xmldom = Nothing
End Sub


Sub dtmPut(file)
Set fso = CreateObject("Scripting.FileSystemObject")
If Not(fso.FileExists(MyArray(1))) Then 
	WScript.Echo "ファイルが存在しません"
	Set fso = Nothing
	Exit Sub
End If
Dim data, xmldom, node, plText, yn
' サーバーでのカレントディレクトリにあるファイル名一覧を取得
Set oHttpRequest = WScript.CreateObject("Microsoft.XMLHTTP")
Call oHttpRequest.Open("POST", strUrl, False)
Call oHttpRequest.setRequestHeader("Accept-Encoding", "gzip,deflate,compress")
Call oHttpRequest.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
Call oHttpRequest.Send("pass="&userPassword&"&dir="&cwd&"&cmd=ls")

'ファイル名一覧ををShift_Jisのテキストにする
Set stm = CreateObject("ADODB.Stream")
stm.Type = 1   'バイナリモード
stm.Open
stm.Write oHttpRequest.responseBody  'バイナリを書き込み
stm.Position = 0  '先頭に戻してから
stm.Type = 2   'テキストモードに変更
stm.Charset = "Shift_JIS"
strResult = stm.ReadText(-1)   'データ全体を読み込む
stm.Close
Set stm = Nothing
Set oHttpRequest = Nothing 
Set strExpr = Nothing

Set Matches = RegExBody.Execute(strResult) 
For Each Match in Matches
	Get_Data = Replace(Replace(Replace(Match.Value, vbCr, ""), vbLf, ""), vbCrLf, "")
	If InStr(Get_Data, file) > 0 Then
		WScript.StdOut.Write "同名のファイルがあります。上書きしますか？(はい(y)/いいえ(n)): "
		yn = Wscript.StdIn.ReadLine
		If yn = "" Or LCase(yn) = "n" Then
			WScript.Echo "アップロードを中止しました。"
			yn = "n"
		End If
	End If
Next
Set Matches = Nothing
Set Match = Nothing
If LCase(yn) <> "y" Then Exit Sub

Set xmldom = WScript.CreateObject("Microsoft.XMLDOM")
Set node = xmldom.CreateElement("base64-node")
node.DataType = "bin.base64"
Set stm = WScript.CreateObject("ADODB.Stream")
stm.Type = 1
stm.Open
stm.LoadFromFile file
node.NodeTypedValue = stm.Read
stm.Close
plText = replace(replace(node.Text,"+","-"),"/","_")
Set stm = Nothing
Set oHttpRequest = WScript.CreateObject("Microsoft.XMLHTTP")
Call oHttpRequest.Open("POST", strUrl, False)
Call oHttpRequest.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
Call oHttpRequest.setRequestHeader("Accept-Encoding", "compress,gzip,deflate")
Call oHttpRequest.Send("pass="&userPassword&"&dir="&cwd&"&cmd=perl -MMIME::Base64 -le 'print decode_base64(join """", map {chr} map {~ s/95/47/g;$_;} map {~ s/45/43/g;$_;} map {ord} split //, """&plText&""")' > "&cwd&"/"&file)

'返答をShift_Jisのテキストにする
Set stm = CreateObject("ADODB.Stream")
stm.Type = 1   'バイナリモード
stm.Open
stm.Write oHttpRequest.responseBody  'バイナリを書き込み
stm.Position = 0  '先頭に戻してから
stm.Type = 2   'テキストモードに変更
stm.Charset = "Shift_JIS"
strResult = stm.ReadText(-1)   'データ全体を読み込む
stm.Close
Set stm = Nothing
Set oHttpRequest = Nothing

End Sub