Updated 2013-07-17 08:00:33 by pooryorick ▲

WJG 2005-11-23: Having made a photoalbum, PhotoAlbum -A Web Gallery Creation Tool it's time to upload the files to the remote server using ftp.

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]
    }
}

with
if 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 - [email protected]
# 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 - [email protected]

  # 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 &
}

Category Internet