windows.shell32: Add a way to find out the kind of executable of a file on

windows. Inline a word.
db4
Doug Coleman 2012-10-24 16:15:28 -07:00
parent 8cfc758735
commit 0ae18456fd
2 changed files with 82 additions and 5 deletions

View File

@ -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

View File

@ -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