111 lines
3.6 KiB
Factor
111 lines
3.6 KiB
Factor
! Copyright (C) 2008 Doug Coleman.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: alien.c-types io.files io.windows kernel
|
|
math windows windows.kernel32 combinators.cleave
|
|
windows.time calendar combinators math.functions
|
|
sequences combinators.lib namespaces words ;
|
|
IN: io.windows.files
|
|
|
|
SYMBOL: +read-only+
|
|
SYMBOL: +hidden+
|
|
SYMBOL: +system+
|
|
SYMBOL: +directory+
|
|
SYMBOL: +archive+
|
|
SYMBOL: +device+
|
|
SYMBOL: +normal+
|
|
SYMBOL: +temporary+
|
|
SYMBOL: +sparse-file+
|
|
SYMBOL: +reparse-point+
|
|
SYMBOL: +compressed+
|
|
SYMBOL: +offline+
|
|
SYMBOL: +not-content-indexed+
|
|
SYMBOL: +encrypted+
|
|
|
|
: expand-constants ( word/obj -- obj'/obj )
|
|
dup word? [ execute ] when ;
|
|
|
|
: get-flags ( n seq -- seq' )
|
|
[
|
|
[
|
|
first2 expand-constants
|
|
[ swapd mask? [ , ] [ drop ] if ] 2curry
|
|
] map call-with
|
|
] { } make ;
|
|
|
|
: win32-file-attributes ( n -- seq )
|
|
{
|
|
{ +read-only+ FILE_ATTRIBUTE_READONLY }
|
|
{ +hidden+ FILE_ATTRIBUTE_HIDDEN }
|
|
{ +system+ FILE_ATTRIBUTE_SYSTEM }
|
|
{ +directory+ FILE_ATTRIBUTE_DIRECTORY }
|
|
{ +archive+ FILE_ATTRIBUTE_ARCHIVE }
|
|
{ +device+ FILE_ATTRIBUTE_DEVICE }
|
|
{ +normal+ FILE_ATTRIBUTE_NORMAL }
|
|
{ +temporary+ FILE_ATTRIBUTE_TEMPORARY }
|
|
{ +sparse-file+ FILE_ATTRIBUTE_SPARSE_FILE }
|
|
{ +reparse-point+ FILE_ATTRIBUTE_REPARSE_POINT }
|
|
{ +compressed+ FILE_ATTRIBUTE_COMPRESSED }
|
|
{ +offline+ FILE_ATTRIBUTE_OFFLINE }
|
|
{ +not-content-indexed+ FILE_ATTRIBUTE_NOT_CONTENT_INDEXED }
|
|
{ +encrypted+ FILE_ATTRIBUTE_ENCRYPTED }
|
|
} get-flags ;
|
|
|
|
: win32-file-type ( n -- symbol )
|
|
FILE_ATTRIBUTE_DIRECTORY mask? +directory+ +regular-file+ ? ;
|
|
|
|
: WIN32_FIND_DATA>file-info
|
|
{
|
|
[ WIN32_FIND_DATA-dwFileAttributes win32-file-type ]
|
|
[
|
|
[ WIN32_FIND_DATA-nFileSizeLow ]
|
|
[ WIN32_FIND_DATA-nFileSizeHigh ] bi >64bit
|
|
]
|
|
[ WIN32_FIND_DATA-dwFileAttributes ]
|
|
! [ WIN32_FIND_DATA-ftCreationTime FILETIME>timestamp ]
|
|
[ WIN32_FIND_DATA-ftLastWriteTime FILETIME>timestamp ]
|
|
! [ WIN32_FIND_DATA-ftLastAccessTime FILETIME>timestamp ]
|
|
} cleave
|
|
\ file-info construct-boa ;
|
|
|
|
: find-first-file-stat ( path -- WIN32_FIND_DATA )
|
|
"WIN32_FIND_DATA" <c-object> [
|
|
FindFirstFile
|
|
[ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep
|
|
FindClose win32-error=0/f
|
|
] keep ;
|
|
|
|
: BY_HANDLE_FILE_INFORMATION>file-info
|
|
{
|
|
[ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-type ]
|
|
[
|
|
[ BY_HANDLE_FILE_INFORMATION-nFileSizeLow ]
|
|
[ BY_HANDLE_FILE_INFORMATION-nFileSizeHigh ] bi >64bit
|
|
]
|
|
[ BY_HANDLE_FILE_INFORMATION-dwFileAttributes ]
|
|
! [ BY_HANDLE_FILE_INFORMATION-ftCreationTime FILETIME>timestamp ]
|
|
[ BY_HANDLE_FILE_INFORMATION-ftLastWriteTime FILETIME>timestamp ]
|
|
! [ BY_HANDLE_FILE_INFORMATION-ftLastAccessTime FILETIME>timestamp ]
|
|
} cleave
|
|
\ file-info construct-boa ;
|
|
|
|
: get-file-information ( handle -- BY_HANDLE_FILE_INFORMATION )
|
|
[
|
|
"BY_HANDLE_FILE_INFORMATION" <c-object>
|
|
[ GetFileInformationByHandle win32-error=0/f ] keep
|
|
] keep CloseHandle win32-error=0/f ;
|
|
|
|
: get-file-information-stat ( path -- BY_HANDLE_FILE_INFORMATION )
|
|
dup
|
|
GENERIC_READ FILE_SHARE_READ f
|
|
OPEN_EXISTING FILE_FLAG_BACKUP_SEMANTICS f
|
|
CreateFileW dup INVALID_HANDLE_VALUE = [
|
|
drop find-first-file-stat WIN32_FIND_DATA>file-info
|
|
] [
|
|
nip
|
|
get-file-information BY_HANDLE_FILE_INFORMATION>file-info
|
|
] if ;
|
|
|
|
M: windows-nt-io file-info ( path -- info )
|
|
get-file-information-stat ;
|
|
|