VBasicFacil

Principal - Enlaces - Codigo - Controles - API


  1. Leer un fichero de texto
  2. Como saber la etiqueta de un disco
  3. Comprobar si existe o no un fichero
  4. Calcular el espacio total y el libre de un disco

1. Leer un fichero de texto

Para leer un fichero de texto desde VBasic, por ejemplo el fichero c:\autoexec.bat crear un formulario con un TextBox (las propiedades multiline = True y ScrollBar = 3 Both).

Option Explicit


Dim Datos As String


Private Sub Form_Load()
    Text1.Text = ""
    Open "C:\AUTOEXEC.BAT" For Input As #1
    While Not EOF(1)
        Line Input #1, Datos
        Text1.Text = Text1.Text & Datos & vbCrLf
    Wend
    Close #1
End Sub

2. Leer la etiqueta de un disco

Crear un formulario con el siguiente código

Option Explicit


Private Sub Form_Load()
    Dim fs, d, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName("d:")))
    s = "Unidad " & d.DriveLetter & ": - " & d.VolumeName
    MsgBox s
End Sub

3. Comprobar si existe un fichero

Para buscar un fichero en un disco crear un formulario con un TextBox, un Label y un CommandButton. introducir en el TextBox el nombre del fichero con el path completo, por ejemplo c:\windows\win.ini

Option Explicit


Private Sub Form_Load()
    Text1.Text = ""
    Label1.Caption = ""
    Command1.Caption = "Buscar Fichero"
End Sub

Private Sub Command1_Click()
    if dir(Text1.Text) = "" then
        Label1.Caption = "Fichero no existe"
    Else
        Label1.Caption = "El fichero existe"
    End If
End Sub

4. Calcular el espacio total y el libre de un disco

Crea un formulario con un TextBox (Multiline=True) y un CommandButton

Option Explicit


Dim Dato As String


Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long

Private Type DISKSPACEINFO
    RootPath As String * 3
    FreeBytes As Long
    TotalBytes As Long
    FreePcnt As Single
    UsedPcnt As Single
End Type

Private CurrentDisk As DISKSPACEINFO

Private Sub Command1_Click()
    Dim X As Long
    Dim Y As String
    X = GetDiskSpace("s:\")
    If X Then
        Dato = CurrentDisk.RootPath
        Text1.Text = Dato & vbCrLf
        Dato = Format$(CurrentDisk.FreeBytes, "###,###,##0")
        Text1.Text = Text1.Text & "Espacio libre : " & Dato & vbCrLf
        Dato = Format$(CurrentDisk.FreePcnt, "Percent")
        Text1.Text = Text1.Text & "Porcentaje libre : " & Dato & vbCrLf
        Dato = Format$(CurrentDisk.TotalBytes, "###,###,##0")
        Text1.Text = Text1.Text & "Capacidad total : " & Dato & vbCrLf
    End If
End Sub

Function GetDiskSpace(sRootPathName As String) As Long
    Dim X As Long
    Dim lSectorsPerCluster As Long, lBytesPerSector As Long
    Dim lNumberOfFreeClusters As Long, lTotalNumberOfClusters As Long

    X = GetDiskFreeSpace(sRootPathName, lSectorsPerCluster, lBytesPerSector, lNumberOfFreeClusters, lTotalNumberOfClusters)
    GetDiskSpace = X

    If X Then
        CurrentDisk.RootPath = sRootPathName
        CurrentDisk.FreeBytes = lBytesPerSector * lSectorsPerCluster * lNumberOfFreeClusters
        CurrentDisk.TotalBytes = lBytesPerSector * lSectorsPerCluster * lTotalNumberOfClusters
        CurrentDisk.FreePcnt = (CurrentDisk.TotalBytes - CurrentDisk.FreeBytes) / CurrentDisk.TotalBytes
        CurrentDisk.UsedPcnt = CurrentDisk.FreeBytes / CurrentDisk.TotalBytes
    Else
        CurrentDisk.RootPath = ""
        CurrentDisk.FreeBytes = 0
        CurrentDisk.TotalBytes = 0
        CurrentDisk.FreePcnt = 0
        CurrentDisk.UsedPcnt = 0
        Exit Function
    End If
End Function


correo-e : vbasicfacil@silared.com
Site : www.vbasicfacil.com