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>
|
||||
|
@ -117,6 +193,7 @@ ALIAS: ShellExecute ShellExecuteW
|
|||
|
||||
: program-files-common-x86 ( -- str )
|
||||
CSIDL_PROGRAM_FILES_COMMONX86 shell32-directory ;
|
||||
|
||||
|
||||
CONSTANT: SHCONTF_FOLDERS 32
|
||||
CONSTANT: SHCONTF_NONFOLDERS 64
|
||||
|
|
Loading…
Reference in New Issue