Fernando Cortés Hierro, consultor de ilitia technologies srl, ha publicado un curso para la utilización de Windows Live desde PHP y JSP.
El curso se centra en las APIs de Windows LIVE:
Podéis echarle un vistazo en: Curso de Windows Live APIs
Aquí tenéis el código de un ejemplo para descargar ficheros de Internet, en este caso se baja el fichero Contaplus.zip que esta en la dirección http://descarga.e-mision.net/contaplus.zip y se graba en c:.
Option Explicit Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _ (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _ ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long Public Function DownloadFile(URL As String, LocalFilename As String) As Boolean Dim lngRetVal As Long lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0) If lngRetVal = 0 Then DownloadFile = True End Function Private Sub Form_Load() If DownloadFile("http://descarga.e-mision.net/contaplus.zip", "c:contaplus.zip") Then MsgBox "Descarga completada correctamente", vbInformation Else MsgBox "La descarga no ha sido completada", vbCritical End If End Sub
Si el servidor requiere inicio de sesión, utiliza el formato «http://usuario:contraseña@www…», por ejemplo
DownloadFile("http://usuario:contraseña@descarga.e-mision.net/contaplus.zip", "c:contaplus.zip")
Este código muestra un cuadro de dialogo para poder seleccionar sólo un equipo de la red o para seleccionar una carpeta concreta de un equipo que este conectado a la red.
Para ejecutar este ejemplo debes añadir al nuevo proyecto dos botones (Command1 y Command2) y dos textbox (Text1 y Text2).
Option Explicit On Private Const ERROR_SUCCESS As Long = 0 Private Const MAX_PATH As Long = 260 Private Const CSIDL_NETWORK As Long = &H12 Private Const BIF_RETURNONLYFSDIRS As Long = &H1 Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000 Private Type BROWSEINFO hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _ Alias "SHGetPathFromIDListA" _ (ByVal pidl As Long, _ ByVal pszPath As String) As Long Private Declare Function SHBrowseForFolder Lib "shell32.dll" _ Alias "SHBrowseForFolderA" _ (ByVal lpBrowseInfo As BROWSEINFO) As Long Private Declare Function SHGetSpecialFolderLocation _ Lib "shell32.dll" _ (ByVal hwndOwner As Long, _ ByVal nFolder As Long, _ ByVal pidl As Long) As Long Private Declare Sub CoTaskMemFree Lib "ole32.dll" _ (ByVal pv As Long) Private Sub Command1_Click() Text1.Text = GetBrowseNetworkWorkstation() End Sub Private Sub Command2_Click() Text2.Text = GetBrowseNetworkShare() End Sub Private Function GetBrowseNetworkShare() As String 'returns only a valid share on a 'network server or workstation Dim BI As BROWSEINFO Dim pidl As Long Dim sPath As String Dim pos As Integer 'obtain the pidl to the special folder 'network' If SHGetSpecialFolderLocation(Me.hWnd, _ CSIDL_NETWORK, _ pidl) = ERROR_SUCCESS Then 'fill in the required members, limiting the 'Browse to the network by specifying the 'returned pidl as pidlRoot With BI .hOwner = Me.hWnd .pidlRoot = pidl .pszDisplayName = Space$(MAX_PATH) .lpszTitle = "Select a network computer or share." .ulFlags = BIF_RETURNONLYFSDIRS End With 'show the browse dialog pidl = SHBrowseForFolder(BI) If pidl 0 Then 'got a pidl .. but is it valid? sPath = Space$(MAX_PATH) If SHGetPathFromIDList(ByVal pidl, ByVal sPath) Then 'valid, so get the share path pos = InStr(sPath, Chr$(0)) GetBrowseNetworkShare = Left$(sPath, pos - 1) End If Call CoTaskMemFree(pidl) Else 'a server selected...follow same principle 'as in GetBrowseNetworkWorkstation GetBrowseNetworkShare = "" & BI.pszDisplayName End If 'If pidl End If 'If SHGetSpecialFolderLocation End Function Private Function GetBrowseNetworkWorkstation() As String 'returns only a valid network server or 'workstation (does not display the shares) Dim BI As BROWSEINFO Dim pidl As Long Dim sPath As String Dim pos As Integer 'obtain the pidl to the special folder 'network' If SHGetSpecialFolderLocation(Me.hWnd, _ CSIDL_NETWORK, _ pidl) = ERROR_SUCCESS Then 'fill in the required members, limiting the 'Browse to the network by specifying the 'returned pidl as pidlRoot With BI .hOwner = Me.hWnd .pidlRoot = pidl .pszDisplayName = Space$(MAX_PATH) .lpszTitle = "Select a network computer." .ulFlags = BIF_BROWSEFORCOMPUTER End With 'show the browse dialog. We don't need 'a pidl, so it can be used in the If..then directly. If SHBrowseForFolder(BI) 0 Then 'a server was selected. Although a valid pidl 'is returned, SHGetPathFromIDList only return 'paths to valid file system objects, of which 'a networked machine is not. However, the 'BROWSEINFO displayname member does contain 'the selected item, which we return GetBrowseNetworkWorkstation = "" & BI.pszDisplayName End If 'If SHBrowseForFolder Call CoTaskMemFree(pidl) End If 'If SHGetSpecialFolderLocation End Function
Publicado en microsoft.public.es.vb por chincho
Inicia un nuevo proyecto, pega el siguiente código en la sección «Declaraciones» y ejecútalo, te mostrara en un MsgBox el Símbolo monetario.
Option Explicit On Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, _ ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long Private Const LOCALE_SCURRENCY = &H14 ' Constante para el símbolo monetario Private Const LOCALE_USER_DEFAULT = &H400 Private Sub Form_Load() Dim sBuffer As String Dim dl As Long ' Area intermedia dónde se cargará la información sBuffer = String$(100, vbNullChar) ' La función devolverá la cantidad de caracteres ' cargados en el área intermedia. Cero, en caso ' de error. dl = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SCURRENCY, sBuffer, 100) If dl 0 Then MsgBox(Left(sBuffer, dl - 1)) End Sub
Publicado en microsoft.public.es.vb por Softjaen
Con esta función API puedes recuperar la hora actual, incluidos los milisegundos.
Option Explicit On Private Declare Sub GetSystemTime Lib "kernel32" (ByVal lpSystemTime As SYSTEMTIME) Private 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 Private Sub Form_Load() Dim SysTime As SYSTEMTIME Dim TxtTmp As String ' Obtenemos la información del Sistema GetSystemTime(SysTime) TxtTmp = "Muestra la Fecha y Hora del Sistema" & vbCrLf & vbCrLf TxtTmp = TxTTmp & "Fecha: " & SysTime.wDay & "/" & SysTime.wMonth & "/" & SysTime.wYear & vbCrLf TxtTmp = TxtTmp & "Hora: " & SysTime.wHour & ":" & SysTime.wMinute & ":" & SysTime.wSecond & ":" & SysTime.wMilliseconds ' Mostramos la información. MsgBox(TxtTmp) End Sub
Con esta función API puedes recuperar la ubicación de la situación, en el sistema donde esta corriendo tu aplicación, de las carpetas del sistema, como el Escritorio, Impresoras, Fuentes, Favoritos, Etc…
Copia este ejemplo en un formulario:
Option Explicit On ' Definimos las constantes de las carpetas 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 Private Type SHITEMID cb As Long abID As Byte End Type Private Type ITEMIDLIST mkid As SHITEMID End Type 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, ByVal 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() ' Activamos el grafico persistente en el formulario Me.AutoRedraw = True ' Mostramos la información en el formulario ' Algunas carpetas devolvera vacio en función del sistema en el que trabajeis Me.Print("Carpeta Desktop..........: " + CarpetadelSistema(CSIDL_DESKTOP)) Me.Print("Carpeta Programs.........: " + CarpetadelSistema(CSIDL_PROGRAMS)) Me.Print("Carpeta Controls.........: " + CarpetadelSistema(CSIDL_CONTROLS)) Me.Print("Carpeta Printers.........: " + CarpetadelSistema(CSIDL_PRINTERS)) Me.Print("Carpeta Personal.........: " + CarpetadelSistema(CSIDL_PERSONAL)) Me.Print("Carpeta Favorites........: " + CarpetadelSistema(CSIDL_FAVORITES)) Me.Print("Carpeta Star UP..........: " + CarpetadelSistema(CSIDL_STARTUP)) Me.Print("Carpeta Recent...........: " + CarpetadelSistema(CSIDL_RECENT)) Me.Print("Carpeta Send To..........: " + CarpetadelSistema(CSIDL_SENDTO)) Me.Print("Carpeta Bit Bucket.......: " + CarpetadelSistema(CSIDL_BITBUCKET)) Me.Print("Carpeta Start Menu.......: " + CarpetadelSistema(CSIDL_STARTMENU)) Me.Print("Carpeta Desktop Directory: " + CarpetadelSistema(CSIDL_DESKTOPDIRECTORY)) Me.Print("Carpeta Drivers..........: " + CarpetadelSistema(CSIDL_DRIVES)) Me.Print("Carpeta Network..........: " + CarpetadelSistema(CSIDL_NETWORK)) Me.Print("Carpeta Net Hood.........: " + CarpetadelSistema(CSIDL_NETHOOD)) Me.Print("Carpeta Fonts............: " + CarpetadelSistema(CSIDL_FONTS)) Me.Print("Carpeta Templates........: " + CarpetadelSistema(CSIDL_TEMPLATES)) End Sub Private Function CarpetadelSistema(ByVal CSIDL As Long) As String Dim Res As Long, Camino As String, IDL As ITEMIDLIST ' Obtenemos el controlador del sistema Res = SHGetSpecialFolderLocation(100, CSIDL, IDL) If Res = 0 Then 'Creamos el buffer Camino = Space$(512) 'Obtenermos el camino de IDList Res = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Camino) ' Eliminamos los caracteres Chr(0) CarpetadelSistema = Left$(Camino, InStr(Camino, Chr$(0)) - 1) Exit Function End If CarpetadelSistema = "" End Function
Con esta función API puedes actualizar la hora del sistema completando los datos del tipo SYSTEMTIME, la declaración sería.
Private Declare Function SetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) As Long Private 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
Un ejemplo:
Dim HoraSistema As SYSTEMTIME Dim FechaActual As Date Dim lReturn As Long ' Una fecha al azar FechaActual = CDate(#12/1/2003 4:45:23 AM#) ' Ahora preparamos los datos para actualizar el reloj del sistema With HoraSistema .wYear = DatePart("yyyy", FechaActual) .wMonth = DatePart("m", FechaActual) .wDay = DatePart("d", FechaActual) .wHour = DatePart("h", FechaActual) .wMinute = DatePart("n", FechaActual) .wSecond = DatePart("s", FechaActual) .wMilliseconds = 0 End With ' Asignamos la hora al sistema lReturn = SetSystemTime(HoraSistema)
El Winsock maneja protocolos, no es una herramienta que cubre necesidades puntuales. Prueba esta API que maneja el protocolo ICMP.
Function IcmpSendEcho Lib "icmp.dll" (ByVal IcmpHandle As Long, ByVal DestinationAddress As Long, _ ByVal RequestData As String, ByVal RequestSize As Long, ByVal RequestOptions As Long, _ ReplyBuffer As ICMP_ECHO_REPLY, ByVal ReplySize As Long, ByVal Timeout As Long) As Long
Publicado en microsoft.public.es.vb por foreback
Este ejemplo genera en el registro de windows la entrada necesaria para crear un DSN desde el código de nuestro programa. Este código es fácil de trasladar a otros lenguajes, ya que sólo hay que tocar el registro.
Option Explicit Private Const REG_SZ = 1 'Constant for a string variable type. Private Const HKEY_LOCAL_MACHINE = &H80000002 Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, _ ByVal lpSubKey As String, phkResult As Long) As Long Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, _ ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, _ ByVal cbData As Long) As Long Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Sub Command1_Click() Dim DataSourceName As String Dim DatabaseName As String Dim Description As String Dim DriverPath As String Dim DriverName As String Dim LastUser As String Dim Regional As String Dim Server As String Dim lResult As Long Dim hKeyHandle As Long 'Specify the DSN parameters. DataSourceName = "" DatabaseName = "" Description = "" DriverPath = "" LastUser = "" Server = "" DriverName = "SQL Server" 'Create the new DSN key. 'Set the values of the new DSN key. lResult = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWAREODBCODBC.INI" & DataSourceName, hKeyHandle) lResult = RegSetValueEx(hKeyHandle, "Database", 0&, REG_SZ, ByVal DatabaseName, Len(DatabaseName)) lResult = RegSetValueEx(hKeyHandle, "Description", 0&, REG_SZ, ByVal Description, Len(Description)) lResult = RegSetValueEx(hKeyHandle, "Driver", 0&, REG_SZ, ByVal DriverPath, Len(DriverPath)) lResult = RegSetValueEx(hKeyHandle, "LastUser", 0&, REG_SZ, ByVal LastUser, Len(LastUser)) lResult = RegSetValueEx(hKeyHandle, "Server", 0&, REG_SZ, ByVal Server, Len(Server)) 'Close the new DSN key. lResult = RegCloseKey(hKeyHandle) 'Open ODBC Data Sources key to list the new DSN in the ODBC Manager. 'Specify the new value. 'Close the key. lResult = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWAREODBCODBC.INIODBC Data Sources", hKeyHandle) lResult = RegSetValueEx(hKeyHandle, DataSourceName, 0&, REG_SZ, ByVal DriverName, Len(DriverName)) lResult = RegCloseKey(hKeyHandle) End Sub
Publicado en microsoft.public.es.vb por Roberto Carretero
Con estas funciones podrás crear Timers que no se detendrán con un MsgBox.
Para Crear el Timer
Declare Function SetTimer Lib "User32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Y esta otra para Destruirlo
Declare Function KillTimer Lib "User32" (ByVal hWnd As Long, nIDEvent As Long) As Long
El Blog de ViMaGoDe 