teln-0.11.vbs

   1 Option Explicit
   2
   3 Dim oHttpRequest, strUrl, userPassword
   4 Dim strExpr, MyArray
   5 Dim stm, strResult
   6 Dim RegExCd, RegExBody
   7 Set RegExCd = New RegExp
   8 RegExCd.Pattern = "(Curr Dir:)" & "(.+)\n"
   9 RegExCd.Global = True
  10 Set RegExBody = New RegExp
  11 RegExBody.Global = true
  12 RegExBody.Pattern = "</B>((.|\n)*)</PRE>"
  13 Dim cwd
  14 Dim Match,mc,Matches,m
  15 Dim Get_Data
  16 Dim fso
  17 Dim strFolderName
  18
  19
  20 WScript.StdOut.Write "'telnet.cgi'がある場所を入力してください。 (例:example.com/hoge/telnet.cgi):"
  21 strUrl =Wscript.StdIn.ReadLine
  22 If strUrl = "" Then
  23         Wscript.Echo "Cancelled."
  24         Wscript.Quit
  25 End If
  26 If Left(strUrl, 7) <> "http://" Then
  27         strUrl = "http://" & strUrl
  28 End If
  29 On Error Resume Next
  30 Set oHttpRequest = CreateObject("Microsoft.XMLHTTP")
  31 oHttpRequest.Open "GET", strUrl, False
  32 If Err.Number <> 0 Then
  33         WScript.echo strUrl & "は有効なアドレスではありません。"
  34         'WScript.echo "Error : " & Err.Number & ": " & Err.Description
  35         WScript.Quit
  36 End If
  37 On Error Goto 0
  38 oHttpRequest.Send
  39 '失敗した場合は関数を終了します。
  40 If (oHttpRequest.Status < 200 Or oHttpRequest.Status >= 300) Then Wscript.Quit
  41 WScript.StdOut.Write "パスワードを入力してください:"
  42 userPassword = Wscript.StdIn.ReadLine
  43
  44 ' パスワード送信とカレントディレクトリ取得
  45 Set oHttpRequest = WScript.CreateObject("Microsoft.XMLHTTP")
  46 Call oHttpRequest.Open("POST", strUrl, False)
  47 Call oHttpRequest.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
  48 Call oHttpRequest.Send("pass="&userPassword)
  49 Set Matches = RegExCd.Execute(oHttpRequest.responseText)
  50 If Err.Number <> 0 Or Matches.Count = 0 Then
  51         WScript.echo "アドレスまたはパスワードが有効ではありません。"
  52         WScript.Quit
  53 End If
  54 On Error Goto 0
  55 For Each Match in Matches
  56 Get_Data = Replace(Replace(Replace(Match.Value, vbCr, ""), vbLf, ""), vbCrLf, "")
  57 If InStr(Get_Data,"Curr Dir:") <> 0 Then cwd=right(Get_Data, len(Get_Data)-9)
  58 Next
  59
  60 Do
  61 WScript.StdOut.Write cwd&"：>"
  62 strExpr = Wscript.StdIn.ReadLine
  63 If strExpr <> "" Then
  64         MyArray = Split(strExpr, " ", -1, 1)
  65         Select Case LCase(Trim(MyArray(0)))
  66         Case "exit"
  67                 WScript.Quit
  68         Case "get"
  69                 dtmGet MyArray(1)
  70         Case "put"
  71                 dtmPut MyArray(1)
  72         Case Else
  73
  74 ' 要求
  75         Set oHttpRequest = WScript.CreateObject("Microsoft.XMLHTTP")
  76         Call oHttpRequest.Open("POST", strUrl, False)
  77         Call oHttpRequest.setRequestHeader("Accept-Encoding", "gzip,deflate,compress")
  78         Call oHttpRequest.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
  79         Call oHttpRequest.Send("pass="&userPassword&"&dir="&cwd&"&cmd="&strExpr)
  80
  81 '返答をShift_Jisのテキストにする
  82         Set stm = CreateObject("ADODB.Stream")
  83         stm.Type = 1   'バイナリモード
  84         stm.Open
  85         stm.Write oHttpRequest.responseBody  'バイナリを書き込み
  86         stm.Position = 0  '先頭に戻してから
  87         stm.Type = 2   'テキストモードに変更
  88         stm.Charset = "Shift_JIS"
  89         strResult = stm.ReadText(-1)   'データ全体を読み込む
  90         stm.Close
  91
  92         Set mc = RegExBody.Execute(strResult)
  93         WScript.Echo Replace(Replace(mc(0).SubMatches(0), "&lt;", "<"), "&gt;", ">")
  94         End Select
  95
  96         Set stm = Nothing
  97         Set oHttpRequest = Nothing
  98         Set strExpr = Nothing
  99         Set Matches = RegExCd.Execute(strResult)
 100         For Each Match in Matches
 101                 Get_Data = Replace(Replace(Replace(Match.Value, vbCr, ""), vbLf, ""), vbCrLf, "")
 102                 If InStr(Get_Data,"Curr Dir:") <> 0 Then cwd=right(Get_Data, len(Get_Data)-9)
 103         Next
 104 End If
 105 Loop
 106 Wscript.Quit
 107
 108 Sub dtmGet(file)
 109 Dim yn
 110 Set fso = CreateObject("Scripting.FileSystemObject")
 111 If (fso.FileExists(file)) Then
 112         WScript.StdOut.Write "同名のファイルがあります。上書きしますか？(はい(y)/いいえ(n)): "
 113         yn = Wscript.StdIn.ReadLine
 114         If yn = "" Or LCase(yn) = "n" Then
 115                 WScript.Echo "ダウンロードを中止しました。"
 116                 Set fso = Nothing
 117                 Set yn = Nothing
 118                 Exit Sub
 119         End If
 120 End If
 121 Dim data, xmldom, node
 122 Set xmldom = WScript.CreateObject("Microsoft.XMLDOM")
 123 Set node = xmldom.CreateElement("base64-node")
 124 node.DataType = "bin.base64"
 125 Set oHttpRequest = WScript.CreateObject("Microsoft.XMLHTTP")
 126 Call oHttpRequest.Open("POST", strUrl, False)
 127 Call oHttpRequest.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
 128 Call oHttpRequest.setRequestHeader("Accept-Encoding", "gzip,deflate")
 129 Call oHttpRequest.Send("pass="&userPassword&"&dir="&cwd&"&cmd=perl -MMIME::Base64 -0777 -ne 'print encode_base64($_)'  < "&cwd&"/"&file)
 130 Set stm = CreateObject("ADODB.Stream")
 131 stm.Type = 1   'バイナリモード
 132 stm.Open
 133 stm.Write oHttpRequest.responseBody  'バイナリを書き込み
 134 stm.Position = 0
 135 stm.Type = 2   'テキストモードに変更
 136 stm.Charset = "Shift_JIS"
 137 stm.LineSeparator = 10
 138 Set oHttpRequest = Nothing
 139
 140 Dim records, i
 141 i = 0
 142 Do While stm.EOS = False
 143         records = stm.ReadText(-2)
 144         strResult = strResult & records
 145         If InStr(records,"</PRE>") Then i = 0
 146         If i = 1 Then node.text = node.text & records
 147         If InStr(records,"</B>") Then i = 1
 148 Loop
 149
 150 stm.Close
 151 Set stm = Nothing
 152
 153 If IsNull(node.NodeTypedValue) Then
 154         Wscript.Echo "ファイルが存在しません"
 155         Wscript.Echo node.text
 156         Wscript.Echo strResult
 157         Exit Sub
 158 End If
 159
 160 ' SaveOptionsEnum Values
 161 Const adSaveCreateNotExist  = 1 ' ファイルがないとき作成する
 162 Const adSaveCreateOverWrite = 2 ' ファイルがあるとき上書きする
 163
 164 Set stm = CreateObject("ADODB.Stream")
 165 stm.Type = 1
 166 stm.Open
 167 stm.write node.NodeTypedValue
 168 stm.saveToFile file, adSaveCreateOverWrite
 169 stm.Close
 170 Set stm = Nothing
 171 Set node = Nothing
 172 Set xmldom = Nothing
 173 End Sub
 174
 175
 176 Sub dtmPut(file)
 177 Set fso = CreateObject("Scripting.FileSystemObject")
 178 If Not(fso.FileExists(MyArray(1))) Then
 179         WScript.Echo "ファイルが存在しません"
 180         Set fso = Nothing
 181         Exit Sub
 182 End If
 183 Dim data, xmldom, node, plText, yn
 184 ' サーバーでのカレントディレクトリにあるファイル名一覧を取得
 185 Set oHttpRequest = WScript.CreateObject("Microsoft.XMLHTTP")
 186 Call oHttpRequest.Open("POST", strUrl, False)
 187 Call oHttpRequest.setRequestHeader("Accept-Encoding", "gzip,deflate,compress")
 188 Call oHttpRequest.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
 189 Call oHttpRequest.Send("pass="&userPassword&"&dir="&cwd&"&cmd=ls")
 190
 191 'ファイル名一覧ををShift_Jisのテキストにする
 192 Set stm = CreateObject("ADODB.Stream")
 193 stm.Type = 1   'バイナリモード
 194 stm.Open
 195 stm.Write oHttpRequest.responseBody  'バイナリを書き込み
 196 stm.Position = 0  '先頭に戻してから
 197 stm.Type = 2   'テキストモードに変更
 198 stm.Charset = "Shift_JIS"
 199 strResult = stm.ReadText(-1)   'データ全体を読み込む
 200 stm.Close
 201 Set stm = Nothing
 202 Set oHttpRequest = Nothing
 203 Set strExpr = Nothing
 204
 205 Set Matches = RegExBody.Execute(strResult)
 206 For Each Match in Matches
 207         Get_Data = Replace(Replace(Replace(Match.Value, vbCr, ""), vbLf, ""), vbCrLf, "")
 208         If InStr(Get_Data, file) > 0 Then
 209                 WScript.StdOut.Write "同名のファイルがあります。上書きしますか？(はい(y)/いいえ(n)): "
 210                 yn = Wscript.StdIn.ReadLine
 211                 If yn = "" Or LCase(yn) = "n" Then
 212                         WScript.Echo "アップロードを中止しました。"
 213                         yn = "n"
 214                 End If
 215         End If
 216 Next
 217 Set Matches = Nothing
 218 Set Match = Nothing
 219 If LCase(yn) <> "y" Then Exit Sub
 220
 221 Set xmldom = WScript.CreateObject("Microsoft.XMLDOM")
 222 Set node = xmldom.CreateElement("base64-node")
 223 node.DataType = "bin.base64"
 224 Set stm = WScript.CreateObject("ADODB.Stream")
 225 stm.Type = 1
 226 stm.Open
 227 stm.LoadFromFile file
 228 node.NodeTypedValue = stm.Read
 229 stm.Close
 230 plText = replace(replace(node.Text,"+","-"),"/","_")
 231 Set stm = Nothing
 232 Set oHttpRequest = WScript.CreateObject("Microsoft.XMLHTTP")
 233 Call oHttpRequest.Open("POST", strUrl, False)
 234 Call oHttpRequest.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
 235 Call oHttpRequest.setRequestHeader("Accept-Encoding", "compress,gzip,deflate")
 236 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)
 237
 238 '返答をShift_Jisのテキストにする
 239 Set stm = CreateObject("ADODB.Stream")
 240 stm.Type = 1   'バイナリモード
 241 stm.Open
 242 stm.Write oHttpRequest.responseBody  'バイナリを書き込み
 243 stm.Position = 0  '先頭に戻してから
 244 stm.Type = 2   'テキストモードに変更
 245 stm.Charset = "Shift_JIS"
 246 strResult = stm.ReadText(-1)   'データ全体を読み込む
 247 stm.Close
 248 Set stm = Nothing
 249 Set oHttpRequest = Nothing
 250
 251 End Sub