Buenas tardes,
dispone alguien de la clase TDiskInfo v2.1 ( o superior, jejejeje) de Antonio Castro funcionando y sin errores ?
Muchas gracias.
Saludos,
Félix
Buenas tardes,
dispone alguien de la clase TDiskInfo v2.1 ( o superior, jejejeje) de Antonio Castro funcionando y sin errores ?
Muchas gracias.
Saludos,
Félix

oDisk:Drive( Eval( oBrw:aCols[ 1 ]:bStrData ) )oDisk:Drive(oBrw:aCols[ 1 ]:bStrData )Application
===========
Path and name: Z:\PRUEBAS\TDisknfo\DiskInfo.Exe (32 bits)
Size: 702,976 bytes
Time from start: 0 hours 0 mins 4 secs
Error occurred at: 10/05/11, 22:37:08
Error description: Error BASE/1132 Bound error: array access
Args:
[ 1] = A { ... }
[ 2] = N 3
Stack Calls
===========
Called from: Z:\PRUEBAS\TDisknfo\tgraph.prg => TGRAPH:PAINT(770)
Called from: Z:\PRUEBAS\TDisknfo\tgraph.prg => (b)TGRAPH:TGRAPH(109)
Called from: => TGRAPH:DISPLAY(0)
Called from: .\source\classes\CONTROL.PRG => TGRAPH:HANDLEEVENT(1459)#include "FiveWin.ch"
#include "xBrowse.ch"
#include "TGraph.ch"
#define cTDiskInfoVer "TDiskInfo Class V2.1, Update 26 March 2008 ©"
#define cPicture "@E 9,999,999,999,999.99" // Picture para mostar números con decimales
#define cPictInt "@E 9,999,999,999,999,999" // Picture para mostar números sin decimales
//----------------------------------------------------------------------------//
Function Main()
LocaL nI, acDisk:={}
Local cText := PadR( "\\Calculus\CALCULO", 40 )
Local oDlg, oBrw, oDisk, aoGraph[ 2 ], aoBtn[ 4 ], oGet
Local anWidth := { 80, 120, 120, 132, 132, 98, 92, 130, 94, 130, 94, 150, 106, 70, 74 }
Local acHeader := { "UNIDAD", "ETIQUETA", "TIPO UNIDAD", "NUMERO DE SERIE",;
"SIST. DE ARCHIVO", "CLUSTER", "SECTORES", "ESPACIO USADO",;
"USO CORTO", "ESPACIO LIBRE", "LIBRE CORTO", "ESPACIO TOTAL",;
"TOTAL CORTO", "% USO", "% LIBRE" }
Local anDataAlign := { AL_LEFT, AL_LEFT, AL_LEFT, AL_LEFT, AL_LEFT, AL_RIGHT,;
AL_RIGHT, AL_RIGHT, AL_RIGHT, AL_RIGHT, AL_RIGHT,;
AL_RIGHT, AL_RIGHT, AL_RIGHT, AL_RIGHT }
DEFINE DIALOG oDlg RESOURCE "D_TEST" TITLE cTDiskInfoVer
oDlg:lHelpIcon := .F.
oDisk := TDiskInfo():New()
oBrw := TXBrowse():New( oDlg )
oBrw:CreateFromResource( 303 )
oDlg:oFont := TFont():New( "ARIAL", 0, -12, .F., .t.)
For nI := 1 to 26
SysRefresh()
oDisk:Drive( Chr( 64 + nI ) ) // Verifica todas las unidades A-Z
If oDisk:nDiskType <> 1 // 1 = No Instalado
AADD( acDisk, { oDisk:Drive(),;
oDisk:Label(),;
oDisk:DriveType(),;
oDisk:NumSerie(),;
oDisk:FileSystem(),;
oDisk:SPClusters(),;
oDisk:BPSectors(),;
oDisk:UsedSpace(),;
oDisk:SUSpace(),;
oDisk:FreeSpace(),;
oDisk:SFSpace(),;
oDisk:TotalSpace(),;
oDisk:STSpace(),;
oDisk:PUSpace(),;
oDisk:PFSpace() } )
EndIf
Next nI
oBrw:SetArray(acDisk, .T.)
For nI := 1 to Len( anWidth )
oBrw:aCols[ nI ]:nWidth := anWidth[ nI ]
oBrw:aCols[ nI ]:cHeader := acHeader[ nI ]
oBrw:aCols[ nI ]:nHeadStrAlign := AL_CENTER
oBrw:aCols[ nI ]:nDataStrAlign := anDataAlign[ nI ]
Next nI
oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW
oBrw:nColDividerStyle := LINESTYLE_BLACK
oBrw:nRowDividerStyle := LINESTYLE_BLACK
oBrw:bLDblClick := {|| Eval(aoBtn[ 3 ]:bAction) }
//oBrw:bRClicked := {|| MsgInfo( oBrw:aCols[oBrw]:nWidth ) }
oBrw:bKeyDown := {| nKey | If( nKey == 13, Eval(aoBtn[ 3 ]:bAction), .T. ) }
oBrw:bChange:= {|| oDisk:Drive( Eval( oBrw:aCols[ 1 ]:bStrData ) ),;
aoBtn [ 3 ]:cTitle := "&Propiedades " + oDisk:Drive(),;
aoGraph[ 1 ]:aData := { { oDisk:nPUSpace }, { oDisk:nPFSpace } },;
aoGraph[ 2 ]:aData := { { oDisk:nPUSpace }, { oDisk:nPFSpace } },;
aoGraph[ 1 ]:Refresh(),;
aoGraph[ 2 ]:Refresh() }
// Unidad por defecto para cargar los valores de los gráfico
//oDisk:Drive( Eval( oBrw:aCols[ 1 ]:bStrData ) ) // Da error
oDisk:Drive( oBrw:aCols[ 1 ]:bStrData ) // Devuelve Z:\
oDisk:Drive("C:\")
REDEFINE GRAPH aoGraph[ 1 ] ID 301 OF oDlg;
TYPE GRAPH_TYPE_PIE XVALUES YVALUES XGRID YGRID LEGENDS 3D
aoGraph[ 1 ]:cTitle := oDisk:TDIVer()
aoGraph[ 1 ]:nClrBack := aoGraph[ 1 ]:nClrPane
aoGraph[ 1 ]:aFont[4] := TFont():New( "IMPACT", 6, -10, .F., .F., 0, 0, , .F., .F.)
aoGraph[ 1 ]:aFont[8] := aoGraph[ 1 ]:aFont[4]
aoGraph[ 1 ]:aData := { { oDisk:nPUSpace }, { oDisk:nPFSpace } }
aoGraph[ 1 ]:aSeries := { { "Utilizado ", CLR_HBLUE },;
{ "Disponible ", nRGB( 255, 0, 255 ) } }
REDEFINE GRAPH aoGraph[ 2 ] ID 302 OF oDlg;
TYPE GRAPH_TYPE_BAR XVALUES YVALUES XGRID YGRID LEGENDS 3D
aoGraph[ 2 ]:cTitle := oDisk:TDIVer()
aoGraph[ 2 ]:aFont[ 4 ] := TFont():New( "IMPACT", 6, -12, .F., .F., 0, 0, , .F., .F.)
aoGraph[ 2 ]:aFont[ 8 ] := aoGraph[ 2 ]:aFont[ 4 ]
aoGraph[ 2 ]:aData := { { oDisk:nPUSpace }, { oDisk:nPFSpace } }
aoGraph[ 2 ]:aSeries := { { "Utilizado ", CLR_HBLUE },;
{ "Disponible ", nRGB( 255, 0, 255 ) } }
REDEFINE GET oGet VAR cText ID 101 OF oDlg
oGet:bGotFocus := {|| oGet:SelectAll() }
oGet:bLClicked := {|| oGet:SelectAll() }
REDEFINE BUTTON aoBtn[ 1 ] PROMPT "&Cargar Recurso" ID 201 OF oDlg;
ACTION ResourceUNCInfo( cText, oBrw, oGet )
REDEFINE BUTTON aoBtn[ 2 ] PROMPT "Probando &Algunos Métodos" ID 202 OF oDlg;
ACTION TestMetodos( Eval( oBrw:aCols[ 1 ]:bStrData ) )
REDEFINE BUTTON aoBtn[ 3 ] PROMPT "&Propiedades " + oDisk:Drive() ID 203 OF oDlg;
ACTION DiskInfo( Eval( oBrw:aCols[ 1 ]:bStrData ) )
REDEFINE BUTTON aoBtn[ 4 ] ID 204 OF oDlg;
ACTION oDlg:End()
ACTIVATE DIALOG oDlg CENTERED ON INIT oBrw:SetFocus()
Release oDlg, oBrw, oDisk
AEval( aoBtn, { | o | If( o != Nil, o:End(), Nil ) } )
AEval( aoGraph, { | o | If( o != Nil, o:End(), Nil ) } )
Return NIL
//----------------------------------------------------------------------------//
Function DiskInfo( cDrive )
Local oDlg, oGraph, aoBmp[ 4 ], oBtn
Local oDisk := TDiskInfo():New( cDrive )
Local acResBMP := { "B_NODISK", "B_EXTRAIBLE",;
"B_HDISK" , "B_NETDISK",;
"B_CDDVD" , "B_RAMDISK",;
"B_USBDISK", "B_NETDISK" }
DEFINE DIALOG oDlg RESOURCE "D_DISK" ;
TITLE "Propiedades de " + If( oDisk:Label() == "No asignada" , ;
"Disco Local " + oDisk:Drive() ,;
oDisk:Label() + " " + oDisk:Drive() )
oDlg:lHelpIcon := .F.
oDlg:oFont := TFont():New( "ARIAL", 6, -12, .F., .T.)
REDEFINE BITMAP aoBmp[ 1 ] TRANSPARENT;
RESOURCE acResBMP[ oDisk:nDiskType ] ID 201 OF oDlg
REDEFINE SAY PROMPT oDisk:cLabel ID 101 OF oDlg
REDEFINE SAY PROMPT oDisk:DriveType() ID 102 OF oDlg
REDEFINE SAY PROMPT oDisk:FileSystem() ID 103 OF oDlg
REDEFINE BITMAP aoBmp[ 2 ] TRANSPARENT;
RESOURCE "B_BLUE" ID 202 OF oDlg
REDEFINE SAY PROMPT oDisk:UsedSpace() ID 104 OF oDlg
REDEFINE SAY PROMPT oDisk:SUSpace() ID 105 OF oDlg
REDEFINE BITMAP aoBmp[ 3 ] TRANSPARENT;
RESOURCE "B_PINK" ID 203 OF oDlg
REDEFINE SAY PROMPT oDisk:FreeSpace() ID 106 OF oDlg
REDEFINE SAY PROMPT oDisk:SFSpace() ID 107 OF oDlg
REDEFINE BITMAP aoBmp[ 4 ] TRANSPARENT;
RESOURCE "B_BLUEPINK" ID 204 OF oDlg
REDEFINE SAY PROMPT oDisk:TotalSpace() ID 108 OF oDlg
REDEFINE SAY PROMPT oDisk:STSpace() ID 109 OF oDlg
REDEFINE SAY PROMPT oDisk:SPClusters() ID 110 OF oDlg
REDEFINE SAY PROMPT oDisk:BPSectors() ID 111 OF oDlg
REDEFINE SAY PROMPT oDisk:UsedClusters() ID 112 OF oDlg
REDEFINE SAY PROMPT oDisk:FreeClusters() ID 113 OF oDlg
REDEFINE SAY PROMPT oDisk:TotalClusters() ID 114 OF oDlg
REDEFINE GRAPH oGraph ID 205 OF oDlg;
TYPE GRAPH_TYPE_PIE XVALUES YVALUES XGRID YGRID LEGENDS 3D
oGraph:lTitle := .F.
oGraph:lLegends := .F.
oGraph:cTitle := oDisk:TDIVer()
oGraph:nClrBack := oDlg:nClrPane
oGraph:nClrX := oDlg:nClrPane
oGraph:nClrPane := oDlg:nClrPane
oGraph:nClrBack := oDlg:nClrPane
oGraph:aFont[1] := TFont():New( "IMPACT", 0, -10, .F., .T., 0, 0, , .F., .F.)
oGraph:aData := { { oDisk:nPUSpace }, { oDisk:nPFSpace } }
oGraph:aSeries := { { "Utilizado ", CLR_HBLUE },;
{ "Disponible ", nRGB( 255, 0, 255 ) } }
REDEFINE BUTTON oBtn ID 301 OF oDlg;
ACTION oDlg:End()
ACTIVATE DIALOG oDlg CENTER;
ON PAINT ( fRectangle(oDlg, 045, 00, 047, 374, nRGB( 100, 100, 100 ) ),;
fRectangle(oDlg, 105, 10, 106, 360, nRGB( 190, 190, 190 ) ),;
fRectangle(oDlg, 188, 10, 189, 360, nRGB( 190, 190, 190 ) ) )
Release oDlg, oGraph, oDisk, oBtn
AEval( aoBmp, { | o | If( o != Nil, o:End(), Nil ) } )
Return Nil
//------------------------------------------------------------------------------------------//
Function TestMetodos( cDrive )
Local oDisk := TDiskInfo():New( cDrive )
MsgInfo(oDisk:cAuthor, cTDiskInfoVer ) // Versión TDiskInfo
MsgInfo(oDisk:Label(), "Label() - Etiqueta" ) // Label
MsgInfo(oDisk:Drive(), "Drive() - Unidad" ) // Drive
MsgInfo(oDisk:DriveType(), "DriveType() - Tipo de Unidad" ) // Drive Type
MsgInfo(oDisk:NumSerie(), "NumSerie() - Número de Serie, Tipo DOS" ) // Num Serie - Type DOS
MsgInfo(oDisk:FileSystem(), "FileSystem() - Sistema de Archivo" ) // File System
MsgInfo(oDisk:BPSectors(), "BPSectors() - Bytes por Sectores" ) // Bytes by Sector
MsgInfo(oDisk:SPClusters(), "SPClusters() - Sector por Clúster" ) // Sector by Cluster
MsgInfo(oDisk:FreeClusters(), "FreeClusters() - Cluster Libres" ) // Cluster Free
MsgInfo(oDisk:UsedClusters(), "UsedClusters() - Cluster Usados" ) // Cluster Used
MsgInfo(oDisk:TotalClusters(), "TotalClusters() - Total Cluster" ) // Cluster Total
MsgInfo(oDisk:UsedSpace(), "UsedSpace() - Espacio Utilizado" ) // Space Used
MsgInfo(oDisk:SUSpace(), "SUSpace() - Espacio Utilizado, Formato Corto" ) // Short Space Use
MsgInfo(oDisk:FreeSpace(), "FreeSpace() - Espacio Libre" ) // Free Space
MsgInfo(oDisk:SFSpace(), "SFSpace() - Espacio Libre, Formato Corto" ) // Short Free Space
MsgInfo(oDisk:TotalSpace(), "TotalSpace() - Espacio Total" ) // Total Space
MsgInfo(oDisk:STSpace(), "STSpace() - Espacio Total, Formato Corto" ) // Short Total Space
MsgInfo(oDisk:PUSpace(), "PUSpace() - Espacio Utilizado, en Porcentaje %" ) // Porcent Used Space
MsgInfo(oDisk:PFSpace(), "PFSpace() - Espacio Libre, en Porcentaje %" ) // Porcent Free Space
MsgInfo( "F I N", StrToken( cTDiskInfoVer, 1, "," ) )
Return Nil
//------------------------------------------------------------------------------------------//
Function ResourceUNCInfo( cDrive, oBrw, oGet )
Local oDisk := TDiskInfo():New( cDrive )
If Empty( cDrive )
MsgInfo( "Debe colocar la ruta del recuso",;
"Mensaje del Sistema" )
oGet:SetFocus()
Return Nil
EndiF
//If oDisk:nTClusters = 0 // con esto se verifica si se pudo conectar la unidad
//If oDisk:NumSerie() = "0000-0000" // pero así tambien sirve para verificar
If oDisk:NumSerie() = "0000-0000"
MsgAlert( "Recurso no encontrado, por favor verifique" + CRLF + CRLF +;
"NOTA: EL TIEMPO QUE TARDA EN VERIFICAR SI ESXISTE O NO" + CRLF +;
"EL RECURSO DE RED ES DETERMINADO POR EL S.O., YA QUE SE" + CRLF +;
"INTENTA CONSEGUIR POR TODOS LOS MEDIOS EL RECURSO. OJO",;
"Mensaje del Sistema" )
Return Nil
Else
AADD( oBrw:aArrayData, { oDisk:Drive(),;
oDisk:Label(),;
oDisk:DriveType(),;
oDisk:NumSerie(),;
oDisk:FileSystem(),;
oDisk:SPClusters(),;
oDisk:BPSectors(),;
oDisk:UsedSpace(),;
oDisk:SUSpace(),;
oDisk:FreeSpace(),;
oDisk:SFSpace(),;
oDisk:TotalSpace(),;
oDisk:STSpace(),;
oDisk:PUSpace(),;
oDisk:PFSpace() } )
oBrw:Refresh()
EndIf
Return Nil
//------------------------------------------------------------------------------------------//
// Add By Antonio Castro 22/03/08
Function fRectangle(oWnd, nTop, nLeft, nBottom, nRight, nColor)
// Dibuja línea separadora entre datos
FillRect( oWnd:hDC, { nTop, nLeft, nBottom, nRight },;
CreatePen( 0, 1, nColor ) )
Return Nil // Add By Antonio Castro 22/03/08
//------------------------------------------------------------------------------------------//
//-----------------------------------------------------------------------------------------//
// Application..: Clase TDiskInfo - Información acerca de unidades de disco. //
// File Name....: TDiskInfo.PRG //
// Author...... : Antonio Castro, Maracaibo - Venezuela. //
// Date Created : ENE - 2003 ©. //
// Date Modified: MAR - 2008 ©. //
// Copyright....: Antonio Castro //
// Email........: <!-- e --><a href="mailto:ant_cas@yahoo.com">ant_cas@yahoo.com</a><!-- e --> //
//-----------------------------------------------------------------------------------------//
/* This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this software; see the file COPYING. If not, write to
the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
Boston, MA 02111-1307 USA (or visit the web site <!-- m --><a class="postlink" href="http://www.gnu.org/">http://www.gnu.org/</a><!-- m -->).
*** Esta es mi primera clase y espero le sirva a cualquier usuario de
FiveWin + Harbour.
*** Estoy a sus ordenes para cualquier consulta y/o comentario.*/
//-----------------------------------------------------------------------------------------//
//----------------------------------------------------------------------------//
// MODIFICACIONES Y AGREGADOS - CLASE TDiskInfo //
//----------------------------------------------------------------------------//
//
// By Antonio Castro 26/03/08 - TDiskInfo 2.1
// - Ahora se puede verificar directamente recursos de red UNC \\SERVIDOR\RECURSO
// y obtener toda la información del recurso al igual que con las unidades A-Z
//
// - Se verificó compratibilidad con Vista
//
//----------------------------------------------------------------------------//
//
// By Antonio Castro 22/03/08 - TDiskInfo 2.0
// - Ahora detecta si una unidad extríble es o no USB ( nDiskType := 7 ). ;-))
//
// - Se agregaron las Datas cAuthor y nDiskType
// |-> cAuthor...: Devuelve información del autor de la clase.
// |-> nPFSpace..: Devuelve el porcentaje de espacio libre.
// |-> nPUSpace..: Devuelve el porcentaje de espacio usado.
// |-> nDiskType.: Devuelve el número de disco actual del Api.
// |-> nFClusters: Devuelve el número de Cluster libres
// |-> nUClusters: Devuelve el número de Cluster usados
// |-> nTClusters: Devuelve el número de total de Cluster
//
// - Se pasaron a C las funciones GETDRIVETYPE, GETDISKFREESPACE y
// GETVOLUMEINFORMATION, Muchas gracias a Antonio Linares por
// toda la ayuda prestada para convertir en C esta funciones.
//
// - Se agregó la Función fPicture( nValue ) la cual devuelve una cadena
// formateada según el DEFINE cPicture y cPictInt
// |-> cPicture: Muestra números con formato decimal
// |-> cPictInt: Muestra números sin formato decimal
//
// - Se optimizó el código de la clase y varias funciones
//
//----------------------------------------------------------------------------//
//
// By Antonio Castro 01/08 - TDiskInfo 1.0 Creación de clase
//
//-----------------------------------------------------------------------------------------//
CLASS TDiskInfo
DATA lResourceUNC AS LOGICAL INIT .F. READONLY // Add By Antonio Castro 26/03/08
DATA nPFSpace AS NUMERIC INIT 0 READONLY // Add By Antonio Castro 22/03/08
DATA nPUSpace AS NUMERIC INIT 0 READONLY // Add By Antonio Castro 22/03/08
DATA nDiskType AS NUMERIC INIT 0 READONLY // Add By Antonio Castro 22/03/08
DATA nFClusters AS NUMERIC INIT 0 READONLY // Add By Antonio Castro 22/03/08
DATA nUClusters AS NUMERIC INIT 0 READONLY // Add By Antonio Castro 22/03/08
DATA nTClusters AS NUMERIC INIT 0 READONLY // Add By Antonio Castro 22/03/08
DATA nBPSectors AS NUMERIC INIT 0 READONLY // Update By Antonio Castro 22/03/08
DATA nSPClusters AS NUMERIC INIT 0 READONLY // Update By Antonio Castro 22/03/08
DATA nTotalSpace AS NUMERIC INIT 0 READONLY // Update By Antonio Castro 22/03/08
DATA nUsedSpace AS NUMERIC INIT 0 READONLY
DATA nFreeSpace AS NUMERIC INIT 0 READONLY
DATA cLabel AS CHARACTER INIT "" READONLY
DATA cDrive AS CHARACTER INIT "" READONLY
DATA cNumSerie AS CHARACTER INIT "" READONLY
DATA cDriveType AS CHARACTER INIT "" READONLY
DATA cFileSystem AS CHARACTER INIT "" READONLY
DATA cAuthor AS CHARACTER INIT ; // Add By Antonio Castro 22/03/08
"By Antonio Castro, Maracaibo - Venezuela" + CRLF +;
"For FiveWin + [x]Harbour. The Class is Free" + CRLF +;
Space(10) + "email: ant_cas@yahoo.com" ;
READONLY
METHOD New( cDrive ) CONSTRUCTOR
METHOD Default() // Default
METHOD TDIVer() INLINE cTDiskInfoVer // Update By Antonio Castro 22/03/08
METHOD Drive( cNewDrive ) // Drive
METHOD Label() INLINE ::cLabel // Label
METHOD DriveType() INLINE ::cDriveType // Drive Type
METHOD NumSerie() INLINE ::cNumSerie // Num Serie - Type DOS
METHOD FileSystem() INLINE ::cFileSystem // File System - Update By Antonio Castro
METHOD BPSectors() INLINE fFormat( ::nBPSectors ) // Bytes by Sectors
METHOD SPClusters() INLINE fFormat( ::nSPClusters ) // Sectors by Cluster
METHOD FreeClusters() INLINE fFormat( ::nFClusters ) // Cluster Free
METHOD UsedClusters() INLINE fFormat( ::nUClusters ) // Cluster Used
METHOD TotalClusters() INLINE fFormat( ::nTClusters ) // Cluster Total
METHOD UsedSpace() INLINE fFormat( ::nUsedSpace ) // Used Space
METHOD FreeSpace() INLINE fFormat( ::nFreeSpace ) // Free Space
METHOD TotalSpace() INLINE fFormat( ::nTotalSpace ) // Total Space
METHOD SUSpace() INLINE fFormat( ::nUsedSpace, .T. ) // Short Use Space
METHOD SFSpace() INLINE fFormat( ::nFreeSpace, .T. ) // Short Free Space
METHOD STSpace() INLINE fFormat( ::nTotalSpace, .T. ) // Short Total Space
METHOD PFSpace() INLINE fPicture( ::nPFSpace ) + "%" // Porcent Free Space
METHOD PUSpace() INLINE fPicture( ::nPUSpace ) + "%" // Porcent Used Space
ENDCLASS
//----------------------------------------------------------------------------//
// METHOD TDiskInfo:New | Versión 2.0 MAR - 2008 //
//----------------------------------------------------------------------------//
METHOD New( cDrive ) CLASS TDiskInfo // New
Default cDrive := "C:\"
::Default( cDrive )
Return Self
//----------------------------------------------------------------------------//
// METHOD TDiskInfo:Default() | Versión 2.0 MAR - 2008 //
//----------------------------------------------------------------------------//
METHOD Default( cDrive ) CLASS TDiskInfo
Local cLabel, nSerial, cFileSystem
Local nSPClusters, nBPSectors, nFClusters, nTClusters
Local acDrive := { "No Instalado",;
"Disco Extraíble",;
"Disco Local" ,;
"Disco de Red",;
"Unidad de CD/DVD",;
"Disco Virtual",;
"Unidad USB",;
"Recurso de Red"} // Add By Antonio Castro 22/03/08
// Valores agregados no devueltos por el API
// 7 = "Unidad USB" y 8 = "Recurso de Red"
// Se utiliza cDrive para pasar por referencia a la funciónes
cDrive := Upper( AllTrim( cDrive ) )
// Verifica si es un recurso o una unidad de red
If Left( cDrive, 2 ) == "\\" // Add By Antonio Castro 26/03/08
::lResourceUNC := .T. // Recurso de Red tipo UNC \\SERVIDOR\RECURSO
ElseIf Asc ( Left( cDrive, 1 ) ) >= 65 .And.; // A Mayúscula
Asc ( Left( cDrive, 1 ) ) <= 90 // Z Mayúscula
cDrive := Left( cDrive, 1 ) + ":\"
/*Else
MsgInfo( "Parámetro incorrecto en cDrive" + CRLF + CRLF +;
cDrive, "Mensaje de TDiskInfo" )
Return Nil*/
EndIf // Add By Antonio Castro 26/03/08
::cDrive := cDrive
// Verifica si es un Recurso de Red tipo UNC \\SERVIDOR\RECURSO
If ::lResourceUNC // Add By Antonio Castro 26/03/08
::nDiskType := 8 // Nuevo tipo agregado que no devuelve el API ;-))
cDrive := cDrive + "\" // Termina en \ si es un recurso UNC \\SERVIDOR\RECURSO\
// esto es para que trabajen las funciones del API
Else
::nDiskType := GETDRIVETYPE( cDrive ) // Update By Antonio Castro 22/03/08
EndIf // Add By Antonio Castro 26/03/08
If ::nDiskType = 1 // Drive No Instalado
::cDriveType := acDrive[ ::nDiskType ]
::cLabel := "No disponible" // Update By Antonio Castro 22/03/08
::cFileSystem := "Desconocido" // Update By Antonio Castro 22/03/08
::cNumSerie := "Desconocido" // Update By Antonio Castro 22/03/08
Else
cLabel := Space(256) // Update By Antonio Castro 22/03/08
cFileSystem := Space(256) // Update By Antonio Castro 22/03/08
// Update By Antonio Castro 22/03/08
GETDISKFREESPACE( cDrive, @nSPClusters, @nBPSectors,;
@nFClusters, @nTClusters )
GETVOLUMEINFORMATION( cDrive, @cLabel, 256, @nSerial,;
0, 0, @cFileSystem, 256 )
::cLabel := StrToken( cLabel , 1, Chr( 255 ) )
::cLabel := If( Empty( ::cLabel ), "No asignada", ::cLabel ) // Add By Antonio Castro 22/03/08
::cFileSystem := StrToken( cFileSystem, 1, Chr( 255 ) )
::cFileSystem := If( Empty( ::cFileSystem ), "Desconocido", ::cFileSystem ) // Add By Antonio Castro 22/03/08
::cNumSerie := Left ( L2Hex( nSerial ), 4) + "-" +;
Right( I2Hex( nSerial ), 4 )
::nBPSectors := nBPSectors
::nFClusters := If ( nBPSectors > 0, nFClusters, 0 ) // Add By Antonio Castro 22/03/08
::nTClusters := If ( nBPSectors > 0, nTClusters, 0 ) // Add By Antonio Castro 22/03/08
::nSPClusters := If ( nBPSectors > 0, nSPClusters, 0 ) // Add By Antonio Castro 22/03/08
::nUClusters := ::nTClusters - ::nFClusters
::nTotalSpace := ::nTClusters * ::nSPClusters * ::nBPSectors
::nFreeSpace := ::nSPClusters * ::nFClusters * ::nBPSectors
::nUsedSpace := ::nTotalSpace - ::nFreeSpace
::nPFSpace := Round( ::nFreeSpace * 100 / ::nTotalSpace, 0 )
::nPUSpace := Round( ::nUsedSpace * 100 / ::nTotalSpace, 0 )
// Add By Antonio Castro 22/03/08
// Evalua el total de Cluster para determinar si es o no un Disco USB
If (::nDiskType = 2 .And.; // 2 es un Disco Extraíble
::nTClusters > 2863 ) // 2863 es el total de cluster de un disco 3½ 2.88MB
// o sea que si es mayor a este valor es un disco USB ;-))
::nDiskType := 7 // Nuevo tipo agregado que no devuelve el API ;-))
::cDriveType := acDrive[ ::nDiskType ]
Else
::cDriveType := acDrive[ ::nDiskType ]
EndIf // Add By Antonio Castro 22/03/08
EndIf
Return Self
//----------------------------------------------------------------------------//
// METHOD TDiskInfo:Drive() | Versión 2.0 MAR - 2008 //
//----------------------------------------------------------------------------//
METHOD Drive( cDrive ) CLASS TDiskInfo // Drive SETGET
If !Empty( cDrive )
::Default( cDrive )
EndIf
Return ::cDrive
//----------------------------------------------------------------------------//
//FUNCTION ShortFormat() | Versión 2.0 MAR - 2008 //
//----------------------------------------------------------------------------//
Static Function fFormat( nValue, lShortFormat) // Update By Antonio Castro 22/03/08
Local cTmp := " Bytes", cValue
Local nBT, nKB, nMB, nGB, nTB, nPB
Default lShortFormat := .F.
nBT := 1024
nKB := nBT * nBT
nMB := nKB * nBT
nGB := nMB * nBT
nTB := nGB * nBT
nPB := nTB * nBT
If lShortFormat
Do Case
Case nValue < nKB
cTmp := " Bytes"
Case nValue > nBT .And. nValue < nKB
cTmp := " KB"
nValue := nValue / nBT
Case nValue > nKB .And. nValue < nMB
cTmp := " MB"
nValue := nValue / nKB
Case nValue > nMB .And. nValue < nGB
cTmp := " GB"
nValue := nValue / nMB
Case nValue > nGB .And. nValue < nTB
cTmp := " TB"
nValue := nValue / nGB
Case nValue > nTB .And. nValue < nPB
cTmp := " PB"
nValue := nValue / nTB
OtherWise
cTmp := " N/D"
nValue := nValue / ( nPB * nPB )
EndCase
EndIf
Return fPicture( nValue ) + cTmp
//----------------------------------------------------------------------------//
//FUNCTION fPicture() | Versión 2.0 MAR - 2008 //
//----------------------------------------------------------------------------//
Static Function fPicture( nValue ) // ADD By Antonio Castro 22/03/08
Local cValue
If "." $ Str( nValue ) // Verifica si el número tienes decimales
cValue := LTrim( Transform( nValue, cPicture ) )
Else
cValue := LTrim( Transform( nValue, cPictInt ) )
EndIf
Return cValue
//----------------------------------------------------------------------------//
// **************** DECLARACIONES - API DIRECTAMENTE DESDE C ***************//
//----------------------------------------------------------------------------//
// Muchas gracias a Antonio Linares por la ayuda prestada para convertir en C
// esta funciones. Mil gracias
#pragma BEGINDUMP
#include <Windows.h>
#include <HBApi.h>
//----------------------------------------------------------------------------//
//FUNCTION GETDRIVETYPE() | Versión 2.0 MAR - 2008 //
//----------------------------------------------------------------------------//
HB_FUNC( GETDRIVETYPE )
{
hb_retnl( GetDriveType( hb_parc( 1 ) ) );
}
//----------------------------------------------------------------------------//
//FUNCTION GETDISKFREESPACE() | Versión 2.0 MAR - 2008 //
//----------------------------------------------------------------------------//
HB_FUNC( GETDISKFREESPACE )
{
LPSTR lpRootPathName = ( char * )hb_parc( 1 );
DWORD lpSectorsPerCluster;
DWORD lpBytesPerSector;
DWORD lpNumberOfFreeClusters;
DWORD lpTtoalNumberOfClusters;
hb_retnl( GetDiskFreeSpace( lpRootPathName, &lpSectorsPerCluster,
&lpBytesPerSector, &lpNumberOfFreeClusters,
&lpTtoalNumberOfClusters ) );
hb_stornl( lpSectorsPerCluster, 2 );
hb_stornl( lpBytesPerSector, 3 );
hb_stornl( lpNumberOfFreeClusters, 4 );
hb_stornl( lpTtoalNumberOfClusters, 5 );
}
//----------------------------------------------------------------------------//
//FUNCTION GETVOLUMEINFORMATION() | Versión 2.0 MAR - 2008 //
//----------------------------------------------------------------------------//
HB_FUNC( GETVOLUMEINFORMATION )
{
LPSTR lpRootPathName = ( char * )hb_parc( 1 );
BYTE lpVolumeNameBuffer[ 256 ];
DWORD lpVolumeSerialNumber;
BYTE lpFileSystemNameBuffer[ 256 ];
hb_retnl( GetVolumeInformation( lpRootPathName,
( char * ) lpVolumeNameBuffer,
sizeof( lpVolumeNameBuffer ),
&lpVolumeSerialNumber, 0, 0,
( char * ) lpFileSystemNameBuffer,
sizeof( lpFileSystemNameBuffer ) ) );
hb_storc( lpVolumeNameBuffer, 2 );
hb_storc( lpFileSystemNameBuffer, 7 );
hb_stornl( lpVolumeSerialNumber, 4 );
}
static double IntToDbl( LONG lowpart, LONG highpart )
{
double value = highpart;
if( highpart < 0 )
value = value + ( 2 ^ 32 );
value = value * ( 2 ^ 32 );
value = value + lowpart;
if( lowpart < 0 )
value = value + ( 2 ^ 32 );
return value;
}
HB_FUNC( GETDISKFREESPACEEX )
{
ULARGE_INTEGER FreeBytesAvailable, TotalNumberOfBytes, TotalNumberOfFreeBytes;
GetDiskFreeSpaceEx( ( char * ) hb_parc( 1 ), &FreeBytesAvailable, &TotalNumberOfBytes, &TotalNumberOfFreeBytes );
hb_reta( 3 );
hb_storvnd( IntToDbl( FreeBytesAvailable.LowPart, FreeBytesAvailable.HighPart ), -1, 1 );
hb_storvnd( IntToDbl( TotalNumberOfBytes.LowPart, TotalNumberOfBytes.HighPart ), -1, 2 );
hb_storvnd( IntToDbl( TotalNumberOfFreeBytes.LowPart, TotalNumberOfFreeBytes.HighPart ), -1, 3 );
}
#pragma ENDDUMPREDEFINE GRAPH aoGraph[ 1 ] ID 301 OF oDlg TYPE GRAPH_TYPE_PIE XVALUES YVALUES XGRID YGRID LEGENDS 3D