home *** CD-ROM | disk | FTP | other *** search
/ Chip 2004 July / CHIP_CD_2004-07.iso / software / nncron_hit / files / nncron189.exe / plugins / time.spf < prev    next >
Encoding:
Text File  |  2003-11-18  |  3.4 KB  |  136 lines
  1. \ File:         time.spf
  2. \ Author:       Nicholas Nemtsev
  3. \ Date:         08.01.2003
  4. \ Description:  Time operations.
  5. \ Words: FILE-TIME:, FILE-ATIME:, FILE-WTIME:, CUR-FTIME, FTIME-, FILE-CHANGE:
  6. \ Usage: FILE-TIME: filename        ( -- d ) 
  7. \        d - is a 64-bit value representing the 
  8. \        number of 100-nanosecond intervals since January 1, 1601
  9. \        [RECURSIVE] FILE-CHANGE: "file mask"      ( -- ?)
  10. \ Example: 
  11. \ CUR-FTIME FILE-TIME: xxx.txt FTIME- 300 > \ curtime-filetime>300sec
  12. \ IF FILE-DELETE: xxx.txt THEN
  13.  
  14.  
  15.  
  16. : FT-OP  IF __FFB ftCreationTime   2@ SWAP ELSE 0. THEN ;
  17. : FAT-OP IF __FFB ftLastAccessTime 2@ SWAP ELSE 0. THEN ;
  18. : FWT-OP IF __FFB ftLastWriteTime  2@ SWAP ELSE 0. THEN ;
  19. : FILE-TIME  ['] FT-OP FILE-OP ;
  20. : FILE-ATIME ['] FAT-OP FILE-OP ;
  21. : FILE-WTIME ['] FWT-OP FILE-OP ;
  22.  
  23. : FILE-TIME: eval-string, POSTPONE FILE-TIME ; IMMEDIATE
  24. : FILE-ATIME: eval-string, POSTPONE FILE-ATIME ; IMMEDIATE
  25. : FILE-WTIME: eval-string, POSTPONE FILE-WTIME ; IMMEDIATE
  26.  
  27.  
  28. \ USER-CREATE FST /SYSTEMTIME USER-ALLOT
  29. \ 
  30. \ : CUR-FTIME ( -- d) \ current time as filetime format
  31. \     FST GetSystemTime DROP
  32. \    0 0 SP@ FST SystemTimeToFileTime ERR THROW
  33. \    SWAP ;
  34.  
  35. : CUR-FTIME  FT-CUR ;
  36.  
  37. \ :NONAME
  38. \    DNEGATE D+ DUP 0< >R DABS
  39. \    10000000 ?UM/MOD IF NIP ELSE 2DROP 0 THEN
  40. \    R> IF NEGATE THEN ;
  41. \ 
  42. \ : FTIME- ( d1 d2 -- sec) \ time difference between two file time in sec
  43. \     LITERAL CATCH IF 2DROP 2DROP 0 THEN ;
  44.  
  45. : FTIME- FT- FT>SEC D>XS ;
  46.  
  47. \ ============ FILE-CHANGE =============================
  48.  
  49. USER FCH-FLAG
  50. USER FCH-NODE
  51.  
  52. VARIABLE FCH-SEM
  53. VARIABLE FCH-LIST
  54. USER FCH-CH-LIST
  55.  
  56. 0 VALUE FCH
  57. : FCH-NAME S" etc/filechange.txt" ;
  58.  
  59. : FCH-READ 
  60.     FCH-SEM GET
  61.     FCH-LIST @ 0= 
  62.     IF 
  63.         FCH-NAME R/O OPEN-FILE-SHARED 
  64.         IF DROP 
  65.         ELSE TO FCH
  66.             BEGIN PAD 512 FCH READ-LINE THROW WHILE
  67.                PAD SWAP GLOBAL S>ZALLOC FCH-LIST AddNode LOCAL
  68.             REPEAT
  69.             DROP
  70.             FCH CLOSE-FILE DROP
  71.         THEN
  72.     THEN
  73.     FCH-SEM RELEASE
  74. ;
  75. : FCH-WRITELN NodeValue ASCIIZ> FCH WRITE-LINE DROP ;
  76. : FCH-WRITE
  77.     FCH-SEM GET
  78.     FCH-NAME R/W CREATE-FILE-SHARED 
  79.     IF DROP 
  80.     ELSE 
  81.         TO FCH
  82.         ['] FCH-WRITELN FCH-LIST DoList
  83.         FCH CLOSE-FILE DROP
  84.     THEN
  85.     FCH-SEM RELEASE
  86. ;
  87.  
  88. : FCH-IS-FILE? { a u -- ? }
  89.     FCH-LIST
  90.     BEGIN @ ?DUP WHILE
  91.       DUP NodeValue 17 + ASCIIZ>
  92.       a u ICOMPARE 0=
  93.       IF NodeValue FCH-NODE ! TRUE EXIT THEN
  94.     REPEAT
  95.     FALSE
  96. ;
  97.  
  98. : FCH-TIME 
  99.     BASE @ >R HEX
  100.     FCH-NODE @ 16 S>DOUBLE
  101.     R> BASE !
  102. ;
  103.  
  104. : FILE-CHANGE ( a u -- ?)
  105.     FCH-READ
  106.     FCH-SEM GET
  107.     FCH-CH-LIST @ IF FCH-CH-LIST FreeList THEN
  108.     FCH-CH-LIST 0!
  109.     FCH-FLAG OFF
  110.     FOR-FILES
  111.         FOUND-FULLPATH FCH-IS-FILE? 0=
  112.         IF  
  113.             FOUND-FULLPATH DUP 18 + 
  114.             GLOBAL ALLOCATE THROW >R
  115.             R@ 17 BLANK
  116.             [CHAR] 0 R@ C!
  117.             R@ 17 + ZPLACE
  118.             R@ FCH-NODE !
  119.             R> FCH-LIST AddNode LOCAL
  120.         THEN
  121.         FOUND-FULLPATH FILE-WTIME 2DUP FCH-TIME D<>
  122.         IF
  123.           BASE @ >R HEX    <# 16 0 DO # LOOP #>       R> BASE !
  124.           FCH-NODE @ SWAP CMOVE
  125.           FCH-NODE @ 17 + FCH-CH-LIST AppendNode
  126.           FCH-FLAG ON
  127.         ELSE
  128.           2DROP
  129.         THEN
  130.     ;FOR-FILES
  131.     FCH-SEM RELEASE
  132.     FCH-FLAG @ DUP IF FCH-WRITE THEN
  133. ;
  134.  
  135. : FILE-CHANGE: eval-string, POSTPONE FILE-CHANGE ; IMMEDIATE
  136.