Buen dia, necesito el TSystem.prg actual.
Gracias, saludos.
function cWinVersion()
local aVersion := GetVersion()
local cVersion := ""
do case
case aVersion[ 4 ] == VER_PLATFORM_WIN32_NT
if aVersion[ 1 ] == 6
if aVersion[ 2 ] == 0
cVersion = "Vista"
elseif aVersion[ 2 ] == 1
cVersion = "7"
elseif aVersion[ 2 ] == 2
if IsWindows10()
cVersion = "10"
else
cVersion = "8"
endif
endif
endif
if aVersion[ 1 ] == 5
if aVersion[ 2 ] == 2
cVersion = "Server 2003"
elseif aVersion[ 2 ] == 1
cVersion = "XP"
elseif aVersion[ 2 ] == 0
cVersion = "2000"
endif
endif
if aVersion[ 1 ] <= 4
cVersion = "NT"
endif
case aVersion[ 4 ] == VER_PLATFORM_WIN32_WINDOWS
if aVersion[ 1 ] == 4
if aVersion[ 2 ] == 90
cVersion = "ME"
elseif aVersion[ 2 ] == 10
cVersion = "98"
elseif aVersion[ 2 ] == 0
cVersion = "95"
endif
endif
endcase
cVersion += IF( IsWin64(), " de 64 ", " de 32 " ) + "Bits"
return cVersion
METHOD WinVer() Class TSystemInfo
Local cVersion := ""
Do Case
Case ::IsWin95() ; cVersion := "Windows 95"
Case ::IsWin95SP1() ; cVersion := "Windows 95 Service Pack 1"
Case ::IsWin95OSR2() ; cVersion := "Windows 95 OSR2"
Case ::IsWin98() ; cVersion := "Windows 98"
Case ::IsWin98SP1() ; cVersion := "Windows 98 Service Pack 1"
Case ::IsWin98SE() ; cVersion := "Windows 98 Second Edition"
Case ::IsWinME() ; cVersion := "Windows ME"
Case ::IsWinNT31() ; cVersion := "Windows NT 3.1"
Case ::IsWinNT35() ; cVersion := "Windows NT 3.5"
Case ::IsWinNT351() ; cVersion := "Windows NT 3.51"
Case ::IsWinNT4() ; cVersion := "Windows NT 4"
Case ::IsWin2000() ; cVersion := "Windows 2000" + If( ::IsWin2000Prof(), " Professional", If( ::IsWin2000Server(), " Server", "" ) ) //+ " " + ::cSP + " build " + LTrim( Str( ::nBuild ) )
Case ::IsWinXP() ; cVersion := "Windows XP " + If( lAnd( ::wSteMask, 512 ), "Home Edition", "Professional" )
Case ::IsWin2003Server() ; cVersion := "Windows Server 2003"
Case IsWinVista() ; cVersion := "Windows Vista"
Case IsWin7() ; cVersion := "Windows 7"
Case IsWin8() ; cVersion := "Windows 8"
Case IsWindows10() ; cVersion := "Windows 10"
Otherwise ; cVersion := "Unknown Windows version"
EndCase
cVersion += IF( IsWin64(), " 64 ", " 32 " ) + "Bits"
Return cVersion
#include "Fivewin.ch"
Function Main()
LOCAL oSystemInfo, cInfo, nHandle
MsgInfo("Your CPU is a "+TSystemInfo():New():CPU())
oSystemInfo:=TSystemInfo():New()
cInfo:= "Data's of TSystemInfo:"
cInfo+=CRLF+ " nOSVers = " + LTrim(Str(oSystemInfo:nOsVer))
cInfo+=CRLF+ " nMajor = " + LTrim(Str(oSystemInfo:nMajor))
cInfo+=CRLF+ " nMinor = " + LTrim(Str(oSystemInfo:nMinor))
cInfo+=CRLF+ " nBuild = " + LTrim(Str(oSystemInfo:nBuild))
cInfo+=CRLF+ " nPlatform = " + LTrim(Str(oSystemInfo:nPlatform))
cInfo+=CRLF+ " cSP = " + AllTrim(oSystemInfo:cSP)
cInfo+=CRLF+ "(local IP) cIP = " + AllTrim(oSystemInfo:cIP)
cInfo+=CRLF+ "(Host name) cSName = " + AllTrim(oSystemInfo:cSName)
cInfo+=CRLF+ "(Machine ID) cLName = " + AllTrim(oSystemInfo:cLName)
cInfo+=CRLF
cInfo+=CRLF+ "Method's of TSystemInfo:"
cInfo+=CRLF+ " WinVer() = " + oSystemInfo:WinVer()
cInfo+=CRLF+ " VerNum() = " + oSystemInfo:VerNum()
cInfo+=CRLF+ " IsWin95() = " + If(oSystemInfo:IsWin95(), "YES", "NO" )
cInfo+=CRLF+ " IsWin95SP1() = " + If(oSystemInfo:IsWin95SP1(), "YES", "NO" )
cInfo+=CRLF+ " IsWin95OSR2() = " + If(oSystemInfo:IsWin95OSR2(), "YES", "NO" )
cInfo+=CRLF+ " IsWin98() = " + If(oSystemInfo:IsWin98(), "YES", "NO" )
cInfo+=CRLF+ " IsWin98SP1() = " + If(oSystemInfo:IsWin98SP1(), "YES", "NO" )
cInfo+=CRLF+ " IsWin98SE() = " + If(oSystemInfo:IsWin98SE(), "YES", "NO" )
cInfo+=CRLF+ " IsWinME() = " + If(oSystemInfo:IsWinME(), "YES", "NO" )
cInfo+=CRLF+ " IsWinNT31() = " + If(oSystemInfo:IsWinNT31(), "YES", "NO" )
cInfo+=CRLF+ " IsWinNT35() = " + If(oSystemInfo:IsWinNT35(), "YES", "NO" )
cInfo+=CRLF+ " IsWinNT351() = " + If(oSystemInfo:IsWinNT351(), "YES", "NO" )
cInfo+=CRLF+ " IsWinNT4() = " + If(oSystemInfo:IsWinNT4(), "YES", "NO" )
cInfo+=CRLF+ " IsWin2000() = " + If(oSystemInfo:IsWin2000(), "YES", "NO" )
cInfo+=CRLF+ " IsWinXP() = " + If(oSystemInfo:IsWinXP(), "YES", "NO" )
cInfo+=CRLF
cInfo+=CRLF+ " IsWinVista() = " + iif( oSystemInfo:IsWinVista(), "YES", "NO" )
cInfo+=CRLF
cInfo+=CRLF+ " IsWin2003Server() = " + If(oSystemInfo:IsWin2003Server(), "YES", "NO" )
cInfo+=CRLF
cInfo+=CRLF+ " IsNTPreWin2K() = " + If(oSystemInfo:IsNTPreWin2K(), "YES", "NO" )
cInfo+=CRLF+ " IsNTWorkstation() = " + If(oSystemInfo:IsNTWorkstation(), "YES", "NO")
cInfo+=CRLF+ " IsNTServer() = " + If(oSystemInfo:IsNTServer(), "YES", "NO")
cInfo+=CRLF
cInfo+=CRLF+ " IsWin2000Prof() = " + If(oSystemInfo:IsWin2000Prof(), "YES", "NO" )
cInfo+=CRLF+ " IsWin2000Server() = " + If(oSystemInfo:IsWin2000Server(), "YES", "NO" )
cInfo+=CRLF
cInfo+=CRLF+ " CPU() = " + oSystemInfo:CPU()
cInfo+=CRLF+ " CPUName() = " + oSystemInfo:CPUName()
cInfo+=CRLF+ " SpeedCPU() = " + LTrim(Str(oSystemInfo:SpeedCPU()))
cInfo+=CRLF+ " IsDualCPU() = " + If(oSystemInfo:IsDualCPU(), "YES", "NO" )
cInfo+=CRLF+ " CPUVendor() = " + oSystemInfo:CPUVendor()
cInfo+=CRLF+ " CPUIdentifier() = " + oSystemInfo:CPUIdentifier()
cInfo+=CRLF+ " WhichNT() = " + oSystemInfo:WhichNT()
cInfo+=CRLF+ " DateSystemBios() = " + oSystemInfo:DateSystemBios()
cInfo+=CRLF+ " NameSystemBios() = " + oSystemInfo:NameSystemBios()
cInfo+=CRLF+ " DateVideoBios() = " + oSystemInfo:DateVideoBios()
cInfo+=CRLF+ " NameVideoBios() = " + oSystemInfo:NameVideoBios()
cInfo+=CRLF+ " Computername() = " + oSystemInfo:ComputerName()
cInfo+=CRLF+ " Servicepack() = " + oSystemInfo:Servicepack()
cInfo+=CRLF+ " TimeZone() = " + oSystemInfo:TimeZone()
cInfo+=CRLF+ " IEStartPage() = " + oSystemInfo:IEStartPage()
cInfo+=CRLF+ " IEVersion() = " + oSystemInfo:IEVersion()
cInfo+=CRLF+ " DefBrowser() = " + oSystemInfo:DefBrowser()
cInfo+=CRLF+ " DTWallPaper() = " + oSystemInfo:DTWallPaper()
cInfo+=CRLF+ " DirectXVersion() = " + oSystemInfo:DirectXVersion()
cInfo+=CRLF+ " Ass4Ext('.ZIP') = " + oSystemInfo:Ass4Ext(".ZIP")
cInfo+=CRLF+ " App4Ext('.ZIP') = " + oSystemInfo:App4Ext(".ZIP")
cInfo+=CRLF+ " Icon4Ext('.ZIP') = " + oSystemInfo:Icon4Ext(".ZIP")
cInfo+=CRLF+ " BootDir() = " + oSystemInfo:BootDir()
cInfo+=CRLF+ " GetColors() = " + Ltrim(Str(oSystemInfo:GetColors()))
cInfo+=CRLF
cInfo+=CRLF+ " ModemName() = " + oSystemInfo:ModemName()
cInfo+=CRLF+ " ModemVersion() = " + oSystemInfo:ModemVersion()
cInfo+=CRLF+ " ModemPort() = " + oSystemInfo:ModemPort()
cInfo+=CRLF+ " MonitorName() = " + oSystemInfo:MonitorName()
cInfo+=CRLF+ " MouseName() = " + oSystemInfo:MouseName()
cInfo+=CRLF+ " MouseVersion() = " + oSystemInfo:MouseVersion()
cInfo+=CRLF
cInfo+=CRLF+ " Memory Info"
cInfo+=CRLF+ " -----------"
cInfo+=CRLF+ " Total Physical = " + LTrim(Str(oSystemInfo:Memory(1),6,0))+" MB"
cInfo+=CRLF+ " Available Physical = " + LTrim(Str(oSystemInfo:Memory(2),6,0))+" MB"
cInfo+=CRLF+ " Total Page File = " + LTrim(Str(oSystemInfo:Memory(3),6,0))+" MB"
cInfo+=CRLF+ "Available Page File = " + LTrim(Str(oSystemInfo:Memory(4),6,0))+" MB"
cInfo+=CRLF+ " Total Virtual = " + LTrim(Str(oSystemInfo:Memory(5),6,0))+" MB"
cInfo+=CRLF+ " Available Virtual = " + LTrim(Str(oSystemInfo:Memory(6),6,0))+" MB"
nHandle:=FCreate("info.txt")
fWrite(nHandle, cInfo )
fClose(nHandle)
Winexec( "NotePad.exe info.txt")
RETURN NIL
#define d_TSIVersion "1.08"
#define d_Internet
#include "hbclass.ch"
#include "Struct.ch"
#include "DLL.ch"
#define HKEY_CLASSES_ROOT 2147483648 // 0x80000000
#define HKEY_CURRENT_USER 2147483649 // 0x80000001
#define HKEY_LOCAL_MACHINE 2147483650 // 0x80000002
#define MEM_TotalPhys 1
#define MEM_AvailPhys 2
#define MEM_TotalPageFile 3
#define MEM_AvailPageFile 4
#define MEM_TotalVirtual 5
#define MEM_AvailVirtual 6
*STATIC lWin2000
//--------------------------------------------------------------------
CLASS TSystemInfo
DATA nOsVer, nMajor, nMinor, nBuild, nPlatform, cSP
DATA wSerPackM, wSerPacki, wSteMask, wProdType, wRes
DATA cIP, cSName, cLName
DATA TSIVersion
METHOD New( lTest, lMsg )
METHOD WinVer()
METHOD VerNum() INLINE LTrim( Str( ::nMajor ) ) + "." + LTrim( Str( ::nMinor ) ) + "." +LTrim( Str( ::nBuild ) ) + RTrim( " " + ::cSP ) // added by LKM
METHOD WhichNT()
METHOD TimeZone()
METHOD DateSystemBios()
METHOD NameSystemBios()
METHOD DateVideoBios()
METHOD NameVideoBios()
METHOD ComputerName()
METHOD IEStartPage()
METHOD IEVersion()
METHOD DefBrowser()
METHOD DTWallpaper()
METHOD DirectxVersion()
METHOD Ass4Ext( cExt ) // Associated program for this extension
METHOD App4Ext( cExt ) // App that opens this extension
METHOD Icon4Ext( cExt ) // Icon associated to this extension
METHOD BootDir()
METHOD GetColors()
METHOD SpeedCPU( nCPU )
METHOD CPU( nCPU )
METHOD CPUName( nCPU )
METHOD IsDualCPU() INLINE ::SpeedCPU( 2 ) > 0
METHOD CPUVendor( nCPU )
METHOD CPUIdentifier( nCPU )
METHOD GMTOffset()
METHOD ModemName()
METHOD ModemVersion()
METHOD ModemPort()
METHOD MonitorName()
METHOD MouseName()
METHOD MouseVersion()
METHOD IPInfo()
METHOD IsWin95() INLINE ::nPlatform == 1 .and. ::nMajor == 4 .and. ::nMinor == 0 .and. ::nBuild == 950
METHOD IsWin95SP1() INLINE ::nPlatform == 1 .and. ::nMajor == 4 .and. ::nMinor == 0 .and. ::nBuild <= 1080
METHOD IsWin95OSR2() INLINE ::nPlatform == 1 .and. ::nMajor == 4 .and. ::nMinor < 10 .and. ::nBuild > 1080
METHOD IsWin98() INLINE ::nPlatform == 1 .and. ::nMajor == 4 .and. ::nMinor == 10 .and. ::nBuild == 1998
METHOD IsWin98SP1() INLINE ::nPlatform == 1 .and. ::nMajor == 4 .and. ::nMinor == 10 .and. ::nBuild > 1998 .and. ::nBuild <= 2183
METHOD IsWin98SE() INLINE ::nPlatform == 1 .and. ::nMajor == 4 .and. ::nMinor == 10 .and. ::nBuild > 2183
METHOD IsWinME() INLINE ::nPlatform == 1 .and. ::nMajor == 4 .and. ::nMinor == 90 .and. ::nBuild > 2183
METHOD IsWinNT31() INLINE ::nPlatform == 2 .and. ::nMajor == 3 .and. ::nMinor == 10
METHOD IsWinNT35() INLINE ::nPlatform == 2 .and. ::nMajor == 3 .and. ::nMinor == 50
METHOD IsWinNT351() INLINE ::nPlatform == 2 .and. ::nMajor == 3 .and. ::nMinor == 51
METHOD IsWinNT4() INLINE ::nPlatform == 2 .and. ::nMajor == 4
METHOD IsWin2000() INLINE ::nPlatform == 2 .and. ::nMajor == 5 .and. ::nMinor == 0
METHOD IsWinXP() INLINE ::nPlatform == 2 .and. ::nMajor == 5 .and. ::nMinor == 1
METHOD IsWin2003Server() INLINE ::nPlatform == 2 .and. ::nMajor == 5 .and. ::nMinor == 2
METHOD IsWinVista() INLINE ::nPlatform == 2 .and. ::nMajor == 6 .and. ::nMinor == 0
METHOD ServicePack() INLINE If( ::nPlatform > 1, "Service Pack " + LTrim( Str( ::wSerPackM ) ), "" )
METHOD IsNTPreWin2K() INLINE ::nPlatform == 2 .and. ::nMajor <= 4
METHOD IsNTWorkstation() INLINE ::IsNTPreWin2K() .and. Upper( ::WhichNT() ) == "WINNT"
METHOD IsNTServer() INLINE ::IsNTPreWin2K() .and. Upper( ::WhichNT() ) == "SERVERNT"
METHOD IsWin2000Prof() INLINE ::IsWin2000() .and. Upper( ::WhichNT() ) == "WINNT"
METHOD IsWin2000Server() INLINE ::IsWin2000() .and. ( Upper( ::WhichNT() ) == "SERVERNT" .or. Upper( ::WhichNT() ) == "LANMANNT" )
METHOD Memory( nMem )
ENDCLASS
//--------------------------------------------------------------------
METHOD New( lTest, lMsg ) Class TSystemInfo
LOCAL cBuffer, sInfo, lWinNT := IsWinNT()
Default lTest := .F., lMsg := .T.
::TSIVersion := d_TSIVersion
::IPInfo() && By Rossine 27/09/07
STRUCT sInfo
Member nLOsVer As DWORD // Size of the structure
Member nLMajor As DWORD // Major windows Version
Member nLMinor As DWORD // Minor Windows Version
Member nLBuild As DWORD // Build Number
Member nLPlatform As DWORD // Wich Platform
Member cLSP As STRING LEN 128 // Service Pack (Nt/2000)
IF lWinNT
Member wLSerPackM As WORD
Member wLSerPacki As WORD
Member wLSteMask As WORD
Member wLProdType As BYTE
Member wLRes As BYTE
ENDIF
ENDSTRUCT
sInfo:SetMember( 1, sInfo:sizeOf() )
cBuffer := sInfo:cBuffer
IF GetVerExA( @cBuffer ) <> 1 .and. lMsg
MsgInfo( "Error on calling GetVersionExA()" )
ENDIF
sInfo:cBuffer := cBuffer
::nOSVer := nLoWord( sInfo:nLOSVer ) // this is struct length, not OS version
::nMajor := nLoWord( sInfo:nLMajor )
::nMinor := nLoWord( sInfo:nLMinor )
::nBuild := nLoWord( sInfo:nLBuild )
::nPlatform := nLoWord( sInfo:nLPlatform )
::cSP := AllTrim( psz( sInfo:cLSP ) )
/*
#ifdef d_Debug
VIEW2 "** TSYSTEM INFO **"
VIEW ::nOSVer
VIEW ::nMajor
VIEW ::nMinor
VIEW ::nBuild
VIEW ::nPlatform
VIEW ::cSP
#endif
*/
IF lWinNT
::wSerPackM := nLoWord( sInfo:wLSerPackM )
::wSerPacki := nLoWord( sInfo:wLSerPacki )
::wSteMask := nLoWord( sInfo:wLSteMask )
::wProdType := sInfo:wLProdType
::wRes := sInfo:wLRes
ELSE
::wSerPackM := 0
::wSerPacki := 0
::wSteMask := 0
::wProdType := 0
::wRes := 0
ENDIF
/*
If lTest
MsgInfo( "nMajor = " + LTrim( Str( ::nMajor ) ) + CRLF + ;
"nMinor = " + LTrim( Str( ::nMinor ) ) + CRLF + ;
"nBuild = " + LTrim( Str( ::nBuild ) ) + CRLF + ;
"cSP = " + ::cSP + CRLF + ;
"sPlatform = " + LTrim( Str( ::nPlatform ) ) + ;
If( ::nPlatform > 1, CRLF + ;
"wSerPackM = " + LTrim( Str( ::wSerPackM ) ) + CRLF + ;
"wSerPacki = " + LTrim( Str( ::wSerPacki ) ) + CRLF + ;
"wSteMask = " + LTrim( Str( ::wSteMask ) ) + CRLF + ;
"wProdType = " + LTrim( Str( ::wProdType ) ) + CRLF + ;
"wRes = " + LTrim( Str( ::wRes ) ), "" ), "System Information" )
Endif
*/
RETURN Self
//--------------------------------------------------------------------
METHOD WinVer() Class TSystemInfo
Local cVersion := ""
Do Case
Case ::IsWin95() ; cVersion := "Windows 95"
Case ::IsWin95SP1() ; cVersion := "Windows 95 Service Pack 1"
Case ::IsWin95OSR2() ; cVersion := "Windows 95 OSR2"
Case ::IsWin98() ; cVersion := "Windows 98"
Case ::IsWin98SP1() ; cVersion := "Windows 98 Service Pack 1"
Case ::IsWin98SE() ; cVersion := "Windows 98 Second Edition"
Case ::IsWinME() ; cVersion := "Windows ME"
Case ::IsWinNT31() ; cVersion := "Windows NT 3.1"
Case ::IsWinNT35() ; cVersion := "Windows NT 3.5"
Case ::IsWinNT351() ; cVersion := "Windows NT 3.51"
Case ::IsWinNT4() ; cVersion := "Windows NT 4"
Case ::IsWin2000() ; cVersion := "Windows 2000" + If( ::IsWin2000Prof(), " Professional", If( ::IsWin2000Server(), " Server", "" ) ) //+ " " + ::cSP + " build " + LTrim( Str( ::nBuild ) )
Case ::IsWinXP() ; cVersion := "Windows XP " + If( lAnd( ::wSteMask, 512 ), "Home Edition", "Professional" )
Case ::IsWin2003Server() ; cVersion := "Windows Server 2003"
Case IsWinVista() ; cVersion := "Windows Vista"
Case IsWin7() ; cVersion := "Windows 7"
Case IsWin8() ; cVersion := "Windows 8"
Case IsWindows10() ; cVersion := "Windows 10"
Otherwise ; cVersion := "Unknown Windows version"
EndCase
cVersion += IF( IsWin64(), " 64 ", " 32 " ) + "Bits"
Return cVersion
//--------------------------------------------------------------------
METHOD WhichNT() Class TSystemInfo
Local oReg, uVar
If ::nPlatform < 2 // Win95-98-ME
uVar := ""
Else
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Control\ProductOptions", .f. )
uVar := oReg:Get( "ProductType", "" )
oReg:Close()
Endif
Return uVar
//--------------------------------------------------------------------
METHOD DateSystemBios() Class TSystemInfo
Local oReg, uVar
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "HARDWARE\DESCRIPTION\System", .f. )
uVar := oReg:Get( "SystemBIOSDate", "" )
oReg:Close()
If Empty( uVar )
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "Enum\Root\*PNP0C01\0000", .f. )
uVar := oReg:Get( "BIOSDate", "" )
oReg:Close()
Endif
Return uVar
//--------------------------------------------------------------------
METHOD NameSystemBios() Class TSystemInfo
Local oReg, uVar
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "HARDWARE\DESCRIPTION\System", .f. )
uVar := RTrim( Remove0( oReg:Get( "SystemBIOSVersion", "" ) ) )
oReg:Close()
If Empty( uVar )
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "Enum\Root\*PNP0C01\0000", .f. )
uVar := AllTrim( Remove0( oReg:Get( "BIOSName", "" ) + " " + oReg:Get( "BIOSVersion", "" ) ) )
oReg:Close()
Endif
Return uVar
//--------------------------------------------------------------------
METHOD DateVideoBios() Class TSystemInfo
Local oReg, uVar
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "HARDWARE\DESCRIPTION\System", .f. )
uVar := RTrim( oReg:Get( "VideoBiosdate", "" ) )
oReg:Close()
Return uVar
//--------------------------------------------------------------------
METHOD NameVideoBios() Class TSystemInfo
Local oReg, uVar
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "HARDWARE\DESCRIPTION\System", .f. )
uVar := RTrim( Remove0( oReg:Get( "VideoBiosVersion", "" ) ) )
oReg:Close()
Return uVar
//--------------------------------------------------------------------
METHOD Computername() Class TSystemInfo
Local oReg, uVar
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName", .f. )
uVar := oReg:Get( "Computername", "" )
oReg:Close()
Return uVar
//--------------------------------------------------------------------
METHOD TimeZone() Class TSystemInfo
Local oReg, uVar
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\TimeZoneInformation", .f. )
uVar := oReg:Get( "StandardName","" )
oReg:Close()
Return uVar
//--------------------------------------------------------------------
METHOD IEStartPage() Class TSystemInfo
LOCAL oReg, uVar
oReg := TReg32():New( HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Main", .f. )
uVar := oReg:Get( "Start Page", "" )
oReg:Close()
Return uVar
//--------------------------------------------------------------------
METHOD IEVersion() Class TSystemInfo
Local oReg, uVar
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "Software\Microsoft\Internet Explorer", .f. )
uVar := oReg:Get( "Version", "" )
oReg:Close()
Return uVar
//--------------------------------------------------------------------
METHOD DefBrowser() Class TSystemInfo
Local oReg, cVar
oReg := TReg32():New( HKEY_CLASSES_ROOT, ".html", .f. )
cVar := RTrim( Remove0( oReg:Get( Nil, "" ) ) ) // i.e look for (Default) key
oReg:close()
Return cVar
//--------------------------------------------------------------------
METHOD DTWallpaper() Class TSystemInfo // DesktopWallpaper
Local oReg, uVar
oReg := TReg32():New( HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Desktop\General", .f. )
uVar := oReg:Get( "Wallpaper", "" )
oReg:Close()
Return uVar
//--------------------------------------------------------------------
METHOD SpeedCPU( nCPU ) Class TSystemInfo
Local oReg, uVar
If ValType( nCPU ) # "N"
nCPU := 1
Endif
If ::nPlatform < 2 // Win95-98-ME
uVar := 0
Else
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "HARDWARE\DESCRIPTION\System\CentralProcessor\" + LTrim( Str( nCPU - 1 ) ), .f. )
uVar := oReg:Get( "~MHz", 0 )
oReg:Close()
uVar := Round( uVar / 10, 0 ) * 10
Endif
Return uVar
//--------------------------------------------------------------------
METHOD CPU( nCPU ) Class TSystemInfo
Local oReg, uVar
If ValType( nCPU ) # "N"
nCPU := 1
Endif
If ::nPlatform < 2 // Win95-98-ME
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "Enum\Root\*PNP0C01\" + StrZero( nCPU - 1, 4 ), .f. )
uVar := AllTrim( Remove0( oReg:Get( "CPU", "" ) ) )
oReg:Close()
Else
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "HARDWARE\DESCRIPTION\System\CentralProcessor\" + LTrim( Str( nCPU - 1 ) ), .f. )
uVar := AllTrim( Remove0( oReg:Get( "ProcessorNameString", "" ) ) )
oReg:Close()
Endif
If Empty( uVar )
uVar := GetCPU()
Endif
Return uVar
//--------------------------------------------------------------------
METHOD CPUName(nCPU) CLASS TSystemInfo
LOCAL oReg, uVar
if ValType(nCPU)#"N"
nCPU:=1
endif
oReg := TReg32():New(HKEY_LOCAL_MACHINE,"HARDWARE\DESCRIPTION\System\CentralProcessor\"+LTrim(Str(nCPU-1)),.f.)
uVar := AllTrim( Remove0( oReg:Get("ProcessorNameString","") ) )
oReg:Close()
RETURN uVar
//--------------------------------------------------------------------
METHOD CPUVendor( nCPU ) Class TSystemInfo
Local oReg, uVar
If ValType( nCPU ) # "N"
nCPU := 1
Endif
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "HARDWARE\DESCRIPTION\System\CentralProcessor\" + LTrim( Str( nCPU - 1 ) ), .f. )
uVar := AllTrim( Remove0( oReg:Get( "VendorIdentifier", "" ) ) )
oReg:Close()
Return uVar
//--------------------------------------------------------------------
METHOD CPUIdentifier( nCPU ) Class TSystemInfo
Local oReg, uVar
If ValType( nCPU ) # "N"
nCPU := 1
Endif
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "HARDWARE\DESCRIPTION\System\CentralProcessor\" + LTrim( Str( nCPU - 1 ) ), .f. )
uVar := AllTrim( Remove0( oReg:Get( "Identifier", "" ) ) )
oReg:Close()
Return uVar
//--------------------------------------------------------------------
METHOD DirectXVersion() Class TSystemInfo
Local oReg, uVar
oReg := TReg32():New( HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\DirectX", .f. )
uVar := oReg:Get( "Version", "" )
oReg:Close()
Return uVar
//--------------------------------------------------------------------
METHOD Ass4Ext( cExt ) Class TSystemInfo
Local oReg, uVar
If ! ValType( cExt ) == "C"
Return ""
Endif
If ! Left( cExt, 1 ) == "."
cExt := "." + cExt
Endif
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Extensions", .f. )
uVar := oReg:Get( cExt, "" )
oReg:Close()
Return SubStr( uVar, 1, Len( uVar ) - ( Len( cExt ) + 2 ) )
//--------------------------------------------------------------------
METHOD App4Ext( cExt ) Class TSystemInfo
Local oReg, cVar1 := "", cVar2 := "", nPos
If ! ValType( cExt ) == "C"
Return ""
Endif
If ! Left( cExt, 1 ) == "."
cExt := "." + cExt
Endif
oReg := TReg32():New( HKEY_CLASSES_ROOT, cExt, .f. )
cVar1 := RTrim( Remove0( oReg:Get( Nil, "" ) ) ) // i.e look for (Default) key
oReg:close()
If ! Empty( cVar1 )
oReg := TReg32():New( HKEY_CLASSES_ROOT, cVar1 + "\shell\open\command" )
cVar2 := RTrim( Remove0( oReg:Get( Nil, "" ) ) ) // i.e look for (Default) key
oReg:close()
If ( nPos := RAt( " %1", cVar2 ) ) > 0 // look for param placeholder without the quotes (ie notepad)
cVar2 := SubStr( cVar2, 1, nPos )
Elseif ( nPos := RAt( '"%', cVar2 ) ) > 0 // look for stuff like "%1", "%L", and so forth (ie, with quotes)
cVar2 := SubStr( cVar2, 1, nPos - 1 )
Endif
Endif
Return RTrim( cVar2 )
//--------------------------------------------------------------------
METHOD Icon4Ext( cExt ) Class TSystemInfo
Local oReg, cVar1 := "", cVar2 := ""
If ! ValType( cExt ) == "C"
Return ""
Endif
If ! Left( cExt, 1 ) == "."
cExt := "." + cExt
Endif
oReg := TReg32():New( HKEY_CLASSES_ROOT, cExt, .f. )
cVar1 := RTrim( Remove0( oReg:Get( Nil, "" ) ) ) // i.e look for (Default) key
oReg:close()
If ! Empty( cVar1 )
oReg := TReg32():New( HKEY_CLASSES_ROOT, cVar1 + "\DefaultIcon" )
cVar2 := RTrim( Remove0( oReg:Get( Nil, "" ) ) ) // i.e look for (Default) key
oReg:close()
// the value after the comma in cVar2 is the position of the icon inside that file (.exe, .dll or whatever)
Endif
Return cVar2
//--------------------------------------------------------------------
METHOD BootDir() Class TSystemInfo
Local oReg, uVar
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Setup", .f. )
uVar := oReg:Get( "BootDir", "" )
oReg:Close()
Return uVar
//--------------------------------------------------------------------
METHOD ModemName() Class TSystemInfo
Local oReg, uVar
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\Class\{4D36E96D-E325-11CE-BFC1-08002BE10318}\0000", .f. )
uVar := RTrim( Remove0( oReg:Get( "DriverDesc", "" ) ) )
oReg:Close()
If Empty( uVar ) // Win95-98-ME doesn't have the above key
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\Class\Modem\0000", .f. )
uVar := RTrim( Remove0( oReg:Get( "DriverDesc", "" ) ) )
oReg:Close()
Endif
Return uVar
//--------------------------------------------------------------------
METHOD ModemVersion() Class TSystemInfo
Local oReg, uVar
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\Class\{4D36E96D-E325-11CE-BFC1-08002BE10318}\0000", .f. )
uVar := RTrim( Remove0( oReg:Get( "DriverVersion", "" ) ) )
oReg:Close()
If Empty( uVar ) // Win95-98-ME doesn't have the above key
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\Class\Modem\0000", .f. )
uVar := RTrim( Remove0( oReg:Get( "DriverVersion", "" ) ) )
oReg:Close()
Endif
Return uVar
//--------------------------------------------------------------------
METHOD ModemPort() Class TSystemInfo
Local oReg, uVar
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\Class\{4D36E96D-E325-11CE-BFC1-08002BE10318}\0000", .f. )
uVar := RTrim( Remove0( oReg:Get( "AttachedTo", "" ) ) )
oReg:Close()
If Empty( uVar ) // Win95-98-ME doesn't have the above key
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\Class\Modem\0000", .f. )
uVar := RTrim( Remove0( oReg:Get( "AttachedTo", "" ) ) )
oReg:Close()
Endif
Return uVar
//--------------------------------------------------------------------
METHOD MonitorName() Class TSystemInfo
Local oReg, uVar
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\Class\{4D36E96E-E325-11CE-BFC1-08002BE10318}\0000", .f. )
uVar := RTrim( Remove0( oReg:Get( "DriverDesc", "" ) ) )
oReg:Close()
If Empty( uVar ) // Win95-98-ME doesn't have the above key
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\Class\Monitor\0000", .f. )
uVar := RTrim( Remove0( oReg:Get( "DriverDesc", "" ) ) )
oReg:Close()
Endif
Return uVar
//--------------------------------------------------------------------
METHOD MouseName() Class TSystemInfo
Local oReg, uVar
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\Class\{4D36E96F-E325-11CE-BFC1-08002BE10318}\0000", .f. )
uVar := RTrim( Remove0( oReg:Get( "DriverDesc", "" ) ) )
oReg:Close()
If Empty( uVar ) // Win95-98-ME doesn't have the above key
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\Class\Mouse\0000", .f. )
uVar := RTrim( Remove0( oReg:Get( "DriverDesc", "" ) ) )
oReg:Close()
Endif
Return uVar
//--------------------------------------------------------------------
METHOD MouseVersion() Class TSystemInfo
Local oReg, uVar
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\Class\{4D36E96F-E325-11CE-BFC1-08002BE10318}\0000", .f. )
uVar := RTrim( Remove0( oReg:Get( "DriverVersion", "" ) ) )
oReg:Close()
If Empty( uVar ) // Win95-98-ME doesn't have the above key
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\Class\Mouse\0000", .f. )
uVar := RTrim( Remove0( oReg:Get( "DriverVersion", "" ) ) )
oReg:Close()
Endif
Return uVar
//--------------------------------------------------------------------
METHOD IPInfo() Class TSystemInfo
Local lSuccess
If lSuccess := WSAStartUp() == 0
::cSName := GetHostName() // usually the same as ::ComputerName(), but in original case (lower case most likely)
::cIP := GetHostByName( ::cSName )
::cLName := GetHostByAddress( AllTrim( ::cIP ) )
WSACleanUp()
Else
::cIP := "0.0.0.0"
::cSName := ""
::cLName := ""
Endif
Return lSuccess
//--------------------------------------------------------------------
METHOD Memory( nMem ) Class TSystemInfo
LOCAL nRetu:=0
#ifdef __HARBOUR__
#pragma BEGINDUMP
#include "windows.h"
#pragma ENDDUMP
nRetu := HB_INLINE( nMem ){
MEMORYSTATUS mst;
long nMem = hb_parnl(1);
mst.dwLength = sizeof( MEMORYSTATUS );
GlobalMemoryStatus( &mst );
switch( nMem )
{
case 1: hb_retnl( mst.dwTotalPhys / (1024*1024) ) ; break;
case 2: hb_retnl( mst.dwAvailPhys / (1024*1024) ) ; break;
case 3: hb_retnl( mst.dwTotalPageFile / (1024*1024) ) ; break;
case 4: hb_retnl( mst.dwAvailPageFile / (1024*1024) ) ; break;
case 5: hb_retnl( mst.dwTotalVirtual / (1024*1024) ) ; break;
case 6: hb_retnl( mst.dwAvailVirtual / (1024*1024) ) ; break;
default: hb_retnl( 0 ) ;
}
}
#else
Local oMemory
Struct oMemory
Member m1 As LONG // nSize
Member m2 As LONG // Memory Load
Member m3 As LONG // Total Physical
Member m4 As LONG // Available Physical
Member m5 As LONG // Total Page File
Member m6 As LONG // Available Page File
Member m7 As LONG // Total Virtual
Member m8 As LONG // Available Virtual
EndStruct
oMemory:m1 := oMemory:sizeOf()
MemStat( oMemory:cBuffer )
Do Case
Case nMem == 1 ; nRetu := Round( oMemory:m3 / ( 1024 * 1024 ), 0 )
Case nMem == 2 ; nRetu := Round( oMemory:m4 / ( 1024 * 1024 ), 0 )
Case nMem == 3 ; nRetu := Round( oMemory:m5 / ( 1024 * 1024 ), 0 )
Case nMem == 4 ; nRetu := Round( oMemory:m6 / ( 1024 * 1024 ), 0 )
Case nMem == 5 ; nRetu := Round( oMemory:m7 / ( 1024 * 1024 ), 0 )
Case nMem == 6 ; nRetu := Round( oMemory:m8 / ( 1024 * 1024 ), 0 )
Otherwise ; nRetu := 0
EndCase
If nRetu # 0 .and. ::nPlatform == 1 // added by lkm
nRetu += 1 // calc error under Win95/98/ME
Endif
#endif
Return nRetu
//--------------------------------------------------------------------
#ifndef __HARBOUR__
DLL32 Static Function MemStat( pMEMORY As LPSTR ) As VOID ;
PASCAL From "GlobalMemoryStatus" Lib "KERNEL32.DLL"
#endif
//--------------------------------------------------------------------
Method GetColors() Class TSystemInfo
Local hDC, nPlanes, nBitsPixel
hDC := CreateDC( "DISPLAY", "", "" )
nPlanes := GetDeviceCaps( hDC, 14 )
nBitsPixel := GetDeviceCaps( hDC, 12 )
DeleteDC( hDC )
Return Int( 2 ^ ( nPlanes * nBitsPixel ) )
//--------------------------------------------------------------------
DLL32 Function GetVerExA( @lpVersionInformation As LPSTR );
As LONG PASCAL From "GetVersionExA" Lib "KERNEL32.DLL"
Static Function psz( c ) ; Return SubStr( c, 1, At( Chr(0), c ) - 1 )
Static Function Remove0( c ) ; Return StrTran( c, Chr(0), " " )
//--------------------------------------------------------------------
METHOD GMTOffset() Class TSystemInfo
Local oReg, uVar
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\TimeZoneInformation", .f. )
uVar := oReg:Get( "Bias", 0 )
oReg:Close()
uVar := Round( uVar / 60, 0 ) * -1
Return uVar
LOCAL oReg
LOCAL uVar
oReg := TReg32():New( HKEY_LOCAL_MACHINE, "HARDWARE\DESCRIPTION\System\BIOS", .f. )
uVar := oReg:Get( "BIOSReleaseDate", "" )
oReg:Close()
Return to FiveWin para Harbour/xHarbour
Users browsing this forum: Google [Bot] and 41 guests