1 ! Copyright (C) 2008 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: byte-arrays math io.backend io.files.info
4 io.files.windows io.files.windows.nt kernel windows.kernel32
5 windows.time windows accessors alien.c-types combinators
6 generalizations system alien.strings io.encodings.utf16n
7 sequences splitting windows.errors fry continuations destructors
8 calendar ascii combinators.short-circuit ;
9 IN: io.files.info.windows
11 TUPLE: windows-file-info < file-info attributes ;
13 : WIN32_FIND_DATA>file-info ( WIN32_FIND_DATA -- file-info )
14 [ \ windows-file-info new ] dip
16 [ WIN32_FIND_DATA-dwFileAttributes win32-file-type >>type ]
17 [ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes >>attributes ]
19 [ WIN32_FIND_DATA-nFileSizeLow ]
20 [ WIN32_FIND_DATA-nFileSizeHigh ] bi >64bit >>size
22 [ WIN32_FIND_DATA-dwFileAttributes >>permissions ]
23 [ WIN32_FIND_DATA-ftCreationTime FILETIME>timestamp >>created ]
24 [ WIN32_FIND_DATA-ftLastWriteTime FILETIME>timestamp >>modified ]
25 [ WIN32_FIND_DATA-ftLastAccessTime FILETIME>timestamp >>accessed ]
28 : find-first-file-stat ( path -- WIN32_FIND_DATA )
29 "WIN32_FIND_DATA" <c-object> [
31 [ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep
32 FindClose win32-error=0/f
35 : BY_HANDLE_FILE_INFORMATION>file-info ( HANDLE_FILE_INFORMATION -- file-info )
36 [ \ windows-file-info new ] dip
38 [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-type >>type ]
39 [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-attributes >>attributes ]
41 [ BY_HANDLE_FILE_INFORMATION-nFileSizeLow ]
42 [ BY_HANDLE_FILE_INFORMATION-nFileSizeHigh ] bi >64bit >>size
44 [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes >>permissions ]
46 BY_HANDLE_FILE_INFORMATION-ftCreationTime
47 FILETIME>timestamp >>created
50 BY_HANDLE_FILE_INFORMATION-ftLastWriteTime
51 FILETIME>timestamp >>modified
54 BY_HANDLE_FILE_INFORMATION-ftLastAccessTime
55 FILETIME>timestamp >>accessed
57 ! [ BY_HANDLE_FILE_INFORMATION-nNumberOfLinks ]
59 ! [ BY_HANDLE_FILE_INFORMATION-nFileIndexLow ]
60 ! [ BY_HANDLE_FILE_INFORMATION-nFileIndexHigh ] bi >64bit
64 : get-file-information ( handle -- BY_HANDLE_FILE_INFORMATION )
66 "BY_HANDLE_FILE_INFORMATION" <c-object>
67 [ GetFileInformationByHandle win32-error=0/f ] keep
68 ] keep CloseHandle win32-error=0/f ;
70 : get-file-information-stat ( path -- BY_HANDLE_FILE_INFORMATION )
72 GENERIC_READ FILE_SHARE_READ f
73 OPEN_EXISTING FILE_FLAG_BACKUP_SEMANTICS f
74 CreateFileW dup INVALID_HANDLE_VALUE = [
75 drop find-first-file-stat WIN32_FIND_DATA>file-info
78 get-file-information BY_HANDLE_FILE_INFORMATION>file-info
81 M: windows file-info ( path -- info )
82 normalize-path get-file-information-stat ;
84 M: windows link-info ( path -- info )
87 : volume-information ( normalized-path -- volume-name volume-serial max-component flags type )
88 MAX_PATH 1+ [ <byte-array> ] keep
92 MAX_PATH 1+ [ <byte-array> ] keep
93 [ GetVolumeInformation win32-error=0/f ] 7 nkeep
95 [ utf16n alien>string ] 4 ndip
98 : file-system-space ( normalized-path -- available-space total-space free-space )
99 "ULARGE_INTEGER" <c-object>
100 "ULARGE_INTEGER" <c-object>
101 "ULARGE_INTEGER" <c-object>
102 [ GetDiskFreeSpaceEx win32-error=0/f ] 3keep ;
104 : calculate-file-system-info ( file-system-info -- file-system-info' )
105 [ dup [ total-space>> ] [ free-space>> ] bi - >>used-space drop ] keep ;
107 TUPLE: win32-file-system-info < file-system-info max-component flags device-serial ;
109 ERROR: not-absolute-path ;
111 : root-directory ( string -- string' )
112 unicode-prefix ?head drop
117 } 1&& [ 2 head "\\" append ] [ not-absolute-path ] if ;
119 M: winnt file-system-info ( path -- file-system-info )
120 normalize-path root-directory
121 dup [ volume-information ] [ file-system-space ] bi
122 \ win32-file-system-info new
123 swap *ulonglong >>free-space
124 swap *ulonglong >>total-space
125 swap *ulonglong >>available-space
128 swap *uint >>max-component
129 swap *uint >>device-serial
132 calculate-file-system-info ;
134 : volume>paths ( string -- array )
135 16384 "ushort" <c-array> tuck dup length
136 0 <uint> dup [ GetVolumePathNamesForVolumeName 0 = ] dip swap [
137 win32-error-string throw
139 *uint "ushort" heap-size * head
140 utf16n alien>string CHAR: \0 split
143 : find-first-volume ( -- string handle )
144 MAX_PATH 1+ [ <byte-array> ] keep
146 FindFirstVolume dup win32-error=0/f
147 [ utf16n alien>string ] dip ;
149 : find-next-volume ( handle -- string/f )
150 MAX_PATH 1+ [ <byte-array> tuck ] keep
152 GetLastError ERROR_NO_MORE_FILES =
153 [ drop f ] [ win32-error-string throw ] if
158 : find-volumes ( -- array )
162 [ _ find-next-volume dup ]
167 ] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi [ ] cleanup ;
169 M: winnt file-systems ( -- array )
170 find-volumes [ volume>paths ] map
173 [ drop \ file-system-info new swap >>mount-point ] recover
176 : file-times ( path -- timestamp timestamp timestamp )
178 normalize-path open-existing &dispose handle>>
179 "FILETIME" <c-object>
180 "FILETIME" <c-object>
181 "FILETIME" <c-object>
182 [ GetFileTime win32-error=0/f ] 3keep
183 [ FILETIME>timestamp >local-time ] tri@
186 : set-file-times ( path timestamp/f timestamp/f timestamp/f -- )
187 #! timestamp order: creation access write
190 normalize-path open-existing &dispose handle>>
191 ] 3dip (set-file-times)
194 : set-file-create-time ( path timestamp -- )
197 : set-file-access-time ( path timestamp -- )
198 [ f ] dip f set-file-times ;
200 : set-file-write-time ( path timestamp -- )
201 [ f f ] dip set-file-times ;