tSystem.prg

tSystem.prg

Postby karinha » Fri Jan 08, 2016 12:25 pm

Buen dia, necesito el TSystem.prg actual.

Gracias, saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7794
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: tSystem.prg

Postby karinha » Mon Jan 11, 2016 1:33 pm

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

Code: Select all  Expand view

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.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7794
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: tSystem.prg

Postby karinha » Mon Jan 11, 2016 1:43 pm

Cambios en TSYSTEM.PRG


Code: Select all  Expand view

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.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7794
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: tSystem.prg

Postby hmpaquito » Mon Jan 11, 2016 2:43 pm

thks.

please... and windows 2008/ 2012 server ?
hmpaquito
 
Posts: 1482
Joined: Thu Oct 30, 2008 2:37 pm

Re: tSystem.prg

Postby 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
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42060
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: tSystem.prg

Postby Antonio Linares » Mon Jan 11, 2016 3:40 pm

João,

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

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42060
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: tSystem.prg

Postby karinha » Mon Jan 11, 2016 3:58 pm

Code: Select all  Expand view

#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.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7794
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: tSystem.prg

Postby Antonio Linares » Mon Jan 11, 2016 4:00 pm

João,

many thanks
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42060
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: tSystem.prg

Postby MOISES » Wed Jan 29, 2020 10:38 am

Hi,

Is there any update?

For example, BIOS functions are not longer working.

Thank you.
Saludos / Regards,

FWH 20.04, Harbour 3.2.0 dev (r1909261630) y BCC 7.40
MOISES
 
Posts: 838
Joined: Wed Aug 22, 2007 10:09 am

Re: tSystem.prg

Postby 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.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7794
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: tSystem.prg

Postby MOISES » Wed Jan 29, 2020 3:55 pm

Por ejemplo, METHOD DateSystemBios()


Lo he solucionado así:

Code: Select all  Expand view
 LOCAL oReg
  LOCAL uVar

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

FWH 20.04, Harbour 3.2.0 dev (r1909261630) y BCC 7.40
MOISES
 
Posts: 838
Joined: Wed Aug 22, 2007 10:09 am


Return to FiveWin para Harbour/xHarbour

Who is online

Users browsing this forum: Google [Bot] and 41 guests