hg/stx-libbasic: comparison Win32OperatingSystem.st

equal deleted inserted replaced

-:da075fbea903
+:569eec7576f1
 on a real OS, we return true."
 ^ false
 !
+clearHidden:aPathName
+"set the hidden attribute; Return true if the operation succeeded"
+|attr|
+attr := self primGetFileAttributes:aPathName.
+(attr bitTest:FILE_ATTRIBUTE_HIDDEN ) ifTrue:[
+^ self primSetFileAttributes:aPathName to:(attr bitClear:2).
+].
+^ true
+"Created: / 29-07-2010 / 11:31:55 / sr"
+!
 compressPath:pathName
 "return the pathName compressed - that is, remove all ..-entries
 and . entries. This does not always (in case of symbolic links)
 return the true pathName and is therefore used as a fallback
 if realPath and popen failed."
 self setCurrentDirectory:'C:\Users\cg\work\stx\projects\smalltalk'
 "
 !
 setHidden:aPathName
-"set the hidden attribute. Return true if it is set"
+"set the hidden attribute. Return true if the operation succeeded"
 |attr|
 attr := self primGetFileAttributes:aPathName.
 (attr bitTest:FILE_ATTRIBUTE_HIDDEN ) ifFalse:[
-	^ self primSetFileAttributes:aPathName to:(attr bitOr:2).
+^ self primSetFileAttributes:aPathName to:(attr bitOr:2).
 ].
 ^ true  "/ aready set
+"Modified: / 29-07-2010 / 11:32:26 / sr"
 !
 setNormal:aPathName
 " sets all file attributes to the normal state
 e.g. set the hidden attribute to false (unhidden)"
 ! !
 !Win32OperatingSystem class methodsFor:'mutex'!
 createMutexNamed: name
 "Returns an array with the handle and the lastErrorCode"
 |handle lastErrorCode|
-"Without clear reasons, before creating the mutex we must call #printCR"
+"/ "Without clear reasons, before creating the mutex we must call #printCR"
-'Creating mutex' printCR.
+"/ 'Creating mutex' printCR.
 self primSetLastError: 0.
 self primGetLastError.
 handle := self primCreateMutex:nil initialOwner: true name: name.
 lastErrorCode := self primGetLastError.
-lastErrorCode printCR.
+"/ lastErrorCode printCR.
 "/    self assert: lastErrorCode == 0.
 "/    lastErrorCode == 5 "ERROR_ACCESS_DENIED" ifTrue:[Transcript showCR: 'Mutex not accesible (GetLastError = ERROR_ACCESS_DENIED)'.].
 "/    lastErrorCode == 183 "ERROR_ALREADY_EXISTS" ifTrue:[Transcript showCR: 'Mutex already exists (GetLastError = ERROR_ALREADY_EXISTS)'.].
 (handle isNil or:[handle address ~~ 0]) ifFalse:[
-	Transcript showCR: 'CreateMutexNamed: "', name printString, '" failed'.
+Transcript showCR: 'CreateMutexNamed: "', name printString, '" failed'.
-	handle := nil.
+handle := nil.
 ].
 ^ Array with: handle with: lastErrorCode
 "
 self createMutexNamed: '8906f5e0-54ed-11dd-9da4-001558137da0'
 self releaseMutexNamed: '8906f5e0-54ed-11dd-9da4-001558137da0'
 "
+"Modified: / 03-08-2010 / 16:57:36 / cg"
 !
 existsMutexNamed: name
 |handle lastErrorCode handleAndLastErrorCode|
 handleAndLastErrorCode := self createMutexNamed: name.
 handle := handleAndLastErrorCode first.
 lastErrorCode := handleAndLastErrorCode second.
 "/    self assert: lastErrorCode == 0.
 ^ handle isNil
-	or:[lastErrorCode == 183 "ERROR_ALREADY_EXISTS"
+or:[lastErrorCode == 183 "ERROR_ALREADY_EXISTS"
-	    or:[ lastErrorCode == 5 "ERROR_ACCESS_DENIED"]]
+or:[ lastErrorCode == 5 "ERROR_ACCESS_DENIED"]]
+"Modified: / 03-08-2010 / 16:59:41 / cg"
 !
 openMutexNamed: name
+"If the function succeeds, the return value is a handle to the mutex object.
-"
+If the function fails, the return value is NULL. To get extended error information, call GetLastError.
-If the function succeeds, the return value is a handle to the mutex object.
+If a named mutex does not exist, the function fails and GetLastError returns ERROR_FILE_NOT_FOUND."
-If the function fails, the return value is NULL. To get extended error information, call GetLastError.
-If a named mutex does not exist, the function fails and GetLastError returns ERROR_FILE_NOT_FOUND.
-"
 |handle |
 handle := self primOpenMutex:nil initialOwner: true name: name.
 "/    lastErrorCode := self primGetLastError.
 "/    lastErrorCode = 2 ifTrue:[Transcript showCR: 'Mutex does not exist (GetLastError = ERROR_FILE_NOT_FOUND)'.].
 "/    lastErrorCode = 5 ifTrue:[Transcript showCR: 'Mutex not accesible (GetLastError = ERROR_ACCESS_DENIED)'.].
 (handle isNil or:[handle address ~~ 0]) ifFalse:[
-	Transcript showCR: 'OpenMutexNamed: "', name printString, '" failed'.
+Transcript showCR: 'OpenMutexNamed: "', name printString, '" failed'.
-	^ nil.
+^ nil.
 ].
 ^ handle
 "
 self openMutexNamed: '8906f5e0-54ed-11dd-9da4-001558137da0'
 "
+"Modified: / 03-08-2010 / 16:59:37 / cg"
 !
 primCreateMutex:lpSecurityDescriptor initialOwner: bInitialOwner name: lpName
+"If the function succeeds, the return value is a handle to the newly created mutex object.
-"
-If the function succeeds, the return value is a handle to the newly created mutex object.
 If the function fails, the return value is NULL.
-If the mutex is a named mutex and the object existed before this function call, the return value is a handle to the existing object.
+If the mutex is a named mutex and the object existed before this function call, the return value is a handle to the existing object."
-"
 <apicall: handle "CreateMutexA" (lpstr bool lpstr) module: "kernel32.dll" >
+"Modified: / 03-08-2010 / 16:59:26 / cg"
 !
 primOpenMutex:lpSecurityDescriptor initialOwner: bInitialOwner name: lpName
+"If the function succeeds, the return value is a handle to the mutex object.
-"
+If the function fails, the return value is NULL. To get extended error information, call GetLastError.
-If the function succeeds, the return value is a handle to the mutex object.
+If a named mutex does not exist, the function fails and GetLastError returns ERROR_FILE_NOT_FOUND."
-If the function fails, the return value is NULL. To get extended error information, call GetLastError.
-If a named mutex does not exist, the function fails and GetLastError returns ERROR_FILE_NOT_FOUND.
-"
 <apicall: handle "OpenMutexA" (lpstr bool lpstr) module: "kernel32.dll" >
+"Modified: / 03-08-2010 / 16:59:11 / cg"
 !
 primReleaseMutex: hMutex
+"If the function succeeds, the return value is nonzero.
-"
+If the function fails, the return value is zero."
-If the function succeeds, the return value is nonzero.
-If the function fails, the return value is zero.
-"
 <apicall: bool "ReleaseMutex" (handle) module: "kernel32.dll" >
+"Modified: / 03-08-2010 / 16:59:55 / cg"
 !
 primWaitForSingleObject: handle milliseconds: dwMilliseconds
+"If the function succeeds, the return value indicates the event that caused the function to return.
-"
+If the function fails, the return value is WAIT_FAILED ((DWORD)0xFFFFFFFF)."
-If the function succeeds, the return value indicates the event that caused the function to return.
-If the function fails, the return value is WAIT_FAILED ((DWORD)0xFFFFFFFF).
-"
 <apicall: dword "WaitForSingleObject" (handle dword) module: "kernel32.dll" >
+"Modified: / 03-08-2010 / 17:00:02 / cg"
 !
 releaseMutex: hMutex
 "Returns true if the Mutex was released. Otherwise, returns false."
 | released|
 hMutex isNil ifTrue:[
-	Transcript showCR: 'hMutex is nil - cannot release'.
+Transcript showCR: 'hMutex is nil - cannot release'.
-	^ false
+^ false
 ].
 released := self primReleaseMutex: hMutex.
 released ifFalse:[Transcript showCR: 'Release Mutex failed'.].
 ^ released
+"Modified: / 03-08-2010 / 17:00:05 / cg"
 !
 releaseMutexNamed: name
 "Returns true if the Mutex was released. Otherwise, returns false."
 | hMutex |
 hMutex := self openMutexNamed: name.
 hMutex isNil ifTrue:[
-	Transcript showCR: 'Cannot release Mutex named: "', name printString,'"'.
+Transcript showCR: 'Cannot release Mutex named: "', name printString,'"'.
-	^ false
+^ false
 ].
 ^ self releaseMutex: hMutex.
+"Modified: / 03-08-2010 / 16:58:25 / cg"
 !
 waitForSingleObject: handle
 |result|
 result := self primWaitForSingleObject: handle milliseconds: 500.
 ^ result
+"Modified: / 03-08-2010 / 17:00:10 / cg"
 ! !
 !Win32OperatingSystem class methodsFor:'os queries'!
 executableFileExtensions
 "Created: 2.5.1997 / 11:42:29 / cg"
 !
 getDomainName
-"return the domain this host is in.
+"return the DNS domain this host is in.
 Notice:
-	not all systems support this; on some, 'unknown' is returned."
+not all systems support this; on some, 'unknown' is returned."
-|name idx hostName k|
+|domainName idx hostName k|
 DomainName notNil ifTrue:[
-	^ DomainName
+^ DomainName
 ].
-name := self getEnvironment:'DOMAIN'.
+"/ sometimes, we can extract the domainName from the hostName ...
-name isNil ifTrue:[
+hostName := self getHostName.
-	name := self getEnvironment:'DOMAINNAME'.
+hostName notEmptyOrNil ifTrue:[
+idx := hostName indexOf:$..
+idx ~~ 0 ifTrue:[
+domainName := hostName copyFrom:idx+1.
+]
 ].
-name isNil ifTrue:[
+domainName isNil ifTrue:[
-	"/ sometimes, we can extract the domainName from the hostName ...
+domainName := self getEnvironment:'DOMAIN'.
-	hostName := self primGetHostName.
+domainName isNil ifTrue:[
-	hostName notNil ifTrue:[
+domainName := self getEnvironment:'DOMAINNAME'.
-	    idx := hostName indexOf:$..
+].
-	    idx ~~ 0 ifTrue:[
-		name := hostName copyFrom:idx+1.
+domainName isNil ifTrue:[
-	    ]
+"/ ok, search the registry ...
-	].
+"/ under NT and later, it is found there ...
+k := RegistryEntry key:'HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters'.
-	name isNil ifTrue:[
+k notNil ifTrue:[
-	    "/ ok, search the registry ...
+domainName := k valueNamed:'Domain'.
-	    "/ under NT and later, it is found there ...
+k close.
-	    k := RegistryEntry key:'HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters'.
+].
-	    k notNil ifTrue:[
+].
-		name := k valueNamed:'Domain'.
-		k close.
+domainName isNil ifTrue:[
-	    ].
+"/ under Win95/Win98, it is found there ...
-	].
+k := RegistryEntry key:'HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\VxD\MSTCP'.
+k notNil ifTrue:[
-	name isNil ifTrue:[
+domainName := k valueNamed:'Domain'.
-	    "/ under Win95/Win98, it is found there ...
+k close.
-	    k := RegistryEntry key:'HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\VxD\MSTCP'.
+]
-	    k notNil ifTrue:[
+].
-		name := k valueNamed:'Domain'.
-		k close.
+domainName isNil ifTrue:[
-	    ]
+'Win32OperatingSystem [warning]: cannot find out domainName' errorPrintCR.
-	].
+domainName := 'unknown'.
+].
-	name isNil ifTrue:[
+DomainName := domainName.     "cache only, if it is fixed"
-	    'Win32OperatingSystem [warning]: cannot find out domainname' errorPrintCR.
-	    name := 'unknown'.
-	]
 ].
-DomainName := name.
+^ domainName
-^ name
 "
 DomainName := nil.
 OperatingSystem getDomainName
 OperatingSystem getHostName
 "Modified: / 09-01-2007 / 20:14:35 / cg"
 !
 getHostName
-"return the hostname we are running on - if there is
+"return the hostname we are running on
-a HOST environment variable, we are much faster here ...
+- if possible, the fully qualified host name."
-Notice:
-	not all systems support this; on some, 'unknown' is returned."
+|hostName|
-|name idx|
+%{  /* STACK: 2048 */
+char buffer[512];
-HostName notNil ifTrue:[
+DWORD buffSize = sizeof(buffer);
-	^ HostName
-].
+if (GetComputerNameEx(ComputerNameDnsFullyQualified, buffer, &buffSize) == TRUE) {
+hostName = __MKSTRING(buffer);
-name := self primGetHostName.
+}
+%}.
-"/ on some systems, the hostname already contains the domain.
+^ hostName
-"/ decompose it here.
-idx := name indexOf:$..
-idx ~~ 0 ifTrue:[
-	DomainName := name copyFrom:(idx+1).
-	name := name copyTo:(idx-1).
-].
-HostName := name.
-^ name
 "
 OperatingSystem getHostName
 "
 !
 OS, for example, linux returns 'ix86', while WIN32 returns 'x86'.
 This method is mainly provided to augment error reports with some system
 information.
 (in case of system/version specific OS errors, conditional workarounds and patches
-	may be based upon this info).
+may be based upon this info).
 Your application should NOT depend upon this in any way.
 The returned info may (or may not) contain:
-	#system -> some operating system identification (irix, Linux, nt, win32s ...)
+#system -> some operating system identification (irix, Linux, nt, win32s ...)
-	#version -> OS version (some os version identification)
+#version -> OS version (some os version identification)
-	#release -> OS release (3.5, 1.2.1 ...)
+#release -> OS release (3.5, 1.2.1 ...)
-	#node   -> some host identification (hostname)
+#node   -> some host identification (hostname)
-	#domain  -> domain name (hosts domain)
+#domain  -> domain name (hosts domain)
-	#machine -> type of machine (i586, mips ...)
+#machine -> type of machine (i586, mips ...)
 win32:
-	#physicalRam -> total amount of physical memory
+#physicalRam -> total amount of physical memory
-	#freeRam -> amount of free memory
+#freeRam -> amount of free memory
-	#swapSize -> size of swapSpace (page file)
+#swapSize -> size of swapSpace (page file)
-	#freeSwap -> free bytes in swapSpace
+#freeSwap -> free bytes in swapSpace
-	#virtualRam -> total amount of virtual memory
+#virtualRam -> total amount of virtual memory
-	#freeVirtual -> amount of free virtual memory
+#freeVirtual -> amount of free virtual memory
-	#memoryLoad -> percentage of memory usage (useless)
+#memoryLoad -> percentage of memory usage (useless)
 "
 |sys node rel ver minorVer majorVer mach dom info arch
 physicalRam freeRam swapSize freeSwap
 virtualRam freeVirtual memoryLoad numberOfCPUs|
 minorVer = __mkSmallInteger(verMinor);
 majorVer = __mkSmallInteger(verMajor);
 if (HIWORD(vsn) & 0x8000) {
-	s = "win95";
+sys = @symbol(win95);
 } else {
-	if ((verMajor > 5)
+if ((verMajor > 5)
-	 || ((verMajor == 5) && (verMinor >= 1))) {
+|| ((verMajor == 5) && (verMinor >= 1))) {
-	    s = "xp";
+sys = @symbol(xp);
-	    if (verMajor >= 6) {
+if (verMajor >= 6) {
-		s = "vista";
+sys = @symbol(vista);
-	    }
+if (verMinor >= 1) {
-	} else {
+sys = @symbol(win7);
-	    s = "nt";
+}
-	}
+}
-}
+} else {
-sys = __MKSTRING(s);
+sys = @symbol(nt);
+}
+}
 len = snprintf(vsnBuffer, sizeof(vsnBuffer), "%d.%d", verMajor, verMinor);
 rel = __MKSTRING_L(vsnBuffer, len);
 GetSystemInfo(&sysInfo);
 memStatus.dwLength = sizeof(memStatus);
 /* MSC, BorlandC4 ... */
 switch (sysInfo.wProcessorArchitecture)
 #endif
 {
 #ifdef PROCESSOR_ARCHITECTURE_INTEL
-	case PROCESSOR_ARCHITECTURE_INTEL:
+case PROCESSOR_ARCHITECTURE_INTEL:
-	    s = "intel";
+arch = @symbol(intel);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_ARCHITECTURE_MIPS
-	case PROCESSOR_ARCHITECTURE_MIPS:
+case PROCESSOR_ARCHITECTURE_MIPS:
-	    s = "mips";
+arch = @symbol(mips);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_ARCHITECTURE_ALPHA
-	case PROCESSOR_ARCHITECTURE_ALPHA:
+case PROCESSOR_ARCHITECTURE_ALPHA:
-	    s = "alpha";
+arch = @symbol(alpha);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_ARCHITECTURE_ALPHA64
-	case PROCESSOR_ARCHITECTURE_ALPHA64:
+case PROCESSOR_ARCHITECTURE_ALPHA64:
-	    s = "alpha64";
+arch = @symbol(alpha64);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_ARCHITECTURE_PPC
-	case PROCESSOR_ARCHITECTURE_PPC:
+case PROCESSOR_ARCHITECTURE_PPC:
-	    s = "ppc";
+arch = @symbol(ppc);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_ARCHITECTURE_ARM
-	case PROCESSOR_ARCHITECTURE_ARM:
+case PROCESSOR_ARCHITECTURE_ARM:
-	    s = "arm";
+arch = @symbol(arm);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_ARCHITECTURE_SHX
-	case PROCESSOR_ARCHITECTURE_SHX:
+case PROCESSOR_ARCHITECTURE_SHX:
-	    s = "shx";
+arch = @symbol(shx);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_ARCHITECTURE_IA64
-	case PROCESSOR_ARCHITECTURE_IA64:
+case PROCESSOR_ARCHITECTURE_IA64:
-	    s = "ia64";
+arch = @symbol(ia64);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_ARCHITECTURE_MSIL
-	case PROCESSOR_ARCHITECTURE_MSIL:
+case PROCESSOR_ARCHITECTURE_MSIL:
-	    s = "msil";
+arch = @symbol(msil);
-	    break;
+break;
 #endif
-	default:
+default:
-	    s = "unknown";
+arch = @symbol(unknown);
-	    break;
+break;
 }
-arch = __MKSTRING(s);
 switch (sysInfo.dwProcessorType) {
 #ifdef PROCESSOR_INTEL_386
-	case PROCESSOR_INTEL_386:
+case PROCESSOR_INTEL_386:
-	    s = "i386";
+mach = @symbol(i386);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_INTEL_486
-	case PROCESSOR_INTEL_486:
+case PROCESSOR_INTEL_486:
-	    s = "i486";
+mach = @symbol(i486);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_INTEL_PENTIUM
-	case PROCESSOR_INTEL_PENTIUM:
+case PROCESSOR_INTEL_PENTIUM:
-	    s = "i586";
+mach = @symbol(i586);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_INTEL_860
-	case PROCESSOR_INTEL_860:
+case PROCESSOR_INTEL_860:
-	    s = "i860";
+mach = @symbol(i860);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_INTEL_IA64
-	case PROCESSOR_INTEL_IA64:
+case PROCESSOR_INTEL_IA64:
-	    s = "ia64";
+mach = @symbol(ia64);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_MIPS_R2000
-	case PROCESSOR_MIPS_R2000:
+case PROCESSOR_MIPS_R2000:
-	    s = "r2000";
+mach = @symbol(r2000);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_MIPS_R3000
-	case PROCESSOR_MIPS_R3000:
+case PROCESSOR_MIPS_R3000:
-	    s = "r3000";
+mach = @symbol(r3000);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_MIPS_R4000
-	case PROCESSOR_MIPS_R4000:
+case PROCESSOR_MIPS_R4000:
-	    s = "r4000";
+mach = @symbol(r4000);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_ALPHA_21064
-	case PROCESSOR_ALPHA_21064:
+case PROCESSOR_ALPHA_21064:
-	    s = "alpha21064";
+mach = @symbol(alpha21064);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_ARM720
-	case PROCESSOR_ARM720:
+case PROCESSOR_ARM720:
-	    s = "arm720";
+mach = @symbol(arm720);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_ARM820
-	case PROCESSOR_ARM820:
+case PROCESSOR_ARM820:
-	    s = "arm820";
+mach = @symbol(arm820);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_ARM920
-	case PROCESSOR_ARM920:
+case PROCESSOR_ARM920:
-	    s = "arm920";
+mach = @symbol(arm920);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_ARM_7TDMI
-	case PROCESSOR_ARM_7TDMI:
+case PROCESSOR_ARM_7TDMI:
-	    s = "arm70001";
+mach = @symbol(arm70001);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_PPC_601
-	case PROCESSOR_PPC_601:
+case PROCESSOR_PPC_601:
-	    s = "ppc601";
+mach = @symbol(ppc601);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_PPC_603
-	case PROCESSOR_PPC_603:
+case PROCESSOR_PPC_603:
-	    s = "ppc603";
+mach = @symbol(ppc603);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_PPC_604
-	case PROCESSOR_PPC_604:
+case PROCESSOR_PPC_604:
-	    s = "ppc604";
+mach = @symbol(ppc604);
-	    break;
+break;
 #endif
 #ifdef PROCESSOR_PPC_620
-	case PROCESSOR_PPC_620:
+case PROCESSOR_PPC_620:
-	    s = "ppc620";
+mach = @symbol(ppc620);
-	    break;
+break;
 #endif
-	default:
+default:
-	    sprintf(vsnBuffer, "%d", sysInfo.dwProcessorType);
+sprintf(vsnBuffer, "%d", sysInfo.dwProcessorType);
-	    s = vsnBuffer;
+mach =  __MKSTRING(vsnBuffer);
-	    break;
+break;
 }
-mach = __MKSTRING(s);
 numberOfCPUs = __MKUINT(sysInfo.dwNumberOfProcessors);
 %}.
-sys isNil ifTrue:[
-	sys := self getSystemType.
-].
 node isNil ifTrue:[
-	node := self getHostName.
+node := self getHostName.
 ].
 dom isNil ifTrue:[
-	dom := self getDomainName.
+dom := self getDomainName.
-].
-mach isNil ifTrue:[
-	mach := self getCPUType.
-].
-arch isNil ifTrue:[
-	arch := 'unknown'.
 ].
 info := IdentityDictionary new.
 info at:#system put:sys.
 info at:#node put:node.
 is slightly different for some systems (i.e. iris vs. irix).
 Dont depend on this - use getOSType. I dont really see a point
 here ...
 (except for slight differences between next/mach and other machs)"
-^ 'win32'
+^ #win32
 "
 OperatingSystem getSystemType
 "
 !
 ^ (self getSystemInfo at:#majorVersion) >= 6
 "
 self isVistaLike
+"
+!
+isWin7Like
+"return true, if running on a Windows7 like system."
+|sysInfo major|
+sysInfo := self getSystemInfo.
+major := sysInfo at:#majorVersion.
+^ (major == 6 and:[(sysInfo at:#minorVersion) >= 1])
+or:[major > 6]
+"
+self isWin7Like
 "
 !
 maxFileNameLength
 "return the max number of characters in a filename.
 "
 !
 osName
-| os |
+^ 'Windows ',
+(#('NT' '2000' 'XP' 'VISTA' '7')
-os := 'Windows ', (#('3.x' '95' 'NT' '2000' 'XP') at: (#('3.0' '4.0' '4.1' '5.0' '5.1') indexOf: (OperatingSystem osVersion))).
+at: (#('4.1' '5.0' '5.1' '6.0' '6.1') indexOf:OperatingSystem osVersion)
+ifAbsent:OperatingSystem osVersion).
-^os
+"
-"Created: / 18-01-2007 / 17:21:06 / User"
+self osName
-"Modified: / 19-01-2007 / 13:15:59 / User"
+"
 !
 osVersion
 ^OperatingSystem getSystemInfo at:#release
 "
 OperatingSystem platformName
 "
 "Modified: 20.6.1997 / 17:37:26 / cg"
-!
-primGetDomainName
-%{
-#if 0   /* not needed */
-HINSTANCE hNetApi32 = LoadLibrary("netapi32.dll");
-DWORD (__stdcall *pfnNetApiBufferFree)(LPVOID Buffer);
-DWORD (__stdcall *pfnNetWkstaGetInfo)(LPWSTR servername, DWORD level, void *bufptr);
-if (hNetApi32) {
-	pfnNetApiBufferFree = (DWORD (__stdcall *)(void *)) GetProcAddress(hNetApi32, "NetApiBufferFree");
-	pfnNetWkstaGetInfo = (DWORD (__stdcall *)(LPWSTR, DWORD, void *)) GetProcAddress(hNetApi32, "NetWkstaGetInfo");
-}
-if (hNetApi32 && pfnNetWkstaGetInfo && pfnNetApiBufferFree) {
-	/* this way is more reliable, in case user has a local account. */
-	char dname[256];
-	DWORD dnamelen = sizeof(dname);
-	struct {
-	    DWORD   wki100_platform_id;
-	    LPWSTR  wki100_computername;
-	    LPWSTR  wki100_langroup;
-	    DWORD   wki100_ver_major;
-	    DWORD   wki100_ver_minor;
-	} *pwi;
-	/* NERR_Success *is* 0*/
-	if (0 == pfnNetWkstaGetInfo(NULL, 100, &pwi)) {
-	    if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
-		WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_langroup,
-				    -1, (LPSTR)dname, dnamelen, NULL, NULL);
-	    }
-	    else {
-		WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_computername,
-				    -1, (LPSTR)dname, dnamelen, NULL, NULL);
-	    }
-	    pfnNetApiBufferFree(pwi);
-	    FreeLibrary(hNetApi32);
-	    RETURN (__MKSTRING(dname));
-	}
-	FreeLibrary(hNetApi32);
-} else {
-	/* Win95 doesn't have NetWksta*(), so do it the old way */
-	char name[256];
-	DWORD size = sizeof(name);
-	if (hNetApi32)
-	    FreeLibrary(hNetApi32);
-	if (GetUserName(name,&size)) {
-	    char sid[1024];
-	    DWORD sidlen = sizeof(sid);
-	    char dname[256];
-	    DWORD dnamelen = sizeof(dname);
-	    SID_NAME_USE snu;
-	    if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen,
-				  dname, &dnamelen, &snu)) {
-		RETURN (__MKSTRING(dname));             /* all that for this */
-	    }
-	}
-}
-#endif /* not needed */
-%}.
-^ nil
-!
-primGetHostName
-"return the hostname we are running on - if there is
-a HOST environment variable, we are much faster here ...
-Notice:
-	not all systems support this; on some, 'unknown' is returned."
-|name|
-%{  /* STACK: 2048 */
-#if defined(HAS_GETHOSTNAME)
-char buffer[256];
-if (gethostname(buffer, sizeof(buffer)) == 0) {
-	name = __MKSTRING(buffer);
-}
-#else
-char buffer[128];
-DWORD buffSize = sizeof(buffer);
-if (GetComputerName(buffer, &buffSize) == TRUE) {
-	name = __MKSTRING(buffer);
-}
-#endif
-%}.
-name isNil ifTrue:[
-	name := self getEnvironment:'HOST'.
-	name isNil ifTrue:[
-	    name := self getEnvironment:'HOSTNAME'.
-	    name isNil ifTrue:[
-		name := self getEnvironment:'COMPUTERNAME'.
-		name isNil ifTrue:[
-		    'Win32OperatingSystem [warning]: cannot find out hostname' errorPrintCR.
-		    name := 'unknown'.
-		]
-	    ]
-	]
-].
-^ name
-"
-OperatingSystem primGetHostName
-"
 !
 randomBytesInto:bufferOrInteger
 "If bufferOrInteger is a String or a ByteArray,
 	fill a given buffer with random bytes from the RtlGenRandom function
 OperatingSystem utcOffset -> -7200
 "
 ! !
 !Win32OperatingSystem class methodsFor:'users & groups'!
+getApplicationDataDirectoryFor:appName
+"return the directory, where user-and-application-specific private files are to be
+located (ini-files, preferences etc.).
+Under windows, something like 'C:\Users\Administrator\AppData\Roaming\<appName>'
+is returned, here, the fallback ~/.<appName> is returned.
+Notice that only the name is returned; the directory is not guaranteed to exist."
+"{ Pragma: +optSpace }"
+|appDataDirFromEnv appDataDirFromRegistry|
+appDataDirFromEnv := self getEnvironment:'APPDATA'.
+appDataDirFromEnv notNil ifTrue:[
+^ appDataDirFromEnv , '\' , appName
+].
+appDataDirFromRegistry :=
+(self registryEntry key:'HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders')
+valueNamed:'AppData'.
+appDataDirFromRegistry notNil ifTrue:[
+^ appDataDirFromRegistry , '\' , appName
+].
+^ super getApplicationDataDirectoryFor:appName
+"
+OperatingSystem getApplicationDataDirectoryFor:'expecco'
+"
+"Created: / 29-07-2010 / 12:13:12 / sr"
+!
 getDesktopDirectory
 "return the name of the users desktop directory (i.e. yours)."
 "{ Pragma: +optSpace }"
 ! !
 !Win32OperatingSystem class methodsFor:'documentation'!
 version
-^ '$Id: Win32OperatingSystem.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+^ '$Id: Win32OperatingSystem.st 10564 2010-08-10 08:55:15Z vranyj1 $'
 !
 version_CVS
-^ 'Header: /cvs/stx/stx/libbasic/Win32OperatingSystem.st,v 1.404 2010/07/07 14:58:13 cg Exp '
+^ 'Header: /cvs/stx/stx/libbasic/Win32OperatingSystem.st,v 1.409 2010/08/03 15:08:47 cg Exp '
 !
 version_SVN
-^ '$Id: Win32OperatingSystem.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+^ '$Id: Win32OperatingSystem.st 10564 2010-08-10 08:55:15Z vranyj1 $'
 ! !
 Win32OperatingSystem initialize!
 Win32OperatingSystem::PerformanceData initialize!
 Win32OperatingSystem::RegistryEntry initialize!

branch	jv
changeset 17795	569eec7576f1
parent 17780	b6e42c92eba0
child 17807	06cc6c49e291