I want to use ftp-download-file to download something, but I want to show the progress in my gui app.So I change net/ftp.rkt a little, let ftp-download-file can report current progress, ftp-download-file now changed to: (define (ftp-download-file tcp-ports folder filename [hook #f]) � ;; Save the file under the name tmp.file, rename it once download is� ;; complete this assures we don't over write any existing file without � ;; having a good file down� (let* ([tmpfile (make-temporary-file � � � � � � � � � �(string-append� � � � � � � � � � (regexp-replace� � � � � � � � � � �#rx"~" � � � � � � � � � � �(path->string (build-path folder "ftptmp"))� � � � � � � � � � �"~~") � � � � � � � � � � "~a"))]� � � � �[new-file (open-output-file tmpfile #:exists 'replace)] � � � � �[tcp-data (establish-data-connection tcp-ports)])� � (fprintf (ftp-connection-out tcp-ports) "RETR ~a\r\n" filename) � � (ftp-check-response (ftp-connection-in tcp-ports)� � � � � � � � � � � � (ftp-connection-out tcp-ports) � � � � � � � � � � � � (list #"125" #"150") print-msg (void)) � � ;; hook is a lambda (-> channel? channel? any?)� � ;; (hook receive-channel control-channel) � � ;; in this lambda, can use (channel-get rcv-ch) to get bytes has downloaded.� � ;; after (channel-get rcv-ch), use (channel-put ctrl-ch 0) to launch sender to get a new size info the rcv-ch channel. � � ;; Two channels used here is want to control the "refresh speed". It prevent receiver get size too frequently. � � ;; It means only if hook (channel-put ctrl-ch 0), then the sender will get the downloading file size.� � ;; Example: � � ;; (ftp-download-file ftp-conn "." "testfile"� � ;; � � � � � � � � � � � � � � � � (lambda (rcv-ch ctrl-ch) � � ;; � � � � � � � � � � � � � � � � � (letrec ([recur� � ;; � � � � � � � � � � � � � � � � � � (lambda () � � ;; � � � � � � � � � � � � � � � � � � � (let ([data (channel-get rcv-ch)])� � ;; � � � � � � � � � � � � � � � � � � � � (when (not (= data -1)) � � ;; � � � � � � � � � � � � � � � � � � � � � (channel-put ctrl-ch 0)� � ;; � � � � � � � � � � � � � � � � � � � � � � (printf "~a~%" data) � � ;; � � � � � � � � � � � � � � � � � � � � � � (sleep 1) //not too fast� � ;; � � � � � � � � � � � � � � � � � � � � � � (recur))))]) � � ;; � � � � � � � � � � � � � � � � � � (recur)))) � � (let ([rcv-ch (make-channel)] � � � � � [ctrl-ch (make-channel)]) � � � (when (procedure? hook) � � � � (thread� � � � �(lambda ()� � � � � �(hook rcv-ch ctrl-ch))) � � � � (thread� � � � �(lambda () � � � � � �(letrec ([recur� � � � � � � � � � �(lambda ()� � � � � � � � � � � �(channel-put rcv-ch (file-size tmpfile)) � � � � � � � � � � � �(when (= 0 (channel-get ctrl-ch))� � � � � � � � � � � � �(recur)))]) � � � � � � �(recur))))) � � � (copy-port tcp-data new-file) � � � (when (procedure? hook)� � � � ; send -1 to stop receiver thread � � � � (channel-put rcv-ch (file-size tmpfile))� � � � (channel-get ctrl-ch)� � � � (channel-put rcv-ch -1) � � � �� � � � ; send -1 to stop sender thread � � � � (channel-get rcv-ch)� � � � (channel-put ctrl-ch -1))) � � (close-output-port new-file)� � (close-input-port tcp-data) � � (ftp-check-response (ftp-connection-in tcp-ports)� � � � � � � � � � � � (ftp-connection-out tcp-ports) � � � � � � � � � � � � #"226" print-msg (void))� � (rename-file-or-directory tmpfile (build-path folder filename) #t))) A little complicated? But is worked. You must send control-channel 0 to let sender to refresh current tmp file size and reget file size. This prevent�sender refresh file size too frequently. Below is the example: � (ftp-download-file ftp-conn "." "testfile" � � � � � � � � � � �(lambda (rcv-ch snd-ch)� � � � � � � � � � � �(letrec ([recur� � � � � � � � � � � � � � � � �(lambda () � � � � � � � � � � � � � � � � � �(let ([data (channel-get rcv-ch)])� � � � � � � � � � � � � � � � � � �(when (not (= data -1)) � � � � � � � � � � � � � � � � � � � �(channel-put snd-ch 0)� � � � � � � � � � � � � � � � � � � �(printf "~a~%" (inexact->exact (round (* 100 (/ data total-size))))) � � � � � � � � � � � � � � � � � � � �(sleep 1)� � � � � � � � � � � � � � � � � � � �(recur))))]) � � � � � � � � � � � � �(recur)))) <div style="font-family:Times;font-size:medium"></div>