Crear archivo en el Desktop
Que tal Experto , Saludos desde Mexico, mi problema es el siguiente, tengo una DLL hecha en Visual 4 ya le migre toda su funcionalidad para que trabaje en Win95, 98 , 2000 y Xp excepto un detalle , recuerdas que en Win95 y 98 el escritorio estaba en la ruta c:\windows\escritorio\ o c:\windows\desktop\ , lo que hace esta DLL es que escribe un archivo de texto ahi en esa ruta , pero el problema que tengo ahorita es para las versiones de Windows 2000 y Xp , ya que la ruta cambia a Documents and Settings\USERNAME\ , como podre obtener el Username firmado para crear la ruta o como podre escribir este archivo en el escritorio directamente, espero me puedas ayudar, gracias de antemano.
1 Respuesta
Respuesta de rodolfo1245
1
'La función sería esta y CSIDL determina el Folder especial a buscar
Const CSIDL_DESKTOP = &H0
Const MAX_PATH = 260
Private Type SHITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
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
Private Sub Form_Load()
Me.AutoRedraw = True
Me.Print "Desktop folder: " + GetSpecialfolder(CSIDL_DESKTOP)
End Sub
Private Function GetSpecialfolder(lPath As Long) As String
Dim r As Long
Dim IDL As ITEMIDLIST
r = SHGetSpecialFolderLocation(100, lPath, IDL)
If r = NOERROR Then
Path$ = Space$(512)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
'Se remueve el chr$(0)
GetSpecialfolder = Left$(Path, InStr(Path, Chr$(0)) - 1)
Exit Function
End If
GetSpecialfolder = ""
End Function
Const CSIDL_DESKTOP = &H0
Const MAX_PATH = 260
Private Type SHITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
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
Private Sub Form_Load()
Me.AutoRedraw = True
Me.Print "Desktop folder: " + GetSpecialfolder(CSIDL_DESKTOP)
End Sub
Private Function GetSpecialfolder(lPath As Long) As String
Dim r As Long
Dim IDL As ITEMIDLIST
r = SHGetSpecialFolderLocation(100, lPath, IDL)
If r = NOERROR Then
Path$ = Space$(512)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
'Se remueve el chr$(0)
GetSpecialfolder = Left$(Path, InStr(Path, Chr$(0)) - 1)
Exit Function
End If
GetSpecialfolder = ""
End Function
Ya lo resolvi ayer "Experto" dejame te cuento como ,fue con una que otra API.
Ahi va:
Use las siguientes funciones y declaraciones de API
Public Type OSVERSIONINFO 'for GetVersionEx API call
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Declare Function GetVersionEx Lib "Kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Public Declare Function GetWindowsDirectory Lib "Kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Luego detecté donde esta el directorio , donde se instalo Windows con esta funcioncita, usando una de las API's:
Public Function ObtenDiscoRaiz() As String
Dim Path As String, strSave As String
'Crea un buffer
strSave = String(200, Chr$(0))
'Obtiene el directorio de windows y se obtiene el disco duro de instalacion
Path = Left$(strSave, GetWindowsDirectory(strSave, Len(strSave))) + "\REGEdit.exe"
ObtenDiscoRaiz = vbNullString
ObtenDiscoRaiz = Mid(Path, 1, 2)
End Function
Con esta otra funcioncita y con ayuda de los API's encontre el Username:
Public Function ObtenUsername() As String
Dim strUserName As String
'Crea un buffer
strUserName = String(100, Chr$(0))
'Obtiene el username
GetUserName strUserName, 100
strUserName = Left$(strUserName, InStr(strUserName, Chr$(0)) - 1)
ObtenUsername = strUserName
End Function
Despues tuve que investigar estos datos:
'codigos para ajuste de versiones del sistema operativo
' Win 95 Win 98 Win Me Win NT 4 Win 2000 Win XP Win 2003 Server
'PlatformID 1 1 1 2 2 2 2
'Major Version 4 4 4 4 5 5 5
'Minor Version 0 10 90 0 0 1 2
'Build 950* 1111 1998 1381 2195 2600 3790
Para luego identificar la version de windows que se esta usando:
Global Const gc_Win95 As String = "Windows 95"
Global Const gc_Win98 As String = "Windows 98"
Global Const gc_WinMe As String = "Windows Millenium"
Global Const gc_WinNT4 As String = "Windows NT4"
Global Const gc_Win2k As String = "Windows 2000"
Global Const gc_WinXp As String = "Windows Xp"
Global Const gc_Win2k3 As String = "Windows 2003 Server"
Public Function extraeOS() As String
VerSisOP.dwOSVersionInfoSize = Len(VerSisOP)
HSucessOS = GetVersionEx(VerSisOP)
Select Case VerSisOP.dwPlatformId
Case 1
Select Case VerSisOP.dwMinorVersion
Case 0
extraeOS = gc_Win95
Case 10
extraeOS = gc_Win98
Case 90
extraeOS = gc_WinMe
Case Else
MsgBox "Esta plataforma no es valida para la operacion", vbError
End Select
Case 2
Select Case VerSisOP.dwMajorVersion
Case 4
extraeOS = gc_WinNT4
Case 5
Select Case VerSisOP.dwMinorVersion
Case 0
extraeOS = gc_Win2k
Case 1
extraeOS = gc_WinXp
Case 2
extraeOS = gc_Win2k3
Case Else
MsgBox "Esta plataforma no es valida para la operacion", vbError
End Select
End Select
End Select
End Function
Finalmente todo esto para este pedacito de codigo:
If ls_OpSys = gc_Win95 Or ls_OpSys = gc_Win98 Or ls_OpSys = gc_WinMe Then
vsPath = ObtenDiscoRaiz & "\windows\escritorio\"
Else
vsPath = ObtenDiscoRaiz & "\Documents and Settings\" & ObtenUsername & "\Escritorio\"
End If
Ahi va:
Use las siguientes funciones y declaraciones de API
Public Type OSVERSIONINFO 'for GetVersionEx API call
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Declare Function GetVersionEx Lib "Kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Public Declare Function GetWindowsDirectory Lib "Kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Luego detecté donde esta el directorio , donde se instalo Windows con esta funcioncita, usando una de las API's:
Public Function ObtenDiscoRaiz() As String
Dim Path As String, strSave As String
'Crea un buffer
strSave = String(200, Chr$(0))
'Obtiene el directorio de windows y se obtiene el disco duro de instalacion
Path = Left$(strSave, GetWindowsDirectory(strSave, Len(strSave))) + "\REGEdit.exe"
ObtenDiscoRaiz = vbNullString
ObtenDiscoRaiz = Mid(Path, 1, 2)
End Function
Con esta otra funcioncita y con ayuda de los API's encontre el Username:
Public Function ObtenUsername() As String
Dim strUserName As String
'Crea un buffer
strUserName = String(100, Chr$(0))
'Obtiene el username
GetUserName strUserName, 100
strUserName = Left$(strUserName, InStr(strUserName, Chr$(0)) - 1)
ObtenUsername = strUserName
End Function
Despues tuve que investigar estos datos:
'codigos para ajuste de versiones del sistema operativo
' Win 95 Win 98 Win Me Win NT 4 Win 2000 Win XP Win 2003 Server
'PlatformID 1 1 1 2 2 2 2
'Major Version 4 4 4 4 5 5 5
'Minor Version 0 10 90 0 0 1 2
'Build 950* 1111 1998 1381 2195 2600 3790
Para luego identificar la version de windows que se esta usando:
Global Const gc_Win95 As String = "Windows 95"
Global Const gc_Win98 As String = "Windows 98"
Global Const gc_WinMe As String = "Windows Millenium"
Global Const gc_WinNT4 As String = "Windows NT4"
Global Const gc_Win2k As String = "Windows 2000"
Global Const gc_WinXp As String = "Windows Xp"
Global Const gc_Win2k3 As String = "Windows 2003 Server"
Public Function extraeOS() As String
VerSisOP.dwOSVersionInfoSize = Len(VerSisOP)
HSucessOS = GetVersionEx(VerSisOP)
Select Case VerSisOP.dwPlatformId
Case 1
Select Case VerSisOP.dwMinorVersion
Case 0
extraeOS = gc_Win95
Case 10
extraeOS = gc_Win98
Case 90
extraeOS = gc_WinMe
Case Else
MsgBox "Esta plataforma no es valida para la operacion", vbError
End Select
Case 2
Select Case VerSisOP.dwMajorVersion
Case 4
extraeOS = gc_WinNT4
Case 5
Select Case VerSisOP.dwMinorVersion
Case 0
extraeOS = gc_Win2k
Case 1
extraeOS = gc_WinXp
Case 2
extraeOS = gc_Win2k3
Case Else
MsgBox "Esta plataforma no es valida para la operacion", vbError
End Select
End Select
End Select
End Function
Finalmente todo esto para este pedacito de codigo:
If ls_OpSys = gc_Win95 Or ls_OpSys = gc_Win98 Or ls_OpSys = gc_WinMe Then
vsPath = ObtenDiscoRaiz & "\windows\escritorio\"
Else
vsPath = ObtenDiscoRaiz & "\Documents and Settings\" & ObtenUsername & "\Escritorio\"
End If
