рэкет / схема программы веб-мониторинга всегда вылетает - PullRequest
Новая
       7

рэкет / схема программы веб-мониторинга всегда вылетает

1 голос
/ 24 марта 2012

Я сделал следующую программу веб-мониторинга, но она всегда вылетает.Интересно, что не так?нет ошибкипрограмма просто зависает при нажатии на кнопку.Я на Windows XP SP3.Я запускаю программу из DrRacket 5.2.1 

#lang racket/gui
(require net/url)
(require racket/date)

(define (path->txt-list path)
  (when (not (equal? path #f))
  (define port (open-input-file path))
  (define txt-list '())
  (define (loop [line (read-line port 'return-linefeed)])
    (when (not (eof-object? line))
      (set! txt-list (list txt-list line)) (loop)))
  (loop) 
  (flatten txt-list)))

(define (find-word src-url-str word)
  (define src-url (string->url src-url-str))
  (define word-len (string-length word))
  (define found 0)
  (define in (get-pure-port src-url))
  (define response-str (port->string in))
  (define src-len (string-length response-str))

  (do 
      ((i 0 (+ i 1)))
    ((or 
      (= i (- src-len 1)) 
      (< (- src-len 1) (+ i word-len))) 
     found)
      (set! in (get-pure-port src-url))
      (set! response-str (port->string in))
      (close-input-port in)
      (set! src-len (string-length response-str))
      (if (string=? (substring response-str i (+ i word-len)) word) 
          (set! found (+ found 1)) 
          0))
  found)


(define (find-all src-url-str txt-file-path)
  (when (not (equal? txt-file-path #f))
  (define find-list (path->txt-list txt-file-path))
  (define number-of-founds 0)
  (for-each (lambda 
                (word) 
              (set! number-of-founds (+ number-of-founds (find-word src-url-str word)))) 
            find-list)
  number-of-founds))


(define (cb-start-btn)
  (define target-url-str (send txt-in get-value))
  (define target-file-path (get-file))
  (define now (current-date))
  (define number-of-founds (find-all target-url-str target-file-path))
  (when (real? number-of-founds)
    (when (> number-of-founds 0)
      (begin (send msg set-label
                   (format "number of founds:~a ~a" 
                           number-of-founds
                           (format "(hour:~a minute:~a second:~a)" 
                                   (date-hour now) 
                                   (date-minute now) 
                                   (date-second now))))
             (play-sound "C:/WINDOWS/Media/ringin.wav"))))
  (cb-start-btn))



(define f (new frame% (label "Luragi Monitor")))
(define txt-in (new text-field% (label "URL for monitoring") (parent f)))
(define msg (new message% (label "") (parent f)))
(define button (new button% (label "paste URL and click here to select txt file(words splitted with return) and go") (parent f) (callback (lambda (b e) (cb-start-btn)))))
(send f show #t)
...