Win32OperatingSystem.st
branchjv
changeset 17815 956b46750806
parent 17814 b75a7f0c346b
child 17834 04ff72c5039a
--- a/Win32OperatingSystem.st	Mon Dec 20 07:13:27 2010 +0000
+++ b/Win32OperatingSystem.st	Fri Feb 04 23:09:23 2011 +0000
@@ -580,6 +580,10 @@
     return __get_functionAddress(&libHandle, "ole32.DLL", functionName);
 }
 
+/*
+ * The difference between the Windows epoch (1601-01-01 00:00:00)
+ * and the Unix epoch (1970-01-01 00:00:00) in milliseconds is: 11644473600000L
+ */
 void
 TimetToFileTime( time_t t, LPFILETIME pft )
 {
@@ -592,7 +596,7 @@
 FileTimeToOsTime(LPFILETIME pft)
 {
     LONGLONG lTime = ((LONGLONG)pft->dwHighDateTime << 32) + pft->dwLowDateTime;
-    lTime = (lTime / 10000) - 11644473600000;
+    lTime = (lTime / 10000) - 11644473600000L;
 
     return(__MKLARGEINT64(1, (unsigned INT)(lTime & 0xFFFFFFFF), (unsigned INT)(lTime >> 32)));
 }
@@ -3992,6 +3996,25 @@
      ^ self openFile:pathName attributes:#(#'GENERIC_READ' #'GENERIC_WRITE' #'CREATE_ALWAYS')
 !
 
+createHardLinkFrom:oldPath to:newPath
+    "link the file 'oldPath' to 'newPath'. The link will be a hard link.
+     Return true if successful, false if not."
+
+    self executeCommand:('mklink/h "%1" "%2"' bindWith:newPath with:oldPath)
+
+    "Created: / 19-01-2011 / 08:42:11 / cg"
+!
+
+createSymbolicLinkFrom:oldPath to:newPath
+    "make a link from the file 'oldPath' to the file 'newPath'.
+     The link will be a soft (symbolic) link.
+     Return true if successful, false if not."
+
+    self executeCommand:('mklink "%1" "%2"' bindWith:newPath with:oldPath)
+
+    "Created: / 19-01-2011 / 08:41:44 / cg"
+!
+
 getLastError
 %{
     RETURN ( __mkSmallInteger( __WIN32_ERR(GetLastError()) ));
@@ -4087,20 +4110,19 @@
      Return true if successful, false if not."
 
     (oldPath isString not or:[newPath isString not]) ifTrue:[
-	"/
-	"/ bad argument(s) given
-	"/
-	^ self primitiveFailed
-    ].
-
-    "/
-    "/ this OperatingSystem does not support links
-    "/
-    ^ UnsupportedOperationSignal raise
+        "/
+        "/ bad argument(s) given
+        "/
+        ^ self primitiveFailed
+    ].
+
+    ^ self createHardLinkFrom:oldPath to:newPath
 
     "
      OperatingSystem linkFile:'foo' to:'bar'
     "
+
+    "Modified: / 19-01-2011 / 08:42:53 / cg"
 !
 
 openFile:pathName attributes:attributeSpec
@@ -9648,7 +9670,8 @@
 
     "Created: / 04-08-2006 / 18:04:52 / fm"
     "Modified: / 26-01-2007 / 14:05:44 / cg"
-!
+! !
+
 !Win32OperatingSystem class methodsFor:'socket support'!
 
 socketAccessor
@@ -13616,17 +13639,33 @@
 key:aKeyNamePath
     "retrieve an entry by full path name (starting at a root)"
 
+    ^ self key:aKeyNamePath createIfAbsent:false
+
+    "
+     self key:'HKEY_LOCAL_MACHINE'
+     self key:'HKEY_LOCAL_MACHINE\Software'
+     self key:'HKEY_LOCAL_MACHINE\Software\Borland\'
+     self key:'HKEY_LOCAL_MACHINE\Software\eXept\Smalltalk/X\3.2.5\Directory'
+     (self key:'HKEY_CLASSES_ROOT\MicrosoftWorks.WordProcessor\CLSID') valueNamed:''
+    "
+
+    "Modified: / 19-01-2011 / 15:59:36 / cg"
+!
+
+key:aKeyNamePath createIfAbsent:createIfAbsent
+    "retrieve an entry by full path name (starting at a root)"
+
     |idx first rest root|
 
     HKEY_CLASSES_ROOT isNil ifTrue:[self initialize].
 
     idx := aKeyNamePath indexOf:(self separator).
     idx == 0 ifTrue:[
-	first := aKeyNamePath.
-	rest := nil.
+        first := aKeyNamePath.
+        rest := nil.
     ] ifFalse:[
-	first := aKeyNamePath copyTo:idx-1.
-	rest := aKeyNamePath copyFrom:idx+1
+        first := aKeyNamePath copyTo:idx-1.
+        rest := aKeyNamePath copyFrom:idx+1
     ].
 
     first := first asUppercase.
@@ -13634,17 +13673,17 @@
     "/ the first is a pseudo name
     root := self rootKey:first.
     root isNil ifTrue:[
-	^ nil
+        ^ nil
     ].
 
     rest size == 0 ifTrue:[
-	^ root
+        ^ root
     ].
 
     Error handle:[:ex |
-	^ nil
+        ^ nil
     ] do:[
-	^ root subKeyNamed:rest.
+        ^ root subKeyNamed:rest createIfAbsent:createIfAbsent.
     ].
 
     "
@@ -13655,7 +13694,7 @@
      (self key:'HKEY_CLASSES_ROOT\MicrosoftWorks.WordProcessor\CLSID') valueNamed:''
     "
 
-    "Modified: / 24.12.1999 / 00:01:52 / cg"
+    "Created: / 19-01-2011 / 15:59:21 / cg"
 !
 
 rootKey:aRootKeyStringOrSymbol
@@ -14111,6 +14150,23 @@
      top := self key:'HKEY_LOCAL_MACHINE'.
      sub := top subKeyNamed:'Software'
     "
+!
+
+subKeyNamed:subKeyString createIfAbsent:createIfAbsent
+    "return a new registry entry below mySelf with the given subKey.
+     If no such key exists and createIfAbsent is true, the key is created.
+     Otherwise, nil is returned"
+
+    |k|
+
+    (k := self subKeyNamed:subKeyString) isNil ifTrue:[
+        createIfAbsent ifTrue:[
+            ^ self createSubKeyNamed:subKeyString
+        ].
+    ].
+    ^ k
+
+    "Created: / 19-01-2011 / 15:58:45 / cg"
 ! !
 
 !Win32OperatingSystem::RegistryEntry methodsFor:'accessing values'!
@@ -14615,6 +14671,16 @@
     "
 !
 
+valueNames
+    "evaluate aBlock for all value names"
+
+    ^ Array streamContents:[:s |
+        self valueNamesDo:[:nm | s nextPut:nm]
+    ].
+
+    "Created: / 18-01-2011 / 20:24:52 / cg"
+!
+
 valueNamesAndValuesDo:aBlock
     "evaluate aBlock for all value names"
 
@@ -16241,15 +16307,15 @@
 !Win32OperatingSystem class methodsFor:'documentation'!
 
 version
-    ^ '$Id: Win32OperatingSystem.st 10602 2010-12-20 07:13:27Z vranyj1 $'
+    ^ '$Id: Win32OperatingSystem.st 10604 2011-02-04 23:09:23Z vranyj1 $'
 !
 
 version_CVS
-    ^ 'Header: /cvs/stx/stx/libbasic/Win32OperatingSystem.st,v 1.414 2010/12/01 19:25:36 cg Exp '
+    ^ 'Header: /cvs/stx/stx/libbasic/Win32OperatingSystem.st,v 1.417 2011/01/19 15:04:48 cg Exp '
 !
 
 version_SVN
-    ^ '$Id: Win32OperatingSystem.st 10602 2010-12-20 07:13:27Z vranyj1 $'
+    ^ '$Id: Win32OperatingSystem.st 10604 2011-02-04 23:09:23Z vranyj1 $'
 ! !
 
 Win32OperatingSystem initialize!
@@ -16262,3 +16328,4 @@
 
 
 
+