kapiaba Posted January 7, 2016 Report Share Posted January 7, 2016 Galera, alguém tem esta classe para os tempo atuais? #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" Otherwise ; cVersion := "Unknown Windows version" EndCase 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 Ronaldbuch 1 Quote Link to comment Share on other sites More sharing options...
kleyber Posted January 8, 2016 Report Share Posted January 8, 2016 Kapi, Eu tenho, por causa do DBF2SQL. Assim que chegar em casa te envio. kapiaba 1 Quote Link to comment Share on other sites More sharing options...
kleyber Posted January 10, 2016 Report Share Posted January 10, 2016 Kapi, Tá no teu email. Veja se funciona pra ti. kapiaba 1 Quote Link to comment Share on other sites More sharing options...
kapiaba Posted January 11, 2016 Author Report Share Posted January 11, 2016 Gracias Kleyber, mas a sua versão também não prevê windows 7 32 / 64 bits, nem windows 8, nem o windows 10. Obg. abs. Kelyber, aqui deveria prever as novas versões do rWindows... 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" Otherwise ; cVersion := "Unknown Windows version" EndCase Abs Quote Link to comment Share on other sites More sharing options...
aferra Posted January 11, 2016 Report Share Posted January 11, 2016 Fala mestre....segue o que encontrei no próprio fivewin. fonte ..\FWH\source\function\getsysin.prg 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" Quote Link to comment Share on other sites More sharing options...
kapiaba Posted January 11, 2016 Author Report Share Posted January 11, 2016 Resolvido, basta modificar GETSYSIN.PRG do próprio FWH... 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 Quote Link to comment Share on other sites More sharing options...
kapiaba Posted January 11, 2016 Author Report Share Posted January 11, 2016 Modificações na TSYSTEM.PRG 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 Obg. abs. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.