tSystem.prg

Post by **karinha** » Fri Jan 08, 2016 12:25 pm

Buen dia, necesito el TSystem.prg actual.

Gracias, saludos.

Post by **karinha** » Mon Jan 11, 2016 1:33 pm

Resuelto, cambiando GETSYSIN.PRG del FWH.. funciona.

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

Gracias, saludos.

Post by **karinha** » Mon Jan 11, 2016 1:43 pm

Cambios en TSYSTEM.PRG

Code: Select all

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

Gracias, saludos.

hmpaquito · Post by **hmpaquito** » Mon Jan 11, 2016 2:43 pm

thks.

please... and windows 2008/ 2012 server ?

Post by **Antonio Linares** » Mon Jan 11, 2016 3:38 pm

João,

Thanks, included for next FWH version.

Just the Windows 2008 or 2012 server detection reported by Paco is missing to solve

Post by **Antonio Linares** » Mon Jan 11, 2016 3:40 pm

João,

Could you please post here the complete tsystem.prg source code ? thanks

Post by **karinha** » Mon Jan 11, 2016 3:58 pm

Code: Select all

#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

Saludos.

Post by **Antonio Linares** » Mon Jan 11, 2016 4:00 pm

João,

many thanks

MOISES · Post by **MOISES** » Wed Jan 29, 2020 10:38 am

Hi,

Is there any update?

For example, BIOS functions are not longer working.

Thank you.

Post by **karinha** » Wed Jan 29, 2020 1:25 pm

Que comando no funciona más? Muestre porfa? Sin mostrar lo que quieres hacer, es difícil ayudarte.

Saludos.

MOISES · Post by **MOISES** » Wed Jan 29, 2020 3:55 pm

Por ejemplo, METHOD DateSystemBios()

Lo he solucionado así:

Code: Select all

  LOCAL oReg
  LOCAL uVar

  oReg := TReg32():New( HKEY_LOCAL_MACHINE, "HARDWARE\DESCRIPTION\System\BIOS", .f. )
  uVar := oReg:Get( "BIOSReleaseDate", "" )
  oReg:Close()

FiveTech Software tech support forums

tSystem.prg

tSystem.prg

Re: tSystem.prg

Re: tSystem.prg

Re: tSystem.prg

Re: tSystem.prg

Re: tSystem.prg

Re: tSystem.prg

Re: tSystem.prg

Re: tSystem.prg

Re: tSystem.prg

Re: tSystem.prg