1 ! Copyright (C) 2008 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien.c-types io.binary io.backend io.files io.buffers
4 io.windows kernel math splitting
5 windows windows.kernel32 windows.time calendar combinators
6 math.functions sequences namespaces words symbols system
7 io.ports destructors accessors
8 math.bitfields math.bitfields.lib ;
11 : open-file ( path access-mode create-mode flags -- handle )
13 >r >r share-mode default-security-attributes r> r>
14 CreateFile-flags f CreateFile opened-file
17 : open-pipe-r/w ( path -- win32-file )
18 { GENERIC_READ GENERIC_WRITE } flags
19 OPEN_EXISTING 0 open-file ;
21 : open-read ( path -- win32-file )
22 GENERIC_READ OPEN_EXISTING 0 open-file 0 >>ptr ;
24 : open-write ( path -- win32-file )
25 GENERIC_WRITE CREATE_ALWAYS 0 open-file 0 >>ptr ;
27 : (open-append) ( path -- win32-file )
28 GENERIC_WRITE OPEN_ALWAYS 0 open-file ;
30 : open-existing ( path -- win32-file )
31 { GENERIC_READ GENERIC_WRITE } flags
35 FILE_FLAG_BACKUP_SEMANTICS
36 f CreateFileW dup win32-error=0/f <win32-file> ;
38 : maybe-create-file ( path -- win32-file ? )
39 #! return true if file was just created
40 { GENERIC_READ GENERIC_WRITE } flags
45 f CreateFileW dup win32-error=0/f <win32-file>
46 GetLastError ERROR_ALREADY_EXISTS = not ;
48 : set-file-pointer ( handle length method -- )
49 >r dupd d>w/w <uint> r> SetFilePointer
50 INVALID_SET_FILE_POINTER = [
51 CloseHandle "SetFilePointer failed" throw
54 HOOK: open-append os ( path -- win32-file )
57 hFile lpBuffer nNumberOfBytesToRead
58 lpNumberOfBytesRet lpOverlapped ;
60 C: <FileArgs> FileArgs
62 : make-FileArgs ( port -- <FileArgs> )
64 [ handle>> check-disposed ]
67 [ buffer>> buffer-length ]
68 [ drop "DWORD" <c-object> ]
69 [ FileArgs-overlapped ]
72 : setup-read ( <FileArgs> -- hFile lpBuffer nNumberOfBytesToRead lpNumberOfBytesRead lpOverlapped )
75 [ lpBuffer>> buffer-end ]
76 [ lpBuffer>> buffer-capacity ]
77 [ lpNumberOfBytesRet>> ]
81 : setup-write ( <FileArgs> -- hFile lpBuffer nNumberOfBytesToWrite lpNumberOfBytesWritten lpOverlapped )
84 [ lpBuffer>> buffer@ ]
85 [ lpBuffer>> buffer-length ]
86 [ lpNumberOfBytesRet>> ]
90 M: windows (file-reader) ( path -- stream )
91 open-read <input-port> ;
93 M: windows (file-writer) ( path -- stream )
94 open-write <output-port> ;
96 M: windows (file-appender) ( path -- stream )
97 open-append <output-port> ;
99 M: windows move-file ( from to -- )
100 [ normalize-path ] bi@ MoveFile win32-error=0/f ;
102 M: windows delete-file ( path -- )
103 normalize-path DeleteFile win32-error=0/f ;
105 M: windows copy-file ( from to -- )
106 dup parent-directory make-directories
107 [ normalize-path ] bi@ 0 CopyFile win32-error=0/f ;
109 M: windows make-directory ( path -- )
111 f CreateDirectory win32-error=0/f ;
113 M: windows delete-directory ( path -- )
115 RemoveDirectory win32-error=0/f ;
117 M: windows normalize-directory ( string -- string )
118 normalize-path "\\" ?tail drop "\\*" append ;
120 SYMBOLS: +read-only+ +hidden+ +system+
121 +archive+ +device+ +normal+ +temporary+
122 +sparse-file+ +reparse-point+ +compressed+ +offline+
123 +not-content-indexed+ +encrypted+ ;
125 : win32-file-attribute ( n attr symbol -- n )
126 >r dupd mask? r> swap [ , ] [ drop ] if ;
128 : win32-file-attributes ( n -- seq )
130 FILE_ATTRIBUTE_READONLY +read-only+ win32-file-attribute
131 FILE_ATTRIBUTE_HIDDEN +hidden+ win32-file-attribute
132 FILE_ATTRIBUTE_SYSTEM +system+ win32-file-attribute
133 FILE_ATTRIBUTE_DIRECTORY +directory+ win32-file-attribute
134 FILE_ATTRIBUTE_ARCHIVE +archive+ win32-file-attribute
135 FILE_ATTRIBUTE_DEVICE +device+ win32-file-attribute
136 FILE_ATTRIBUTE_NORMAL +normal+ win32-file-attribute
137 FILE_ATTRIBUTE_TEMPORARY +temporary+ win32-file-attribute
138 FILE_ATTRIBUTE_SPARSE_FILE +sparse-file+ win32-file-attribute
139 FILE_ATTRIBUTE_REPARSE_POINT +reparse-point+ win32-file-attribute
140 FILE_ATTRIBUTE_COMPRESSED +compressed+ win32-file-attribute
141 FILE_ATTRIBUTE_OFFLINE +offline+ win32-file-attribute
142 FILE_ATTRIBUTE_NOT_CONTENT_INDEXED +not-content-indexed+ win32-file-attribute
143 FILE_ATTRIBUTE_ENCRYPTED +encrypted+ win32-file-attribute
147 : win32-file-type ( n -- symbol )
148 FILE_ATTRIBUTE_DIRECTORY mask? +directory+ +regular-file+ ? ;
150 : WIN32_FIND_DATA>file-info ( WIN32_FIND_DATA -- file-info )
152 [ WIN32_FIND_DATA-dwFileAttributes win32-file-type ]
154 [ WIN32_FIND_DATA-nFileSizeLow ]
155 [ WIN32_FIND_DATA-nFileSizeHigh ] bi >64bit
157 [ WIN32_FIND_DATA-dwFileAttributes ]
158 ! [ WIN32_FIND_DATA-ftCreationTime FILETIME>timestamp ]
159 [ WIN32_FIND_DATA-ftLastWriteTime FILETIME>timestamp ]
160 ! [ WIN32_FIND_DATA-ftLastAccessTime FILETIME>timestamp ]
164 : find-first-file-stat ( path -- WIN32_FIND_DATA )
165 "WIN32_FIND_DATA" <c-object> [
167 [ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep
168 FindClose win32-error=0/f
171 : BY_HANDLE_FILE_INFORMATION>file-info ( HANDLE_FILE_INFORMATION -- file-info )
173 [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-type ]
175 [ BY_HANDLE_FILE_INFORMATION-nFileSizeLow ]
176 [ BY_HANDLE_FILE_INFORMATION-nFileSizeHigh ] bi >64bit
178 [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes ]
179 ! [ BY_HANDLE_FILE_INFORMATION-ftCreationTime FILETIME>timestamp ]
180 [ BY_HANDLE_FILE_INFORMATION-ftLastWriteTime FILETIME>timestamp ]
181 ! [ BY_HANDLE_FILE_INFORMATION-ftLastAccessTime FILETIME>timestamp ]
182 ! [ BY_HANDLE_FILE_INFORMATION-nNumberOfLinks ]
184 ! [ BY_HANDLE_FILE_INFORMATION-nFileIndexLow ]
185 ! [ BY_HANDLE_FILE_INFORMATION-nFileIndexHigh ] bi >64bit
190 : get-file-information ( handle -- BY_HANDLE_FILE_INFORMATION )
192 "BY_HANDLE_FILE_INFORMATION" <c-object>
193 [ GetFileInformationByHandle win32-error=0/f ] keep
194 ] keep CloseHandle win32-error=0/f ;
196 : get-file-information-stat ( path -- BY_HANDLE_FILE_INFORMATION )
198 GENERIC_READ FILE_SHARE_READ f
199 OPEN_EXISTING FILE_FLAG_BACKUP_SEMANTICS f
200 CreateFileW dup INVALID_HANDLE_VALUE = [
201 drop find-first-file-stat WIN32_FIND_DATA>file-info
204 get-file-information BY_HANDLE_FILE_INFORMATION>file-info
207 M: winnt file-info ( path -- info )
208 normalize-path get-file-information-stat ;
210 M: winnt link-info ( path -- info )
213 : file-times ( path -- timestamp timestamp timestamp )
215 normalize-path open-existing &dispose handle>>
216 "FILETIME" <c-object>
217 "FILETIME" <c-object>
218 "FILETIME" <c-object>
219 [ GetFileTime win32-error=0/f ] 3keep
220 [ FILETIME>timestamp >local-time ] tri@
223 : (set-file-times) ( handle timestamp/f timestamp/f timestamp/f -- )
224 [ timestamp>FILETIME ] tri@
225 SetFileTime win32-error=0/f ;
227 : set-file-times ( path timestamp/f timestamp/f timestamp/f -- )
228 #! timestamp order: creation access write
231 normalize-path open-existing &dispose handle>>
232 r> r> r> (set-file-times)
235 : set-file-create-time ( path timestamp -- )
238 : set-file-access-time ( path timestamp -- )
239 >r f r> f set-file-times ;
241 : set-file-write-time ( path timestamp -- )
242 >r f f r> set-file-times ;
244 M: winnt touch-file ( path -- )
247 maybe-create-file >r &dispose r>
248 [ drop ] [ handle>> f now dup (set-file-times) ] if