From 67e1cea5d6580f58bfde81d52c9f92dab588bd56 Mon Sep 17 00:00:00 2001
From: bchuukai <bchuukai@users.sourceforge.jp>
Date: Wed, 9 Nov 2011 20:09:47 +0900
Subject: [PATCH 1/1] teln as cilent for telnet.cgi

---
 teln-0.11.vbs | 251 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 251 insertions(+)
 create mode 100644 teln-0.11.vbs

diff --git a/teln-0.11.vbs b/teln-0.11.vbs
new file mode 100644
index 0000000..478bc72
--- /dev/null
+++ b/teln-0.11.vbs
@@ -0,0 +1,251 @@
+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
-- 
2.11.0