tengo algo, solo me falta en envío por mail, es reducida la información pero es lo que yo necesito para resolver el problema en donde se generó
1.- formato del archivo Error dd-mm_Hora_mm.ss.TXT mas otro archivo genérico que tiene el nombre "Error de Sistema.txt"
2.- Guarda cada error generado en un DBF llamado Repository.dbf que lo genera automáticamente si no lo encuentra.
3.- Todo esto lo guarda en una sub-carpeta en donde se encuentra el sistema que se llama "Mensajes de Error"
Code: Select all
#include "FiveWin.ch"
#include "Error.ch"
#include "Struct.ch"
#include "Dll.ch"
#include "TSButton.ch"
#include "viking_Master.ch" <----- solo saca variables propias de versiones de mi sistema mas algunas definiciones de colores
#define HKEY_CLASSES_ROOT 2147483648 // 0x80000000
#define HKEY_CURRENT_USER 2147483649 // 0x80000001
#define HKEY_LOCAL_MACHINE 2147483650 // 0x80000002
#define NTrim(n) AllTrim( Transform( n , "@E 999,999,999,999") )
PROCEDURE ErrorSys()
ErrorBlock( { | e | ErrorDialog( e ) } )
RETURN
//--------------------------
STATIC FUNCTION ErrorDialog( e )
LOCAL aRct, oBtn, lRet, nI, oSystemInfo, oOldError, oDlg, oLbx, oFont[2], oSay, cMessage, cErrorLog := "", aStack := {}, oNombre := ""
IF ( e:genCode == EG_ZERODIV ) ; RETURN 0 ; ENDIF
IF ( e:genCode == EG_OPEN .AND. ( e:osCode == 32 .OR. e:osCode == 5 ) .AND. e:canDefault ) ; NETERR( .T. ) ; RETURN .F. ; ENDIF
IF ( e:genCode == EG_APPENDLOCK .AND. e:canDefault ) ; NETERR( .T. ) ; RETURN .F. ; ENDIF
IF ProcName( 7 ) == "ERRORDIALO"
SET RESOURCES TO
ErrorLevel( 1 )
QUIT
ENDIF
USE .\Fuentes\System\Empresa.dbf ALIAS ALVER SHARED NEW <-- solo saca un campo en donde veo la versión de compilación
cErrorLog += "Información" + CRLF
cErrorLog += "-----------" + CRLF
cErrorLog += "Ruta y nombre: " + GetModuleFileName( GetInstance() ) + CRLF
cErrorLog += "Fecha y Hora : " + DTOC( DATE() )+" - "+TIME() + CRLF
cErrorLog += "Tamaño : " + NTrim( FSize( GetModuleFileName( GetInstance() ) ) ) + " bytes" + CRLF
cErrorLog += "Estación : " + NETNAME() + CRLF + CRLF
cMessage = "Detalle técnico" + CRLF+;
"---------------" + CRLF+;
ErrorMessage( e ) + CRLF
cErrorLog += cMessage
if ValType( e:Args ) == "A"
cErrorLog += "Argumentos :" + CRLF
for nI = 1 to Len( e:Args )
cErrorLog += "[" + Str( nI, 4 ) + "]= " + ValType( e:Args[ nI ] ) + ;
cValToChar( e:Args[ nI ] ) + CRLF
next
endif
cErrorLog += CRLF + "Procedimientos" + CRLF
cErrorLog += "--------------" + CRLF
nI := 2 // we don't disscard any info again !
while ( nI < 74 )
if ! Empty(ProcName( nI ) )
AAdd( aStack, __VERSION+ALVER->VERSION1+" Llamado de " + Trim( ProcName( nI ) ) + ;
"(" + NTrim( ProcLine( nI ) ) + ")" )
cErrorLog += ATail( aStack ) + CRLF
endif
nI++
end
oSystemInfo:=TSystemInfo():New()
cErrorLog+=CRLF+ "Sistema"
cErrorLog+=CRLF+ "-------"
cErrorLog+=CRLF+ "Versión de Windows = " + oSystemInfo:WinVer()
cErrorLog+=CRLF+ "Número de Versión = " + oSystemInfo:VerNum()
cErrorLog+=CRLF+ "Versión de Compilador = " + Version()
cErrorLog+=CRLF+ "Versión de Sistema = " + __VERSION+ALVER->VERSION1
cErrorLog+=CRLF
cErrorLog+=CRLF+ "Procesador"
cErrorLog+=CRLF+ "----------"
cErrorLog+=CRLF+ oSystemInfo:CPUVendor()+" "+oSystemInfo:CPUIdentifier()
cErrorLog+=CRLF+ "Tipo "+oSystemInfo:CPU()+" o Superior"
cErrorLog+=CRLF+ "Velocidad " + IF(oSystemInfo:SpeedCPU()>0,LTrim(Str(oSystemInfo:SpeedCPU()))+" MHz","No determinada")
if oSystemInfo:IsDualCPU()
cErrorLog+=CRLF+ "Placa Multiprocesador"
endif
cErrorLog+=CRLF+ "BIOS "+oSystemInfo:NameSystemBios()+" "+oSystemInfo:DateSystemBios()
cErrorLog+=CRLF
cErrorLog+=CRLF+ "Fin Error.txt "
cErrorLog+=CRLF+ "--------------"
cErrorLog+=CRLF
if ProcName( 7 ) == "ERRORDIALO"
SET RESOURCES TO
ErrorLevel( 1 )
QUIT
endif
oNombre := ".\Mensajes de Error\Error "+strtran( ( str(day(date()),2,0)+"-"+str(month(date()),2,0)+"_hora_"+substr(time(),1,2)+"."+substr(time(),4,2))," ","0")+".txt"
MemoWrit( ".\Mensajes de Error\Error de Sistema.txt", cErrorLog )
MemoWrit( oNombre, cErrorLog )
/* PANTALLA DE CONTROL DEL ERROR */
DEFINE FONT oFont[1] NAME "Roboto" SIZE 0, -12
DEFINE FONT oFont[2] NAME __FONT SIZE 0, -15
nI := aStack[ 1 ]
DEFINE DIALOG oDlg SIZE 600, 285 TITLE __LOGO+" "+__MAIN1 STYLE nOr( WS_CHILD, WS_POPUP, WS_CAPTION ) COLOR CLR_WHITE FONT oFont[2]
@ 00, 03 STSAY oSay VAR "TECNICAL / "+ErrorMessage( e ) CENTER OF oDlg FONT oFont[1] SIZE 295, 80
@ 20, 03 STSAY oSay VAR "Modulos en Ejecusión" OF oDlg FONT oFont[2] PIXEL
@ 24,248 STSAY oSay VAR __VERSION+ALVER->VERSION1 OF oDlg FONT oFont[1] SIZE 50, 18 PIXEL COLOR CLR_HRED
@ 31,3 Listbox oLbx VAR nI ITEMS aStack OF oDlg SIZE 295,90 FONT oFont[1] COLOR CLR_HRED, CLR_BLACK PIXEL
@ 120, 95 SBUTTON oBtn PROMPT "Salir" OF oDlg SIZE 50, 18 PIXEL ACTION ( oDlg:End() ) FONT oFont[2] SUNSET COLOR CLR_WHITE, CLR_BLACK
@ 120,165 SBUTTON oBtn PROMPT "Detalles" OF oDlg SIZE 50, 18 PIXEL ACTION ( WAITRUN("NotePad .\Mensajes de Error\Error de Sistema.txt"), oDlg:End() ) FONT oFont[2] SUNSET COLOR CLR_WHITE, CLR_BLACK
ACTIVATE DIALOG oDlg CENTERED ;
ON PAINT ( aRct := GetClientRect( oDlg:hWnd ), GradColor( oDlg:hDC, aRct, nRGB(68,68,68), CLR_BLACK ) ) ;
ON INIT ( SndPlaySound(".\SYSTEM\Voice_Error.wav",1) )
oFont[1]:End()
oFont[2]:End()
if lRet == nil .or. ( !LWRunning() .and. lRet )
BEGIN SEQUENCE
oOldError = ErrorBlock( { || DoBreak() } )
IF !FILE ("Mensajes de Error\Repository.dbf")
DbCreate("Mensajes de Error\Repository.dbf", {{"USER" ,"C",11,0},;
{"FECHA" ,"D", 8,0},;
{"HORA" ,"C", 8,0},;
{"ERROR" ,"C",90,0},;
{"DESCR" ,"M",10,0}})
ENDIF
USE "Mensajes de Error\Repository.dbf" SHARED
APPEND BLANK
REPLACE USER WITH NETNAME()
REPLACE FECHA WITH DATE()
REPLACE HORA WITH TIME()
REPLACE ERROR WITH STRTRAN(ErrorMessage( e ),CRLF," ")
REPLACE DESCR WITH cErrorLog
COMMIT
END SEQUENCE
ErrorBlock( oOldError )
DBCLOSEALL()
SET RESOURCES TO
ErrorLevel( 1 )
QUIT
endif
return lRet
//----------------------------------------------------------------------------//
static function DoBreak()
BREAK
return nil
//----------------------------------------------------------------------------//
static function ErrorMessage( e )
// start error message
local cMessage := if( empty( e:OsCode ), ;
if( e:severity > ES_WARNING, "Error ", "ADV=" ),;
"(Error DOS " + AllTrim( Str( e:osCode ) ) + ") " )
// add subsystem name if available
cMessage += if( ValType( e:SubSystem ) == "C", e:SubSystem(), "???" )
// add subsystem's error code if available
cMessage += if( ValType( e:SubCode ) == "N", "/" + AllTrim( Str( e:SubCode ) ), "/???" )
// add error description if available
if ( ValType( e:Description ) == "C" )
cMessage += " " + e:Description
end
// add either filename or operation
cMessage += if( ! Empty( e:FileName ),;
": " + e:FileName ,;
if( !Empty( e:Operation ),;
": " + e:Operation ,;
"" ) )
return cMessage
//----------------------------------------------------------------------------//
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 )
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 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 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" )
ENDCLASS
//--------------------------------------------------------------------
METHOD New( lTest, lMsg ) Class TSystemInfo
Local cBuffer, sInfo, lWinNT := IsWinNT()
Default lTest := .F., lMsg := .T.
::TSIVersion := "1.06"
::IPInfo()
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 ) )
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 ::IsWinXP() ; cVersion := "Windows XP"
Otherwise ; cVersion := "Windows 7 o Superior"
EndCase
Return cVersion
//--------------------------------------------------------------------
METHOD WhichNT() Class TSystemInfo
Local oReg, uVar
If ::nPlatform < 2
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
//--------------------------------------------------------------------
#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 ) )
Static Function Remove0( c )
Return StrTran( c, Chr(0), " " )
Static Function psz( c )
Return SubStr( c, 1, At( Chr(0), c ) - 1 )
//--------------------------------------------------------------------
DLL32 STATIC FUNCTION GetVerExA( @lpVersionInformation As LPSTR ) As LONG PASCAL From "GetVersionExA" Lib "KERNEL32.DLL"
//--------------------------------------------------------------------
si te salta un error por variables, esas son propias mías y que no influyen en el funcionamiento de la clase, las puedes reemplazar por las tuyas.