implement file-systems on windows

db4
Doug Coleman 2008-11-11 15:17:35 -06:00
parent 17916ed7f2
commit 146340690f
2 changed files with 25 additions and 8 deletions

View File

@ -276,18 +276,31 @@ M: winnt file-system-info ( path -- file-system-info )
swap >>type
swap >>mount-point ;
: volume>paths ( string -- array )
16384 "ushort" <c-array> tuck dup length
0 <uint> dup [ GetVolumePathNamesForVolumeName 0 = ] dip swap [
win32-error-string throw
] [
*uint "ushort" heap-size * head
utf16n alien>string CHAR: \0 split
] if ;
: find-first-volume ( -- string handle )
MAX_PATH 1+ <byte-array> dup length
dupd
FindFirstVolume dup win32-error=0/f
[ utf16n alien>string ] dip ;
: find-next-volume ( handle -- string )
: find-next-volume ( handle -- string/f )
MAX_PATH 1+ <byte-array> dup length
[ FindNextVolume win32-error=0/f ] 2keep drop
utf16n alien>string ;
over [ FindNextVolume ] dip swap 0 = [
GetLastError ERROR_NO_MORE_FILES =
[ drop f ] [ win32-error ] if
] [
utf16n alien>string
] if ;
: mounted ( -- array )
M: winnt file-systems ( -- array )
find-first-volume
[
'[
@ -296,7 +309,8 @@ M: winnt file-system-info ( path -- file-system-info )
[ drop ] produce
swap prefix
]
] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi [ ] cleanup ;
] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi [ ] cleanup
[ volume>paths ] map ;
: file-times ( path -- timestamp timestamp timestamp )
[

View File

@ -954,7 +954,8 @@ ALIAS: GetDiskFreeSpaceEx GetDiskFreeSpaceExW
! FUNCTION: GetDllDirectoryA
! FUNCTION: GetDllDirectoryW
! FUNCTION: GetDriveTypeA
! FUNCTION: GetDriveTypeW
FUNCTION: UINT GetDriveTypeW ( LPCTSTR lpRootPathName ) ;
ALIAS: GetDriveType GetDriveTypeW
FUNCTION: void* GetEnvironmentStringsW ( ) ;
! FUNCTION: GetEnvironmentStringsA
ALIAS: GetEnvironmentStrings GetEnvironmentStringsW
@ -999,7 +1000,7 @@ FUNCTION: DWORD GetLastError ( ) ;
! FUNCTION: GetLocaleInfoA
! FUNCTION: GetLocaleInfoW
! FUNCTION: GetLocalTime
! FUNCTION: GetLogicalDrives
FUNCTION: DWORD GetLogicalDrives ( ) ;
! FUNCTION: GetLogicalDriveStringsA
! FUNCTION: GetLogicalDriveStringsW
! FUNCTION: GetLongPathNameA
@ -1129,7 +1130,9 @@ ALIAS: GetVolumeInformation GetVolumeInformationW
! FUNCTION: GetVolumeNameForVolumeMountPointW
! FUNCTION: GetVolumePathNameA
! FUNCTION: GetVolumePathNamesForVolumeNameA
! FUNCTION: GetVolumePathNamesForVolumeNameW
FUNCTION: BOOL GetVolumePathNamesForVolumeNameW ( LPCTSTR lpszVolumeName, LPTSTR lpszVolumePathNames, DWORD cchBufferLength, PDWORD lpcchReturnLength ) ;
ALIAS: GetVolumePathNamesForVolumeName GetVolumePathNamesForVolumeNameW
! FUNCTION: GetVolumePathNameW
! FUNCTION: GetWindowsDirectoryA
FUNCTION: UINT GetWindowsDirectoryW ( LPTSTR lpBuffer, UINT uSize ) ;