windows.ole32: add create-guid

diff --git a/basis/windows/ole32/ole32-docs.factor b/basis/windows/ole32/ole32-docs.factor
new file mode 100644 (file)
index 0000000..0947247
--- /dev/null
+++ b/basis/windows/ole32/ole32-docs.factor
@@ -0,0 +1,10 @@
+! Copyright (C) 2016 Alexander Ilin.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax kernel windows.kernel32 ;
+IN: windows.ole32
+
+HELP: create-guid
+{ $values
+    { "GUID" GUID }
+}
+{ $description "Generate a new random " { $link GUID } " value." } ;

diff --git a/basis/windows/ole32/ole32-tests.factor b/basis/windows/ole32/ole32-tests.factor
index 2e25f80a53f0d0a8bd418ea3e0787e9942998e2b..a4645a30ce954dca2a6bead5a8c28fac7a17f1ef 100644 (file)
--- a/basis/windows/ole32/ole32-tests.factor
+++ b/basis/windows/ole32/ole32-tests.factor
@@ -1,6 +1,7 @@
-USING: kernel tools.test windows.ole32 alien.c-types
-classes.struct specialized-arrays windows.kernel32
-windows.com.syntax ;
+USING: alien.c-types classes.struct kernel math sequences
+specialized-arrays
+specialized-arrays.instances.alien.c-types.uchar tools.test
+windows.com.syntax windows.kernel32 windows.ole32 ;

 SPECIALIZED-ARRAY: uchar
 IN: windows.ole32.tests
 
 SPECIALIZED-ARRAY: uchar
 IN: windows.ole32.tests
 


@@ -29,3 +30,5 @@ IN: windows.ole32.tests
 [ "{01234567-89ab-cdef-0123-456789abcdef}" ]
 [ "{01234567-89ab-cdef-0123-456789abcdef}" string>guid guid>string ]
 unit-test
 [ "{01234567-89ab-cdef-0123-456789abcdef}" ]
 [ "{01234567-89ab-cdef-0123-456789abcdef}" string>guid guid>string ]
 unit-test

+
+{ 0 } [ 10 [ create-guid ] replicate duplicates length ] unit-test

diff --git a/basis/windows/ole32/ole32.factor b/basis/windows/ole32/ole32.factor
index 02eb52c28e6b80d09618bfe5811569485285f5c0..47c45c8d2f152a08f61892f335eb6b5f15c1d9a1 100644 (file)
--- a/basis/windows/ole32/ole32.factor
+++ b/basis/windows/ole32/ole32.factor
@@ -21,6 +21,7 @@ TYPEDEF: REFGUID REFIID
 TYPEDEF: REFGUID REFCLSID
 
 FUNCTION: HRESULT CoCreateInstance ( REFGUID rclsid, LPUNKNOWN pUnkOuter, DWORD dwClsContext, REFGUID riid, LPUNKNOWN out_ppv )
 TYPEDEF: REFGUID REFCLSID
 
 FUNCTION: HRESULT CoCreateInstance ( REFGUID rclsid, LPUNKNOWN pUnkOuter, DWORD dwClsContext, REFGUID riid, LPUNKNOWN out_ppv )

+FUNCTION: HRESULT CoCreateGuid ( GUID* pguid )

 FUNCTION: BOOL IsEqualGUID ( REFGUID rguid1, REFGUID rguid2 )
 FUNCTION: int StringFromGUID2 ( REFGUID rguid, LPOLESTR lpsz, int cchMax )
 FUNCTION: HRESULT CLSIDFromString ( LPOLESTR lpsz, REFGUID out_rguid )
 FUNCTION: BOOL IsEqualGUID ( REFGUID rguid1, REFGUID rguid2 )
 FUNCTION: int StringFromGUID2 ( REFGUID rguid, LPOLESTR lpsz, int cchMax )
 FUNCTION: HRESULT CLSIDFromString ( LPOLESTR lpsz, REFGUID out_rguid )


@@ -134,6 +135,9 @@ TUPLE: ole32-error code message ;
 CONSTANT: GUID-STRING-LENGTH
     $[ "{01234567-89ab-cdef-0123-456789abcdef}" length ]
 
 CONSTANT: GUID-STRING-LENGTH
     $[ "{01234567-89ab-cdef-0123-456789abcdef}" length ]
 

+: create-guid ( -- GUID )
+    GUID <struct> dup CoCreateGuid check-ole32-error ;
+

 : string>guid ( string -- guid )
     "{-}" split harvest
     [ first3 [ hex> ] tri@ ]
 : string>guid ( string -- guid )
     "{-}" split harvest
     [ first3 [ hex> ] tri@ ]