hg/stx-libbasic: comparison Win32OperatingSystem.st

equal deleted inserted replaced

-:5d7d08fd4c77
+:f476234e681d
 "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
 ! !
 !Win32OperatingSystem class methodsFor:'documentation'!
 version
-^ '$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.405 2010-07-23 15:10:35 stefan Exp $'
 !
 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.405 2010-07-23 15:10:35 stefan Exp $'
 ! !
 Win32OperatingSystem initialize!
 Win32OperatingSystem::PerformanceData initialize!
 Win32OperatingSystem::RegistryEntry initialize!

changeset 12961	f476234e681d
parent 12934	bc516945ce4d
child 12969	999e457ed11e