我制作了以下网络监控程序,但它总是崩溃。 我想知道出了什么问题。 没有错误。 单击按钮时程序就会冻结。 我在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)