Хабр Курсы для всех
РЕКЛАМА
Практикум, Хекслет, SkyPro, авторские курсы — собрали всех и попросили скидки. Осталось выбрать!
Кто был достаточно внимателен, то заметил что мы переопределили базовые слова двоеточие и минус. Как быть с этим? Ответ ниже.
" %DD%-%MM%-%YYYY%/%HH%:%MM%:%SS%"
WINAPI: GetSystemTime Kernel32.dll
0
2 -- -Year \ Указывает текущий год
2 -- -Month \ Текущий месяц; Январь = 1, Февраль = 2, и так далее
2 -- -DayOfWeek \ Текущий день недели; Воскресенье = 0, Понедельник = 1, и так далее
2 -- -Day \ Текущий день месяца
2 -- -Hour \ Час
2 -- -Minute \ Минуты
2 -- -Second \ Секунды
2 -- -Milliseconds \ Миллисекунды
CONSTANT /SYSTEMTIME
USER-CREATE SYSTEMTIME-BUF /SYSTEMTIME USER-ALLOT
USER-CREATE WebTime[] 30 USER-ALLOT
29 CONSTANT WebTime#
CREATE WebDays S" Sun, Mon, Tue, Wed, Thu, Fri, Sat, " HERE SWAP DUP ALLOT 0 C, CMOVE
CREATE WebMonths S" Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec " HERE SWAP DUP ALLOT 0 C, CMOVE
: WebTime! \ ( addr -- ) \ Записать по адресу addr строку с текущей датой вида "Fri, 04 Jul 2008 08:42:36 GMT"
>R SYSTEMTIME-BUF GetSystemTime \ Получаем текущее системное время
DUP -DayOfWeek W@ 5 * WebDays + R@ 5 CMOVE R> 5 + >R \ и конвертируем его в формат RFC 822
DUP -Day W@ 0 <# # # #> R@ SWAP CMOVE R> 2 + >R \ Код хоть и немного жуткий, зато быстрый — а это главное
BL R> DUP 1+ >R C!
DUP -Month W@ CELLS WebMonths + R@ 4 CMOVE R> 4 + >R
DUP -Year W@ 0 <# # # # # #> R@ SWAP CMOVE R> 4 + >R
BL R> DUP 1+ >R C!
DUP -Hour W@ 0 <# # # #> R@ SWAP CMOVE R> 2 + >R
[CHAR] : R> DUP 1+ >R C!
DUP -Minute W@ 0 <# # # #> R@ SWAP CMOVE R> 2 + >R
[CHAR] : R> DUP 1+ >R C!
-Second W@ 0 <# # # #> R@ SWAP CMOVE R> 2 + >R
S" GMT" R> SWAP CMOVE
;
: GetWebTime \ ( -- a u )
WebTime[] WebTime!
WebTime[] 29
;
USING: io io.sockets kernel calendar
io.streams.duplex accessors prettyprint
calendar.format io.encodings.utf8
math.parser math.functions ;
IN: my.server
CONSTANT: port 80
CONSTANT: host "127.0.0.1"
: create-server ( -- server ) host port <inet4> utf8 <server> ;
: make-value ( -- )
: _ ( -- ) " " write ;
: - ( -- ) "-" write ;
: _: ( -- ) ":" write ;
: HOURS ( time -- ) hour>> number>string write ;
: MINUTES ( time -- ) minute>> number>string write ;
: SECONDS ( time -- ) second>> round number>string write ;
: print-date-now ( -- )
now dup dup dup dup dup
DAY - MONTH - YYYY _ HOURS _: MINUTES _: SECONDS ;
"Starting server..." print flush
create-server
"Start listening..." print flush
accept
"Connected: " write
[ host>> write ] [ ":" write port>> number>string print ] bi
[
print-date-now
"" print
flush
] with-stream
USING: io io.sockets kernel calendar
io.streams.duplex accessors prettyprint
calendar.format io.encodings.utf8
math.parser math.functions ;
IN: my.server
CONSTANT: port 80
CONSTANT: host "127.0.0.1"
: create-server ( -- server ) host port <inet4> utf8 <server> ;
: _ ( -- ) " " write ;
: - ( -- ) "-" write ;
: _: ( -- ) ":" write ;
: HOURS ( time -- ) hour>> number>string write ;
: MINUTES ( time -- ) minute>> number>string write ;
: SECONDS ( time -- ) second>> round number>string write ;
: print-date-now ( -- )
now dup dup dup dup dup
DAY - MONTH - YYYY _ HOURS _: MINUTES _: SECONDS ;
"Starting server..." print flush
create-server
"Start listening..." print flush
accept
"Connected: " write
[ host>> write ] [ ":" write port>> number>string print ] bi
[
print-date-now
"" print
flush
] with-stream
FORTH: наносервера и наноклиенты. Часть 1