'Código para el Modulo
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'lpBuffer = Area intermedia donde se cargará el nombre del usuario
'nsize = Longitud real del nombre del ordenador

'Código para el Procedimiento
'Definimos las variables
Dim Texto As String * 255
Dim Longitud As Long
Dim CadenaResultante As Long

'Inicializamos las variables
Longitud = Len(Texto)

CadenaResultante = GetUserName(Texto, Longitud)
'CadenaResultante = Devuelve cero en caso de error.

'mostramos el resultado
NombreUsuario.Caption = Left(Texto, Longitud)

'Código para el Modulo
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'lpBuffer = Area intermedia donde se cargará el nombre del ordenador
'nsize = Longitud real del nombre del ordenador

'Código para el Procedimiento
'Definimos las variables
Dim Texto As String * 255
Dim Longitud As Long
Dim CadenaResultante As Long

'Inicializamos las variables
Longitud = Len(Texto)

CadenaResultante = GetComputerName(Texto, Longitud)
'CadenaResultante = Devuelve cero en caso de error.

'mostramos el resultado
NombreComputador.Caption = Left(Texto, Longitud)

'Código para el Modulo
Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long
'lpRootPathName = Unidad del disco.
LpSectorsPerCluster = Devuelve en numero de sectores por cluster.
lpButesPerSector = Devuelve el numero de bites de un sector.
lpNumberOfFreeClusters = Devuelve el numero de clusters libres en disco.
LpTotalNumberOfClusters = Devuelve el numero de clusters del disco.

'Código para el Procedimiento
'Definimos las variables
Dim Texto As String * 255
Dim SecPorClau As Long
Dim BitsPorSec As Long
Dim NumFreeClusters As Long
Dim TotalNumClusters As Long
Dim CadenaResultante As Long

'Inicializamos las variables
SecPorClau = Len(Texto)
BitsPorSec = Len(Texto)
NumFreeClusters = Len(Texto)
TotalNumClusters = Len(Texto)
'Indicamos la unidad a revisar
Texto = "c:\" & Chr(0)

CadenaResultante = GetDiskFreeSpace(Texto, SecPorClau, BitsPorSec, NumFreeClusters, TotalNumClusters)
'CadenaResultante = Devuelve cero en caso de error.

'mostramos el resultado
'Numero de sectores por cluster
SectoresPorCluster.Caption = SecPorClau
'Bits por sector
BitsPorSector.Caption = BitsPorSec
'Numero de clusters vacios
NumeroClustersVacios.Caption = Format(NumFreeClusters, "#,##0")
'Numero total de clusters del disco
TotalNumeroClusters.Caption = Format(TotalNumClusters, "#,##0")
'Espacio disponible en disco
EspacioDisponible.Caption = Format(SecPorClau * NumFreeClusters * BitsPorSec, "#,##0")
'Espacio utilizado en disco
EspacioUtilizado.Caption = Format((TotalNumClusters - NumFreeClusters) * SecPorClau * BitsPorSec, "#,##0")

'Código para el Modulo
Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" (ByVal lpRootPathName As String, lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As Currency, lpTotalNumberOfFreeBytes As Currency) As Long

'Código para el Procedimiento
'Definimos las variables
Dim CadenaResultante As Long
Dim Disco As String
Dim lpFreeBytesAvailableToCaller As Currency
Dim TotalEspacioDisco As Currency
Dim TotalEspacioLibreDisco As Currency

'Inicializamos las variables
Disco = "c:\" & Chr(0)

CadenaResultante = GetDiskFreeSpaceEx(Disco, lpFreeBytesAvailableToCaller, TotalEspacioDisco, TotalEspacioLibreDisco)
'CadenaResultante = Devuelve cero en caso de error.

'mostramos el resultado
Print "Espacio total del disco : " & Format(TotalEspacioDisco * 10000, "###,###,###")
Print "Espacio libre en disco : " & Format(TotalEspacioLibreDisco * 10000, "###,###,###")
Print "Espacio utilizado : " & Format((TotalEspacioDisco - TotalEspacioLibreDisco) * 10000, "###,###,###")

'Código para el Modulo
Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
'lpRootPathName = Unidad del disco.
'lpVolumeNameBuffer = Devuelve el nombre del volumen.
'nVolumeSerialNumber = Longitud de la cadena lpVolumeNameBuffer.
'lpVolumeSerialNumber = Devuelve el numero de serie del volumen.
'lpMaximumComponentLength = Devuelve la longitud máxima para un nombre de archivo o directorio.
'lpFileSystemFlags = Devuelve información sobre el disco como compresiones, Mayusculas en los archivos, etc.
'LpFileSystemNameBuffer = Devuelve el sistema de Archivos (FAT, NTFS, etc.)
'NFileSystemNameSize = Longitud de la cadena LpFileSystemNameBuffer.

'Código para el Procedimiento
'Definimos las variables
Dim i As Integer
Dim NumeroDisco As Long
Dim CadenaResultante As Long
Dim NombreDisco As String
Dim FormatoDisco As String
Dim Unidad As String
Dim LongitudNombreProgramaMasLargo As Long
Dim Flags As Long

'Inicializamos las variables
Unidad = "c:\"
NombreDisco = String(255, Chr(0))
FormatoDisco = String(255, Chr(0))

CadenaResultante = GetVolumeInformation(Unidad, NombreDisco, Len(NombreDisco), NumeroDisco, LongitudNombreProgramaMasLargo, Flags, FormatoDisco, Len(FormatoDisco))
'CadenaResultante = Devuelve cero en caso de error.

'mostramos el resultado
i = InStr(NombreDisco, Chr(0))
NombreDisco = Mid(NombreDisco, 1, i - 1)
i = InStr(FormatoDisco, Chr(0))
FormatoDisco = Mid(FormatoDisco, 1, i - 1)
Print NombreDisco
Print FormatoDisco
Print Hex(NumeroDisco)
Print LongitudNombreProgramaMasLargo

'Código para el Modulo
Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
'nBufferLength = Longitud de lpBuffer.
'lpBuffer = Devuelve el nombre las unidades separadas por chr(0).

'Código para el Procedimiento
'Definimos las variables
Dim Texto As String * 255
Dim Longitud As Long
Dim CadenaResultante As Long
Dim i as integer

'Inicializamos las variables
Longitud = Len(Texto)

CadenaResultante = GetLogicalDriveStrings(Longitud, Texto)
'CadenaResultante = Devuelve el numero de unidades. Cero en caso de error.

'mostramos el resultado
For i = 1 To CadenaResultante Step 4
   Print Mid(Texto, i, 3)
Next i

'Código para el Modulo
Declare Sub GetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)

Type SYSTEMTIME
   wYear As Integer
   wMonth As Integer
   wDayOfWeek As Integer
   wDay As Integer
   wHour As Integer
   wMinute As Integer
   wSecond As Integer
   wMilliseconds As Integer
End Type

Global DatosFechaSistema As SYSTEMTIME

'Código para el Procedimiento
Call GetLocalTime(FechaSistema)

'mostramos el resultado
Print DatosFechaSistema.wDay 'Dia
Print DatosFechaSistema.wMonth 'Mes
Print DatosFechaSistema.wYear 'Año
Print DatosFechaSistema.wDayOfWeek 'Dia de la Semana (0-Domingo, 6-Sabado)
Print DatosFechaSistema.wHour 'Hora
Print DatosFechaSistema.wMinute 'Minutos
Print DatosFechaSistema.wSecond 'Segundos
Print DatosFechaSistema.wMilliseconds 'Milisegundos

'Código para el Modulo
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long

Type POINTAPI
   x As Long
   y As Long
End Type

Global PosicionCursor As POINTAPI

'Código para el Procedimiento
'Definimos las variables
Dim CadenaResultante As Long

CadenaResultante = GetCursorPos(PosicionCursor)
'CadenaResultante = Devuelve cero en caso de error.

'mostramos el resultado
Print PosicionCursor.x 'Posición Horizontal
Print PosicionCursor.y 'Posición Vertical

'Colocamos el cursor en la posicion 100,100 de la pantalla
Call SetCursorPos(100, 100)

'Código para el Modulo
Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Public Const Disco_CD = 5
Public Const Disco_Fijo = 3
Public Const Disco_Ram = 6
Public Const Disco_Remoto = 4
Public Const Disco_Removible = 2

'Código para el Procedimiento
'Definimos las variables
Dim Disco As String
Dim CadenaResultante As Long
Dim Informacion As String

'Inicializamos las variables
Disco = "c:\"

CadenaResultante = GetDriveType(Disco)
'CadenaResultante = Cero si no se pudo identificar el dispositivo. Uno si el directorio especificado no existe.

'mostramos el resultado
'Segun el numero devuelto por la función, podremos saber que tipo de unidad se trata
Select Case CadenaResultante
   Case Disco_Removible
      Informacion = "Unidad removible"
   Case Disco_Fijo
      Informacion = "Disco Fijo"
   Case Disco_Remoto
      Informacion = "Unidad Remota"
   Case Disco_CD
      Informacion = "Unidad CD"
   Case Disco_Ram
      Informacion = "Unidad Ram"
   Case Else
      Informacion = "Unidad Desconocida"
End Select
Print Informacion

'Código para el Modulo
Public Const HWND_BOTTOM = 1 'Coloca la venta al final de la lista
Public Const HWND_TOP = 0 'Coloca la ventana al inicio del orden
Public Const HWND_TOPMOST = -1 'Coloca la ventana al inicio del orden por encima de todo
Public Const HWND_NOTOPMOST = -2 'Coloca la ventana al inicio del orden detras de las ventanas de nivel superior

Public Const SWP_HIDEWINDOW = &H80 'Esconde la ventana
Public Const SWP_NOACTIVATE = &H10 'No activa la ventana
Public Const SWP_NOMOVE = &H2 'Mantiene la posición Actual
Public Const SWP_NOREDRAW = &H8 'La ventana No se redibuja automáticamente
Public Const SWP_NOSIZE = &H1 'Mantiene el tamaño vigente
Public Const SWP_NOZORDER = &H4 'Mantiene la posición vigente en la lista de ventanas
Public Const SWP_SHOWWINDOW = &H40 'Presenta en pantalla la ventana

'Para mantenerlo siempre visible, podeis utilizar estas opciones
Public Const SWP_FLAGS = SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW Or SWP_NOACTIVATE

Declare Function SetWindowPos Lib "User32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

'Código para el evento 'Load' del Formulario
'Definimos la variable
Dim CadenaResultante As Long

CadenaResultante = SetWindowPos(hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_FLAGS)
'CadenaResultante = Devuelve cero en caso de error.

'NOTA: Para finalizar la posición de siempre visible, cambiar HWND_TOPMOST por HWND_NOTOPMOST

'Código para el Modulo
Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)

Type MEMORYSTATUS
   dwLength As Long
   dwMemoryLoad As Long 'porcentaje de memoria en Uso
   dwTotalPhys As Long 'Total Bytes de memoria física
   dwAvailPhys As Long 'Memoria física libre en bytes
   dwTotalPageFile As Long
   dwAvailPageFile As Long
   dwTotalVirtual As Long
   dwAvailVirtual As Long
End Type

Global Memoria As MEMORYSTATUS

'Código para el procedimiento
Memoria.dwLength = Len(Memoria)

GlobalMemoryStatus Memoria

'mostramos el resultado
Print "Memoria fisica total : " & Format(Memoria.dwTotalPhys, "#,##0")
Print "Memoria fisica disponible : " & Format(Memoria.dwAvailPhys, "#,##0")
Print "Porcentaje de Memoria Utilzada : " & Memoria.dwMemoryLoad & "%"
Print "Porcentaje de Memoria Disponible : " & 100 - Memoria.dwMemoryLoad & "%"

'Código para el Modulo
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

'Código para el procedimiento
'Definimos las variables
Dim CadenaResultante As Long

'Abre un nuevo correo electronico
CadenaResultante = ShellExecute(hwnd, "open", "mailto:[email protected]?subject=API's para Visual Basic", "", "", 1)

'Abre una página Web en el navegador por defecto del sistema
CadenaResultante = ShellExecute(hwnd, "open", "http://www.lawebdelprogramador.com", "", "", 1)

'Abre una hoja de calculo, en este caso del Excel de Microsoft
CadenaResultante = ShellExecute(hwnd, "open", "nombre_directorio.xls", "", "", 1)

'Código para el Modulo
Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128
End Type

Public Const PLATAFORMA_WIN32_NT& = 2
Public Const PLATAFORMA_WIN32_WINDOWS& = 1

'Código para el procedimiento
'Definimos las variables
Dim Version As OSVERSIONINFO
Dim CadenaResultante As Long
Dim x As Long

Version.dwOSVersionInfoSize = Len(Version)

CadenaResultante = GetVersionEx(Version)

'mostramos el resultado
If Version.dwPlatformId = PLATAFORMA_WIN32_NT Then Print "Windows NT"
If Version.dwPlatformId = PLATAFORMA_WIN32_WINDOWS Then Print "Windows 95/98"
x = InStr(Version.szCSDVersion, Chr(0))
Print Version.dwMajorVersion & "." & Version.dwMinorVersion & Left(Version.szCSDVersion, x - 1)

'Código para el Modulo
Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long

Public Const SPI_SETDESKWALLPAPER = 20
Public Const SPIF_UPDATEINIFILE = &H1

'Código para el procedimiento
'Cambiar "nombre_ubicacion", por la direccion y nomre del archivo de imagen a utilizar.
SystemParametersInfo SPI_SETDESKWALLPAPER, 0, ByVal "nombre_ubicacion", SPIF_UPDATEINIFILE

'Código para el Modulo
Type SHFILEOPSTRUCT
   hwnd As Long
   wFunc As Long
   pFrom As String
   pTo As String
   fFlags As Integer
   fAnyOperationsAborted As Long
   hNameMappings As Long
   lpszProgressTitle As Long ' only used if FOF_SIMPLEPROGRESS
End Type

Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Public Const FO_DELETE = &H3
Public Const FOF_ALLOWUNDO = &H40

'Código para el procedimiento
'Definimos las variables
Dim SHFO As SHFILEOPSTRUCT
Dim CadenaResultante As Long

'Inicializamos las variables
With SHFO
   .wFunc = FO_DELETE
   .pFrom = "archivo_directorio"
   .fFlags = FOF_ALLOWUNDO
End With

CadenaResultante = SHFileOperation(SHFO)

'Código para el Modulo
Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

'Código para el procedimiento
'Definimos las variables
Dim DirectorioWindows As String * 255
Dim CadenaResultante As Long

CadenaResultante = GetWindowsDirectory(DirectorioWindows, 255)

'mostramos el resultado
Print Left(DirectorioWindows, CadenaResultante)

'Código para el Modulo
Declare Function GetSystemDirectory Lib "kernel32.dll" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

'Código para el procedimiento
'Definimos las variables
Dim DirectorioSystem As String * 255
Dim CadenaResultante As Long

CadenaResultante = GetSystemDirectory(DirectorioSystem, 255)

'mostramos el resultado
Print Left(DirectorioSystem, CadenaResultante)