]> gitweb.factorcode.org Git - factor.git/blob - basis/windows/shell32/shell32.factor
windows.shell32: Throw an error if file does not exist on file-executable?
[factor.git] / basis / windows / shell32 / shell32.factor
1 ! Copyright (C) 2006, 2008 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien alien.c-types alien.data alien.strings
4 alien.syntax classes.struct combinators io.backend io.files
5 io.pathnames kernel math sequences specialized-arrays
6 ui.backend.windows windows windows.com windows.com.syntax
7 windows.errors windows.kernel32 windows.ole32 windows.types
8 windows.user32 io.files.info ;
9 SPECIALIZED-ARRAY: ushort
10 IN: windows.shell32
11
12 CONSTANT: CSIDL_DESKTOP 0x00
13 CONSTANT: CSIDL_INTERNET 0x01
14 CONSTANT: CSIDL_PROGRAMS 0x02
15 CONSTANT: CSIDL_CONTROLS 0x03
16 CONSTANT: CSIDL_PRINTERS 0x04
17 CONSTANT: CSIDL_PERSONAL 0x05
18 CONSTANT: CSIDL_FAVORITES 0x06
19 CONSTANT: CSIDL_STARTUP 0x07
20 CONSTANT: CSIDL_RECENT 0x08
21 CONSTANT: CSIDL_SENDTO 0x09
22 CONSTANT: CSIDL_BITBUCKET 0x0a
23 CONSTANT: CSIDL_STARTMENU 0x0b
24 CONSTANT: CSIDL_MYDOCUMENTS 0x0c
25 CONSTANT: CSIDL_MYMUSIC 0x0d
26 CONSTANT: CSIDL_MYVIDEO 0x0e
27 CONSTANT: CSIDL_DESKTOPDIRECTORY 0x10
28 CONSTANT: CSIDL_DRIVES 0x11
29 CONSTANT: CSIDL_NETWORK 0x12
30 CONSTANT: CSIDL_NETHOOD 0x13
31 CONSTANT: CSIDL_FONTS 0x14
32 CONSTANT: CSIDL_TEMPLATES 0x15
33 CONSTANT: CSIDL_COMMON_STARTMENU 0x16
34 CONSTANT: CSIDL_COMMON_PROGRAMS 0x17
35 CONSTANT: CSIDL_COMMON_STARTUP 0x18
36 CONSTANT: CSIDL_COMMON_DESKTOPDIRECTORY 0x19
37 CONSTANT: CSIDL_APPDATA 0x1a
38 CONSTANT: CSIDL_PRINTHOOD 0x1b
39 CONSTANT: CSIDL_LOCAL_APPDATA 0x1c
40 CONSTANT: CSIDL_ALTSTARTUP 0x1d
41 CONSTANT: CSIDL_COMMON_ALTSTARTUP 0x1e
42 CONSTANT: CSIDL_COMMON_FAVORITES 0x1f
43 CONSTANT: CSIDL_INTERNET_CACHE 0x20
44 CONSTANT: CSIDL_COOKIES 0x21
45 CONSTANT: CSIDL_HISTORY 0x22
46 CONSTANT: CSIDL_COMMON_APPDATA 0x23
47 CONSTANT: CSIDL_WINDOWS 0x24
48 CONSTANT: CSIDL_SYSTEM 0x25
49 CONSTANT: CSIDL_PROGRAM_FILES 0x26
50 CONSTANT: CSIDL_MYPICTURES 0x27
51 CONSTANT: CSIDL_PROFILE 0x28
52 CONSTANT: CSIDL_SYSTEMX86 0x29
53 CONSTANT: CSIDL_PROGRAM_FILESX86 0x2a
54 CONSTANT: CSIDL_PROGRAM_FILES_COMMON 0x2b
55 CONSTANT: CSIDL_PROGRAM_FILES_COMMONX86 0x2c
56 CONSTANT: CSIDL_COMMON_TEMPLATES 0x2d
57 CONSTANT: CSIDL_COMMON_DOCUMENTS 0x2e
58 CONSTANT: CSIDL_COMMON_ADMINTOOLS 0x2f
59 CONSTANT: CSIDL_ADMINTOOLS 0x30
60 CONSTANT: CSIDL_CONNECTIONS 0x31
61 CONSTANT: CSIDL_COMMON_MUSIC 0x35
62 CONSTANT: CSIDL_COMMON_PICTURES 0x36
63 CONSTANT: CSIDL_COMMON_VIDEO 0x37
64 CONSTANT: CSIDL_RESOURCES 0x38
65 CONSTANT: CSIDL_RESOURCES_LOCALIZED 0x39
66 CONSTANT: CSIDL_COMMON_OEM_LINKS 0x3a
67 CONSTANT: CSIDL_CDBURN_AREA 0x3b
68 CONSTANT: CSIDL_COMPUTERSNEARME 0x3d
69 CONSTANT: CSIDL_PROFILES 0x3e
70 CONSTANT: CSIDL_FOLDER_MASK 0xff
71 CONSTANT: CSIDL_FLAG_PER_USER_INIT 0x800
72 CONSTANT: CSIDL_FLAG_NO_ALIAS 0x1000
73 CONSTANT: CSIDL_FLAG_DONT_VERIFY 0x4000
74 CONSTANT: CSIDL_FLAG_CREATE 0x8000
75 CONSTANT: CSIDL_FLAG_MASK 0xff00
76
77
78 CONSTANT: ERROR_FILE_NOT_FOUND 2
79
80 CONSTANT: SHGFP_TYPE_CURRENT 0
81 CONSTANT: SHGFP_TYPE_DEFAULT 1
82
83 LIBRARY: shell32
84
85 FUNCTION: HRESULT SHGetFolderPathW ( HWND hwndOwner, int nFolder, HANDLE hToken, DWORD dwReserved, LPTSTR pszPath ) ;
86 ALIAS: SHGetFolderPath SHGetFolderPathW
87
88 FUNCTION: HINSTANCE ShellExecuteW ( HWND hwnd, LPCTSTR lpOperation, LPCTSTR lpFile, LPCTSTR lpParameters, LPCTSTR lpDirectory, INT nShowCmd ) ;
89 ALIAS: ShellExecute ShellExecuteW
90
91 CONSTANT: SHGFI_ICON 0x000000100
92 CONSTANT: SHGFI_DISPLAYNAME 0x000000200
93 CONSTANT: SHGFI_TYPENAME 0x000000400
94 CONSTANT: SHGFI_ATTRIBUTES 0x000000800
95 CONSTANT: SHGFI_ICONLOCATION 0x000001000
96 CONSTANT: SHGFI_EXETYPE 0x000002000
97 CONSTANT: SHGFI_SYSICONINDEX 0x000004000
98 CONSTANT: SHGFI_LINKOVERLAY 0x000008000
99 CONSTANT: SHGFI_SELECTED 0x000010000
100 CONSTANT: SHGFI_ATTR_SPECIFIED 0x000020000
101 CONSTANT: SHGFI_LARGEICON 0x000000000
102 CONSTANT: SHGFI_SMALLICON 0x000000001
103 CONSTANT: SHGFI_OPENICON 0x000000002
104 CONSTANT: SHGFI_SHELLICONSIZE 0x000000004
105 CONSTANT: SHGFI_PIDL 0x000000008
106 CONSTANT: SHGFI_USEFILEATTRIBUTES 0x000000010
107 CONSTANT: SHGFI_ADDOVERLAYS 0x000000020
108 CONSTANT: SHGFI_OVERLAYINDEX 0x000000040
109
110 STRUCT: SHFILEINFO
111     { hIcon HICON }
112     { iIcon int }
113     { dwAttributes DWORD }
114     { szDisplayName TCHAR[MAX_PATH] }
115     { szTypeName TCHAR[80] } ;
116
117 FUNCTION: DWORD_PTR SHGetFileInfoW (
118     LPCTSTR pszPath,
119     DWORD dwFileAttributes,
120     SHFILEINFO *psfi,
121     UINT cbFileInfo,
122     UINT uFlags
123 ) ;
124
125 : shell32-file-info ( path -- err struct )
126     normalize-path
127     0
128     SHFILEINFO <struct>
129     [ dup byte-length SHGFI_EXETYPE SHGetFileInfoW ] keep ;
130
131 SINGLETONS:
132     +dos-executable+
133     +win32-console-executable+
134     +win32-vxd-executable+
135     +win32-os2-executable+
136     +win32-nt-executable+ ;
137
138 MIXIN: windows-executable
139 INSTANCE: +dos-executable+ windows-executable        ! mz
140 INSTANCE: +win32-console-executable+ windows-executable
141 INSTANCE: +win32-vxd-executable+ windows-executable  ! le
142 INSTANCE: +win32-os2-executable+ windows-executable  ! ne
143 INSTANCE: +win32-nt-executable+ windows-executable   ! pe
144
145 : file-executable-type ( path -- executable/f )
146     normalize-path dup
147     0
148     f
149     ! hi is zero means old style executable
150     0 SHGFI_EXETYPE SHGetFileInfoW
151     [
152         file-info drop f
153     ] [
154         nip >lo-hi first2 zero? [
155             {
156                 { 0x5A4D [ +dos-executable+ ] }
157                 { 0x4550 [ +win32-console-executable+ ] }
158                 [ drop f ]
159             } case
160         ] [
161             {
162                 { 0x454C [ +win32-vxd-executable+ ] }
163                 { 0x454E [ +win32-os2-executable+ ] }
164                 { 0x4550 [ +win32-nt-executable+ ] }
165                 [ drop f ]
166             } case
167         ] if
168     ] if-zero ;
169
170 : shell32-directory ( n -- str )
171     f swap f SHGFP_TYPE_DEFAULT
172     MAX_UNICODE_PATH ushort <c-array>
173     [ SHGetFolderPath drop ] keep alien>native-string ;
174
175 : desktop ( -- str )
176     CSIDL_DESKTOPDIRECTORY shell32-directory ;
177
178 : my-documents ( -- str )
179     CSIDL_PERSONAL shell32-directory ;
180
181 : application-data ( -- str )
182     CSIDL_APPDATA shell32-directory ;
183
184 : windows-directory ( -- str )
185     CSIDL_WINDOWS shell32-directory ;
186
187 : programs ( -- str )
188     CSIDL_PROGRAMS shell32-directory ;
189
190 : program-files ( -- str )
191     CSIDL_PROGRAM_FILES shell32-directory ;
192
193 : program-files-x86 ( -- str )
194     CSIDL_PROGRAM_FILESX86 shell32-directory ;
195
196 : program-files-common ( -- str )
197     CSIDL_PROGRAM_FILES_COMMON shell32-directory ;
198
199 : program-files-common-x86 ( -- str )
200     CSIDL_PROGRAM_FILES_COMMONX86 shell32-directory ;
201     
202
203 CONSTANT: SHCONTF_FOLDERS 32
204 CONSTANT: SHCONTF_NONFOLDERS 64
205 CONSTANT: SHCONTF_INCLUDEHIDDEN 128
206 CONSTANT: SHCONTF_INIT_ON_FIRST_NEXT 256
207 CONSTANT: SHCONTF_NETPRINTERSRCH 512
208 CONSTANT: SHCONTF_SHAREABLE 1024
209 CONSTANT: SHCONTF_STORAGE 2048
210
211 TYPEDEF: DWORD SHCONTF
212
213 CONSTANT: SHGDN_NORMAL 0
214 CONSTANT: SHGDN_INFOLDER 1
215 CONSTANT: SHGDN_FOREDITING 0x1000
216 CONSTANT: SHGDN_INCLUDE_NONFILESYS 0x2000
217 CONSTANT: SHGDN_FORADDRESSBAR 0x4000
218 CONSTANT: SHGDN_FORPARSING 0x8000
219
220 TYPEDEF: DWORD SHGDNF
221
222 ALIAS: SFGAO_CANCOPY           DROPEFFECT_COPY
223 ALIAS: SFGAO_CANMOVE           DROPEFFECT_MOVE
224 ALIAS: SFGAO_CANLINK           DROPEFFECT_LINK
225 CONSTANT: SFGAO_CANRENAME         0x00000010
226 CONSTANT: SFGAO_CANDELETE         0x00000020
227 CONSTANT: SFGAO_HASPROPSHEET      0x00000040
228 CONSTANT: SFGAO_DROPTARGET        0x00000100
229 CONSTANT: SFGAO_CAPABILITYMASK    0x00000177
230 CONSTANT: SFGAO_LINK              0x00010000
231 CONSTANT: SFGAO_SHARE             0x00020000
232 CONSTANT: SFGAO_READONLY          0x00040000
233 CONSTANT: SFGAO_GHOSTED           0x00080000
234 CONSTANT: SFGAO_HIDDEN            0x00080000
235 CONSTANT: SFGAO_DISPLAYATTRMASK   0x000F0000
236 CONSTANT: SFGAO_FILESYSANCESTOR   0x10000000
237 CONSTANT: SFGAO_FOLDER            0x20000000
238 CONSTANT: SFGAO_FILESYSTEM        0x40000000
239 CONSTANT: SFGAO_HASSUBFOLDER      0x80000000
240 CONSTANT: SFGAO_CONTENTSMASK      0x80000000
241 CONSTANT: SFGAO_VALIDATE          0x01000000
242 CONSTANT: SFGAO_REMOVABLE         0x02000000
243 CONSTANT: SFGAO_COMPRESSED        0x04000000
244 CONSTANT: SFGAO_BROWSABLE         0x08000000
245 CONSTANT: SFGAO_NONENUMERATED     0x00100000
246 CONSTANT: SFGAO_NEWCONTENT        0x00200000
247
248 TYPEDEF: ULONG SFGAOF
249
250 STRUCT: DROPFILES
251     { pFiles DWORD }
252     { pt POINT }
253     { fNC BOOL }
254     { fWide BOOL } ;
255 TYPEDEF: DROPFILES* LPDROPFILES
256 TYPEDEF: DROPFILES* LPCDROPFILES
257 TYPEDEF: HANDLE HDROP
258
259 STRUCT: SHITEMID
260     { cb USHORT }
261     { abID BYTE[1] } ;
262 TYPEDEF: SHITEMID* LPSHITEMID
263 TYPEDEF: SHITEMID* LPCSHITEMID
264
265 STRUCT: ITEMIDLIST
266     { mkid SHITEMID } ;
267 TYPEDEF: ITEMIDLIST* LPITEMIDLIST
268 TYPEDEF: ITEMIDLIST* LPCITEMIDLIST
269 TYPEDEF: ITEMIDLIST ITEMID_CHILD
270 TYPEDEF: ITEMID_CHILD* PITEMID_CHILD
271 TYPEDEF: ITEMID_CHILD* PCUITEMID_CHILD
272
273 CONSTANT: STRRET_WSTR 0
274 CONSTANT: STRRET_OFFSET 1
275 CONSTANT: STRRET_CSTR 2
276
277 UNION-STRUCT: STRRET-union
278     { pOleStr LPWSTR }
279     { uOffset UINT }
280     { cStr char[260] } ;
281 STRUCT: STRRET
282     { uType int }
283     { value STRRET-union } ;
284
285 COM-INTERFACE: IEnumIDList IUnknown {000214F2-0000-0000-C000-000000000046}
286     HRESULT Next ( ULONG celt, LPITEMIDLIST* rgelt, ULONG* pceltFetched )
287     HRESULT Skip ( ULONG celt )
288     HRESULT Reset ( )
289     HRESULT Clone ( IEnumIDList** ppenum ) ;
290
291 COM-INTERFACE: IShellFolder IUnknown {000214E6-0000-0000-C000-000000000046}
292     HRESULT ParseDisplayName ( HWND hwndOwner, void* pbcReserved, LPOLESTR lpszDisplayName, ULONG* pchEaten, LPITEMIDLIST* ppidl, ULONG* pdwAttributes )
293     HRESULT EnumObjects ( HWND hwndOwner, SHCONTF grfFlags, IEnumIDList** ppenumIDList )
294     HRESULT BindToObject ( LPCITEMIDLIST pidl, void* pbcReserved, REFGUID riid, void** ppvOut )
295     HRESULT BindToStorage ( LPCITEMIDLIST pidl, void* pbcReserved, REFGUID riid, void** ppvObj )
296     HRESULT CompareIDs ( LPARAM lParam, LPCITEMIDLIST pidl1, LPCITEMIDLIST pidl2 )
297     HRESULT CreateViewObject ( HWND hwndOwner, REFGUID riid, void** ppvOut )
298     HRESULT GetAttributesOf ( UINT cidl, LPCITEMIDLIST* apidl, SFGAOF* rgfInOut )
299     HRESULT GetUIObjectOf ( HWND hwndOwner, UINT cidl, LPCITEMIDLIST* apidl, REFGUID riid, UINT* prgfInOut, void** ppvOut )
300     HRESULT GetDisplayNameOf ( LPCITEMIDLIST pidl, SHGDNF uFlags, STRRET* lpName )
301     HRESULT SetNameOf ( HWND hwnd, LPCITEMIDLIST pidl, LPCOLESTR lpszName, SHGDNF uFlags, LPITEMIDLIST* ppidlOut ) ;
302
303 FUNCTION: HRESULT SHGetDesktopFolder ( IShellFolder** ppshf ) ;
304
305 FUNCTION: UINT DragQueryFileW ( HDROP hDrop, UINT iFile, LPWSTR lpszFile, UINT cch ) ;
306 ALIAS: DragQueryFile DragQueryFileW
307
308 FUNCTION: BOOL IsUserAnAdmin ( ) ;