Rutinas referentes a obtención de información del equipo' ------------------------------------------------------------------------------------
'
' función para obtener el nombre del usuario actual
'
' devuelve
' ' el nombre del usuario si tuvo éxito
' ' "" si no lo tuvo
' Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Function ObtenerUsuario() As String
'Esta función devuelve el nombre del Usuario
Dim sBuffer As String
Dim lSize As Long
Dim sUsuario As String
sBuffer = Space$(260)
lSize = Len(sBuffer)
Call GetUserName(sBuffer, lSize)
If lSize > 0 Then
sUsuario = Left$(sBuffer, lSize)
'Quitarle el CHR$(0) del final...
lSize = InStr(sUsuario, Chr$(0))
If lSize Then
sUsuario = Left$(sUsuario, lSize - 1)
End If
Else
sUsuario = ""
End If
ObtenerUsuario = sUsuario
End Function
Obtener nombre del equipo' -----------------------------------------------------------------------------
' función para obtener el nombre completo del equipo
'
' devuelve :
' ' el nombre del equipo si tuvo éxito
' ' "" si no lo tuvo
'
' Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, _
nSize As Long) As Long
Public Function ObtenerNombreEquipo() As String
Dim sBuffer As String, lSize As Long, Resultado As Long
Const MAX_COMPUTERNAME_LENGTH As Long = 31 'longitud máxima del nombre de un equipo
sBuffer = String(MAX_COMPUTERNAME_LENGTH + 1, vbNullChar)
lSize = MAX_COMPUTERNAME_LENGTH
Resultado = GetComputerName(sBuffer, lSize)
ObtenerNombreEquipo = IIf(Resultado, Left(sBuffer, lSize), "")
End Function
Obtener el path del directorio system' ------------------------------------------------------------------------------------------------------
' función para obtener el path de system
'
' Declare Function GetSystemDirectory Lib "kernel32.dll" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Function ObtenerSystem() As String
Dim DirectorioSystem As String * 255
Dim CadenaResultante As Long
CadenaResultante = GetSystemDirectory(DirectorioSystem, 255)
ObtenerSystem = Left(DirectorioSystem, CadenaResultante)
End Function
Obtener el path de archivos temporales' -------------------------------------------------------------------------------
'
' función para obtener el path de archivos temporales
'
Public Function ObtenerTemp() As String
Dim Buffer As String, Size As Long
Const MAX_PATH = 260
' Inicializamos la cadena donde se cargará la trayectoria
Buffer = String(MAX_PATH, 0)
' Recuperamos la trayectoria
Size = GetTempPath(Len(Buffer) - 1, Buffer)
If Size <> 0 Then
GetTempFolder = Left(Buffer, Size)
End If
End Function
Funciones para obtener trayecto de carpetas especiales' -------------------------------------------------------------------------------
'
' función para obtener el trayecto de carpetas especiales del usuario 'menu inicio','favoritos, 'escritorio'
' 'archivos de programa'
'
'Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hWnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
'Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
'Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Const CSIDL_DESKTOP = &H0
Const CSIDL_PROGRAMS = &H2
Const CSIDL_CONTROLS = &H3
Const CSIDL_PRINTERS = &H4
Const CSIDL_PERSONAL = &H5
Const CSIDL_FAVORITES = &H6
Const CSIDL_STARTUP = &H7
Const CSIDL_RECENT = &H8
Const CSIDL_SENDTO = &H9
Const CSIDL_BITBUCKET = &HA
Const CSIDL_STARTMENU = &HB
Const CSIDL_DESKTOPDIRECTORY = &H10
Const CSIDL_DRIVES = &H11
Const CSIDL_NETWORK = &H12
Const CSIDL_NETHOOD = &H13
Const CSIDL_FONTS = &H14
Const CSIDL_TEMPLATES = &H15
Const MAX_PATH = 260
Public Function ObtenerMenuUsuario() As String
ObtenerMenuUsuario = GetSpecialfolder(CSIDL_STARTMENU)
End Function
Public Function ObtenerFavoritos() As String
ObtenerFavoritos = GetSpecialfolder(CSIDL_FAVORITES)
End Function
Public Function ObtenerMenuProgramas() As String
ObtenerMenuProgramas = GetSpecialfolder(CSIDL_PROGRAMS)
End Function
Public Function ObtenerEscritorio() As String
ObtenerEscritorio = GetSpecialfolder(CSIDL_DESKTOP)
End Function
Autor
En línea
