Code edit
package require Tk
catch { console show }
# load necessary packages
package require ftp
package require ftp::geturl
#---------------
# set appropriate values...
#---------------
set host *******
set user *******
set pass *******
set directory /
#---------------
# transfer files to server
#---------------
proc upload {host user pass dir fileList} {
set handle [::ftp::Open $host $user $pass]
# some counters for our feedback string
set j 1
set k [llength $fileList]
foreach i $fileList {
upload:status "uploading ($j/$k) $i"
::ftp::Put $handle $i
incr j
}
::ftp::Close $handle
}
#---------------
# feedback
#---------------
proc upload:status {msg} {
puts $msg
}
#---------------
# create filelist
#---------------
set files {}
foreach i {jpg html css} {
upload $host $user $pass $directory [glob -nocomplain *.$i]
}RLH 2006-04-05: Is there a reason Tk is required for this?
[Pierre Coueffin] 2006-04-12: Why does it need the variable "files"?I'd be tempted to replace:
if 0 {
#---------------
# create filelist
#---------------
set files ""
foreach i {jpg html css} {
upload $host $user $pass $directory [glob -nocomplain *.$i]
}
}withif 0 {
#---------------
# create filelist
#---------------
upload $host $user $pass $directory [glob -nocomplain *.jpg *.html *.css]
}Unless I'm missing something subtle about how glob works.thgr 2008-03-08: I needed to transfer whole directories:
ftpUpload $myHost $myUser $myPasswd $localDirctory $hostDirectory
# ftpUpload --
#
# Open ftp session - transfer $local recursively to ftp server - close
# ftp session.
#
# Arguments:
# host name of ftp server.
# user ftp user name.
# passwd ftp password.
# local name of file or dir.
# hostDir (optional) name of target directory on ftp server.
#
# Results:
# If $local is a file name the file will be uploaded. If $local is the
# name of a local directory, all subdirs and files will be uploaded.
proc ftpUpload {host user passwd local {hostDir ""}} {
set handle [::ftp::Open $host $user $passwd]
if {$handle < 0} {
error "Connection refused!"
return
}
ftpGoToDir $handle $hostDir
foreach l $local {
recursiveUpload $handle $l $hostDir
}
::ftp::Close $handle
return
}
proc setFtpType {handle fileName} {
switch -exact -- [file extension $fileName] \
.txt - .html - .css {::ftp::Type $handle ascii} \
default {::ftp::Type $handle binary}
}
# recursiveUpload --
#
# Recursively transfer directories to ftp server.
#
# Arguments:
# handle ftp session handle.
# local name of local file or directory.
# hostDir name of directory on ftp server.
#
# Results:
# If $local is a file name the file will be uploaded. If $local is the
# name of a local directory, all subdirs and files will be uploaded.
proc recursiveUpload {handle local hostDir} {
if {[file isfile $local]} {
#just a file -> upload
set fileName [file tail $local]
setFtpType $handle $fileName
::ftp::Put $handle $local [file join $hostDir $fileName]
return
} ;# else file is directory -> recursion
if {![file isdirectory $local]} {return}
set targetDir [file join $hostDir [file tail $local]]
ftpGoToDir $handle $targetDir
# upload regular files of directory
foreach f [glob -nocomplain -directory $local -type f *] {
setFtpType $handle [file tail $f]
::ftp::Put $handle $f
}
# recursion for subdirectories
foreach d [glob -nocomplain -directory $local -type d *] {
recursiveUpload $handle $d $targetDir
}
}
# ftpGoToDir --
#
# Change directory on ftp server to given path.
#
# Arguments:
# handle ftp session handle.
# path path on ftp server.
#
# Results:
# Goes to the given path on ftp server. If directories don't exist, they
# will be created.
proc ftpGoToDir {handle path} {
::ftp::Cd $handle /
foreach dir [file split $path] {
if {![::ftp::Cd $handle $dir]} {
::ftp::MkDir $handle $dir
::ftp::Cd $handle $dir
}
}
}tonytraductor - Likely this is extremely inefficient, and there are better ways to do it, but, I wrote one that uploads, and downloads. I don't like my method of listing and finding a remote file to download, but, with my very n00bish skills, it was what I could figure out to make it work. Also, this one will offer the user to open an uploaded file in the browser of their choice (provided it is a file a browser can open, such as .txt, .html, .jpg, etc.), and tells the user where the URL is for an uploaded file, and the location of a downloaded file. It was fun...I'll keep learning.
#!/usr/bin/env wish8.5
# This program was written by tony baldwin - tonytraductor@linguasos.org
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA
# tclUP copyright tony baldwin - tonytraductor@linguasos.org
# load necessary packages
package require ftp
#global vars...I'm always getting hollered at for these, but, they're working for me.
global filename
global rfile
global fname
global host
global path
global username
global password
global url
global dlay
global file_types
global list
global dldir
# File types I most frequently up/download from my server, anyway
set file_types {
{"All Files" * }
{"Text Files" { .txt .TXT}}
{"LaTex" {.tex}}
{"PDF" {.pdf}}
{"Xml" {.xml}}
{"Html" {.html}}
{"CSS" {.css}}
{"Image" {.jpg .jpeg .gif .png}}
{"Zipped" {.gz .zip .rar}}
{"Music" {.ogg .mp3 .wav .wma}}
{"Video" {.mpg .mov .avi .wmv}}
}
wm title . "TickleUP"
# gui
frame .notes
grid [ttk::label .notes.lab -text "Server information:"]
pack .notes -in . -fill x
frame .fields
grid [ttk::label .fields.hq -text "Host:"]\
[ttk::entry .fields.host -textvariable host]\
[ttk::label .fields.pathq -text "Directory: "]\
[ttk::entry .fields.path -textvariable path]
grid [ttk::label .fields.unam -text "Username: "]\
[ttk::entry .fields.uname -textvariable username]\
[ttk::label .fields.pwrd -text "Password: "]\
[ttk::entry .pswrd -show * -textvariable password]
pack .fields -in . -fill x
frame .ubtns
grid [ttk::label .ubtns.lbl -text "Uploads:"]
grid [ttk::button .ubtns.filename -text "Local file" -command grabfile]\
[ttk::button .ubtns.send -text "Upload" -command {upload}]
pack .ubtns -in . -fill x
frame .dbtns
grid [ttk::label .dbtns.lbl -text "Downloads:"]
grid [ttk::button .dbtns.dlfilen -text "List" -command {dlist}]\
[ttk::entry .dbtns.file -textvariable rfile]\
[ttk::button .dbtns.ddn -text "Download" -command {down}]
pack .dbtns -in . -fill x
frame .btns
grid [ttk::button .btns.out -text "QUIT" -command {exit}]
pack .btns -in . -fill x
# procs
# My really lame, n00bish means of listing the files on the remote server
proc dlist {} {
set handle [::ftp::Open $::host $::username $::password]
set list [::ftp::NList $handle $::path]
toplevel .list
wm title .list "Remote File List"
text .list.l -width 80 -height 40 -wrap word
.list.l insert end "$list"
.list.l insert end "\n \n Copy the file name you wish to download and paste to the entry field.\n Then click \'download\' and choose the directory where to save it."
pack .list.l -in .list -fill x
}
# dls the file, tells you where it is
proc down {} {
global dldir
set dldir [tk_chooseDirectory]
set handle [::ftp::Open $::host $::username $::password]
::ftp::Cd $handle $::path
::ftp::Get $handle $::rfile $::dldir/$::rfile
::ftp::Close $handle
toplevel .down
wm title .down "Success!"
tk::message .down.loaded -text "Your file has been downloaded to $::dldir/$::rfile"
tk::button .down.out -text "Okay" -command {destroy .down}
pack .down.loaded -in .down -side top
pack .down.out -in .down -side top
}
# uploads the file, tells you where it is, offers to open it in a browser for verification
proc upload {} {
global fname
set fname [file tail $::filename]
set handle [::ftp::Open $::host $::username $::password]
::ftp::Cd $handle $::path
::ftp::Put $handle $::filename $::fname
::ftp::Close $handle
toplevel .url
grid [ttk::label .url.lbl -text "Your image is at\n http:://www.$::host/$::path/$::fname"]
grid [ttk::button .url.btn -text "open in browser" -command {browse}]\
[ttk::button .url.not -text "close" -command {destroy .url}]
}
# grabs the local file to upload
# I wish I could use a tk_getOpenFile to grab the remote file
# like this, but, I couldn't get a tk_getOpenFile to open at
# the remote server location, which I tried with
# set $odir [::ftp::Cd $handle $::path]
# set filename [tk_getOpenFile -filetypes $::file_types -initialdir $odir]
# but that didn't work...
proc grabfile {} {
global filename
set filename [tk_getOpenFile -filetypes $::file_types]
wm title . "Now Tickling: $::filename"
}
#proc to view an uploaded remote file with a browser
# whoopee
proc browse {} {
set filetypes " "
tk_messageBox -message "Choose your browser" -type ok -title "Set browser"
set brow [tk_getOpenFile -filetypes $filetypes]
# I just end up typing in /usr/bin/konqueror or something rather than surf
# the file system for it
exec $brow www.$::host/$::path/$::fname &
}
