コンピュータや音楽の事書いてます

FTPサーバの全階層ファイル一覧をテキストに出力

使い方:以下3つを正しいものに書き換える

  • serverXXX
  • userXXX
  • passwordXXX

ftp.exeのパラメータファイルを作らないで標準入力・標準出力から制御するところがミソ。

option explicit 
dim ws, fso, ftp, lines, regex, line, outfile, outfilename, errmsg

set ws = createobject("wscript.shell")
set fso = createobject("scripting.filesystemobject")
set ftp = ws.Exec("ftp -vn")
set regex = new regexp

regex.Global=true

regex.Pattern="\/|:"
outfilename = regex.Replace(formatdatetime(now, 0) & ".txt", ".")
set outfile = fso.CreateTextFile(outfilename)

outfile.writeline "####open"
execCommand "open serverXXX"
if false = readWait ("220 ", "incorrect.") then
  msgbox "login error"
  ws.quit
end if
outfile.writeline "####user"
execCommand "user userXXX passwordXXX"
if false = readWait ("230 ", "incorrect.") then
  msgbox "login error"
  ws.quit
end if

outfile.writeline "####search start"
searchDir "."
execCommand "quit"
outfile.writeline errmsg
ws.Run """" & outfilename & """"

function searchDir(name)
    searchDir = true
    execCommand "dir " & name
    if false = readWait ("226 ", "No such file or directory") then 
        errmsg = errmsg & lines & vbcrlf
        searchDir=false
        exit function
    end if
    
    regex.Pattern = "([^ \t]+)"
    for each line in split(lines, vbcrlf)
        dim matches, matche0, matche1, dirname
        set matches = regex.Execute(line)
        if right(line,1) <> "." and _
           right(line,2) <> ".." and _
           left(line,1) = "d" and _
           matches.count > 8 then
            '9番目以降はファイル名なので結合
            dirname = mid(line, matches(8).firstindex + 1)
            execCommand "cd """ & dirname & """" & vbcrlf & "pwd"
            if true = searchDir (".") then execCommand "cd .."
        end if
    next
end function

sub execCommand(cmd)
    ftp.StdIn.Writeline cmd
    outfile.writeline cmd
    wscript.sleep 100
end sub

function readWait(waitstring, errorstring)
    lines = ""
    readWait = true
    do while 1 <> instr(line, waitstring) '行頭にwaitstring
        line = Replace(ftp.StdOut.readline, vbcr, "")
        lines = lines & line & vbcrlf
        if instr(line, errorstring) then 
            readWait=false
            outfile.writeline lines
            exit do
        end if
    loop
    'lines = removeGomi(lines)
    outfile.writeline lines
end function

function removeGomi(str)
    dim matches
    'regex.Pattern = "^([0-9]+[ .])+(.*command successful)"
    'set matches = regex.Execute(str)
    'if matches.count then str = matches(0).submatches(1)
    regex.Pattern = "\r\r" '何故かcrが2つ含まれている行対応
    removeGomi = regex.Replace(str, "")
end function

2016/11/16