1 USING: alien alien.syntax alien.c-types alien.strings math
2 kernel sequences windows.errors windows.types io
3 accessors math.order namespaces make math.parser windows.kernel32
4 combinators locals specialized-arrays.direct.uchar
5 literals splitting grouping classes.struct combinators.smart ;
10 TYPEDEF: GUID* REFGUID
11 TYPEDEF: void* LPUNKNOWN
12 TYPEDEF: wchar_t* LPOLESTR
13 TYPEDEF: wchar_t* LPCOLESTR
15 TYPEDEF: REFGUID LPGUID
16 TYPEDEF: REFGUID REFIID
17 TYPEDEF: REFGUID REFCLSID
19 FUNCTION: HRESULT CoCreateInstance ( REFGUID rclsid, LPUNKNOWN pUnkOuter, DWORD dwClsContext, REFGUID riid, LPUNKNOWN out_ppv ) ;
20 FUNCTION: BOOL IsEqualGUID ( REFGUID rguid1, REFGUID rguid2 ) ;
21 FUNCTION: int StringFromGUID2 ( REFGUID rguid, LPOLESTR lpsz, int cchMax ) ;
22 FUNCTION: HRESULT CLSIDFromString ( LPOLESTR lpsz, REFGUID out_rguid ) ;
26 CONSTANT: E_NOINTERFACE HEX: 80004002
27 CONSTANT: E_FAIL HEX: 80004005
28 CONSTANT: E_INVALIDARG HEX: 80070057
30 CONSTANT: MK_ALT HEX: 20
31 CONSTANT: DROPEFFECT_NONE 0
32 CONSTANT: DROPEFFECT_COPY 1
33 CONSTANT: DROPEFFECT_MOVE 2
34 CONSTANT: DROPEFFECT_LINK 4
35 CONSTANT: DROPEFFECT_SCROLL HEX: 80000000
36 CONSTANT: DD_DEFSCROLLINSET 11
37 CONSTANT: DD_DEFSCROLLDELAY 50
38 CONSTANT: DD_DEFSCROLLINTERVAL 50
39 CONSTANT: DD_DEFDRAGDELAY 200
40 CONSTANT: DD_DEFDRAGMINDIST 2
44 CONSTANT: CF_METAFILEPICT 3
48 CONSTANT: CF_OEMTEXT 7
50 CONSTANT: CF_PALETTE 9
51 CONSTANT: CF_PENDATA 10
54 CONSTANT: CF_UNICODETEXT 13
55 CONSTANT: CF_ENHMETAFILE 14
57 CONSTANT: CF_LOCALE 16
60 CONSTANT: CF_OWNERDISPLAY HEX: 0080
61 CONSTANT: CF_DSPTEXT HEX: 0081
62 CONSTANT: CF_DSPBITMAP HEX: 0082
63 CONSTANT: CF_DSPMETAFILEPICT HEX: 0083
64 CONSTANT: CF_DSPENHMETAFILE HEX: 008E
66 CONSTANT: DVASPECT_CONTENT 1
67 CONSTANT: DVASPECT_THUMBNAIL 2
68 CONSTANT: DVASPECT_ICON 4
69 CONSTANT: DVASPECT_DOCPRINT 8
71 CONSTANT: TYMED_HGLOBAL 1
72 CONSTANT: TYMED_FILE 2
73 CONSTANT: TYMED_ISTREAM 4
74 CONSTANT: TYMED_ISTORAGE 8
75 CONSTANT: TYMED_GDI 16
76 CONSTANT: TYMED_MFPICT 32
77 CONSTANT: TYMED_ENHMF 64
78 CONSTANT: TYMED_NULL 0
80 C-STRUCT: DVTARGETDEVICE
82 { "WORD" "tdDriverNameOffset" }
83 { "WORD" "tdDeviceNameOffset" }
84 { "WORD" "tdPortNameOffset" }
85 { "WORD" "tdExtDevmodeOffset" }
86 { "BYTE[1]" "tdData" } ;
88 TYPEDEF: WORD CLIPFORMAT
92 { "CLIPFORMAT" "cfFormat" }
93 { "DVTARGETDEVICE*" "ptd" }
94 { "DWORD" "dwAspect" }
97 TYPEDEF: FORMATETC* LPFORMATETC
102 { "LPUNKNOWN" "punkForRelease" } ;
103 TYPEDEF: STGMEDIUM* LPSTGMEDIUM
105 CONSTANT: COINIT_MULTITHREADED 0
106 CONSTANT: COINIT_APARTMENTTHREADED 2
107 CONSTANT: COINIT_DISABLE_OLE1DDE 4
108 CONSTANT: COINIT_SPEED_OVER_MEMORY 8
110 FUNCTION: HRESULT OleInitialize ( void* reserved ) ;
111 FUNCTION: HRESULT CoInitializeEx ( void* reserved, DWORD dwCoInit ) ;
113 FUNCTION: HRESULT RegisterDragDrop ( HWND hWnd, IDropTarget* pDropTarget ) ;
114 FUNCTION: HRESULT RevokeDragDrop ( HWND hWnd ) ;
115 FUNCTION: void ReleaseStgMedium ( LPSTGMEDIUM pmedium ) ;
117 : succeeded? ( hresult -- ? )
118 0 HEX: 7FFFFFFF between? ;
120 TUPLE: ole32-error code message ;
122 : <ole32-error> ( code -- error )
123 dup n>win32-error-string \ ole32-error boa ;
125 : ole32-error ( hresult -- )
126 dup succeeded? [ drop ] [ <ole32-error> throw ] if ;
128 : ole-initialize ( -- )
129 f OleInitialize ole32-error ;
132 [ 16 memory>byte-array ] bi@ = ;
134 CONSTANT: GUID-STRING-LENGTH
135 $[ "{01234567-89ab-cdef-0123-456789abcdef}" length ]
137 : string>guid ( string -- guid )
139 [ first3 [ hex> ] tri@ ]
140 [ 3 tail concat 2 group [ hex> ] B{ } map-as ] bi
143 : guid>string ( guid -- string )
146 [ Data1>> >hex 8 CHAR: 0 pad-head "-" ]
147 [ Data2>> >hex 4 CHAR: 0 pad-head "-" ]
148 [ Data3>> >hex 4 CHAR: 0 pad-head "-" ]
152 [ >hex 2 CHAR: 0 pad-head ]
153 [ >hex 2 CHAR: 0 pad-head "-" ]
154 [ >hex 2 CHAR: 0 pad-head ]
155 [ >hex 2 CHAR: 0 pad-head ]
156 [ >hex 2 CHAR: 0 pad-head ]
157 [ >hex 2 CHAR: 0 pad-head ]
158 [ >hex 2 CHAR: 0 pad-head ]
159 [ >hex 2 CHAR: 0 pad-head ]
164 ] "" append-outputs-as ;