windows.shell32: Add a way to find out the kind of executable of a file on
windows. Inline a word.db4
							parent
							
								
									8cfc758735
								
							
						
					
					
						commit
						0ae18456fd
					
				| 
						 | 
				
			
			@ -171,7 +171,7 @@ PRIVATE>
 | 
			
		|||
 | 
			
		||||
: lo-word ( wparam -- lo ) c:short <ref> c:short deref ; inline
 | 
			
		||||
: hi-word ( wparam -- hi ) -16 shift lo-word ; inline
 | 
			
		||||
: >lo-hi ( WORD -- array ) [ lo-word ] [ hi-word ] bi 2array ;
 | 
			
		||||
: >lo-hi ( WORD -- array ) [ lo-word ] [ hi-word ] bi 2array ; inline
 | 
			
		||||
: GET_APPCOMMAND_LPARAM ( lParam -- appCommand )
 | 
			
		||||
    hi-word FAPPCOMMAND_MASK lo-word bitnot bitand ; inline
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,9 +1,11 @@
 | 
			
		|||
! Copyright (C) 2006, 2008 Doug Coleman.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: alien alien.c-types alien.data alien.strings alien.syntax
 | 
			
		||||
classes.struct combinators io.files io.pathnames kernel
 | 
			
		||||
windows.errors windows.com windows.com.syntax windows.types
 | 
			
		||||
windows.user32 windows.ole32 windows specialized-arrays ;
 | 
			
		||||
USING: alien alien.c-types alien.data alien.strings
 | 
			
		||||
alien.syntax classes.struct combinators io.backend io.files
 | 
			
		||||
io.pathnames kernel math sequences specialized-arrays
 | 
			
		||||
ui.backend.windows windows windows.com windows.com.syntax
 | 
			
		||||
windows.errors windows.kernel32 windows.ole32 windows.types
 | 
			
		||||
windows.user32 ;
 | 
			
		||||
SPECIALIZED-ARRAY: ushort
 | 
			
		||||
IN: windows.shell32
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -86,6 +88,80 @@ ALIAS: SHGetFolderPath SHGetFolderPathW
 | 
			
		|||
FUNCTION: HINSTANCE ShellExecuteW ( HWND hwnd, LPCTSTR lpOperation, LPCTSTR lpFile, LPCTSTR lpParameters, LPCTSTR lpDirectory, INT nShowCmd ) ;
 | 
			
		||||
ALIAS: ShellExecute ShellExecuteW
 | 
			
		||||
 | 
			
		||||
CONSTANT: SHGFI_ICON 0x000000100
 | 
			
		||||
CONSTANT: SHGFI_DISPLAYNAME 0x000000200
 | 
			
		||||
CONSTANT: SHGFI_TYPENAME 0x000000400
 | 
			
		||||
CONSTANT: SHGFI_ATTRIBUTES 0x000000800
 | 
			
		||||
CONSTANT: SHGFI_ICONLOCATION 0x000001000
 | 
			
		||||
CONSTANT: SHGFI_EXETYPE 0x000002000
 | 
			
		||||
CONSTANT: SHGFI_SYSICONINDEX 0x000004000
 | 
			
		||||
CONSTANT: SHGFI_LINKOVERLAY 0x000008000
 | 
			
		||||
CONSTANT: SHGFI_SELECTED 0x000010000
 | 
			
		||||
CONSTANT: SHGFI_ATTR_SPECIFIED 0x000020000
 | 
			
		||||
CONSTANT: SHGFI_LARGEICON 0x000000000
 | 
			
		||||
CONSTANT: SHGFI_SMALLICON 0x000000001
 | 
			
		||||
CONSTANT: SHGFI_OPENICON 0x000000002
 | 
			
		||||
CONSTANT: SHGFI_SHELLICONSIZE 0x000000004
 | 
			
		||||
CONSTANT: SHGFI_PIDL 0x000000008
 | 
			
		||||
CONSTANT: SHGFI_USEFILEATTRIBUTES 0x000000010
 | 
			
		||||
CONSTANT: SHGFI_ADDOVERLAYS 0x000000020
 | 
			
		||||
CONSTANT: SHGFI_OVERLAYINDEX 0x000000040
 | 
			
		||||
 | 
			
		||||
STRUCT: SHFILEINFO
 | 
			
		||||
    { hIcon HICON }
 | 
			
		||||
    { iIcon int }
 | 
			
		||||
    { dwAttributes DWORD }
 | 
			
		||||
    { szDisplayName TCHAR[MAX_PATH] }
 | 
			
		||||
    { szTypeName TCHAR[80] } ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: DWORD_PTR SHGetFileInfoW (
 | 
			
		||||
    LPCTSTR pszPath,
 | 
			
		||||
    DWORD dwFileAttributes,
 | 
			
		||||
    SHFILEINFO *psfi,
 | 
			
		||||
    UINT cbFileInfo,
 | 
			
		||||
    UINT uFlags
 | 
			
		||||
) ;
 | 
			
		||||
 | 
			
		||||
: shell32-file-info ( path -- err struct )
 | 
			
		||||
    normalize-path
 | 
			
		||||
    0
 | 
			
		||||
    SHFILEINFO <struct>
 | 
			
		||||
    [ dup byte-length SHGFI_EXETYPE SHGetFileInfoW ] keep ;
 | 
			
		||||
 | 
			
		||||
SINGLETONS:
 | 
			
		||||
    +dos-executable+
 | 
			
		||||
    +win32-console-executable+
 | 
			
		||||
    +win32-vxd-executable+
 | 
			
		||||
    +win32-os2-executable+
 | 
			
		||||
    +win32-nt-executable+ ;
 | 
			
		||||
 | 
			
		||||
MIXIN: windows-executable
 | 
			
		||||
INSTANCE: +dos-executable+ windows-executable        ! mz
 | 
			
		||||
INSTANCE: +win32-console-executable+ windows-executable
 | 
			
		||||
INSTANCE: +win32-vxd-executable+ windows-executable  ! le
 | 
			
		||||
INSTANCE: +win32-os2-executable+ windows-executable  ! ne
 | 
			
		||||
INSTANCE: +win32-nt-executable+ windows-executable   ! pe
 | 
			
		||||
    
 | 
			
		||||
: file-executable-type ( path -- executable/f )
 | 
			
		||||
    normalize-path
 | 
			
		||||
    0
 | 
			
		||||
    f
 | 
			
		||||
    ! hi is zero means old style executable
 | 
			
		||||
    0 SHGFI_EXETYPE SHGetFileInfoW >lo-hi first2 zero? [
 | 
			
		||||
        {
 | 
			
		||||
            { 0x5A4D [ +dos-executable+ ] }
 | 
			
		||||
            { 0x4550 [ +win32-console-executable+ ] }
 | 
			
		||||
            [ drop f ]
 | 
			
		||||
        } case
 | 
			
		||||
    ] [
 | 
			
		||||
        {
 | 
			
		||||
            { 0x454C [ +win32-vxd-executable+ ] }
 | 
			
		||||
            { 0x454E [ +win32-os2-executable+ ] }
 | 
			
		||||
            { 0x4550 [ +win32-nt-executable+ ] }
 | 
			
		||||
            [ drop f ]
 | 
			
		||||
        } case
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
: shell32-directory ( n -- str )
 | 
			
		||||
    f swap f SHGFP_TYPE_DEFAULT
 | 
			
		||||
    MAX_UNICODE_PATH ushort <c-array>
 | 
			
		||||
| 
						 | 
				
			
			@ -118,6 +194,7 @@ ALIAS: ShellExecute ShellExecuteW
 | 
			
		|||
: program-files-common-x86 ( -- str )
 | 
			
		||||
    CSIDL_PROGRAM_FILES_COMMONX86 shell32-directory ;
 | 
			
		||||
    
 | 
			
		||||
 | 
			
		||||
CONSTANT: SHCONTF_FOLDERS 32
 | 
			
		||||
CONSTANT: SHCONTF_NONFOLDERS 64
 | 
			
		||||
CONSTANT: SHCONTF_INCLUDEHIDDEN 128
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue