--- /dev/null
+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), "<", "<"), ">", ">")
+ 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
OSDN Git Service
