vb

Autenticación con Windows Live ID

Alrededor de 500 millones de personas utilizan los servicios de Windows Live, con la intención de despreocuparnos de la autenticación y ofrecer una mejor usabilidad al visitante, podemos utilizar estos servicios en nuestra web.

El primera paso es registrar nuestra página web o aplicación en http://manage.dev.live.com, indicaremos una descripción, tipo y dominio. si corresponde, donde se alojará la aplicación. Podemos registrar hasta 100 aplicaciones por cada usuario.

image

image

Estos serán los datos que configuraremos más tarde en nuestra aplicación.

Para comenzar utilizaremos el SDK de Windows Live ID Web Authentication con el que podremos iniciar una pequeña prueba de acceso. Un paso importante es copiar la carpeta App_Code dentro del directorio Sample, esta carpeta contiene “WindowsLiveLogin.vb”, encargada de la autenticación y captura de los identificadores proporcionados por Windows Live.

Por último vamos a asignar al sitio “Client ID” y el “Secret key” obtenidos anteriormente, sustituyendo los valores por defecto que vienen en el fichero web.config.

image

Todo listo, nuestra aplicación ya puede ser ejecutada. Como podéis observar nos aparece la opción Sign In, significa que no ha detectado ningún usuario, por lo que pulsando sobre el enlace nos mostrará la pantalla de autenticación.

image

image

Como podemos observar el enlace directamente conecta con Windows Live para solicitar los datos de acceso. Una vez introducidos los datos, regresaremos a nuestra aplicación, ahora el botón “Sign In” se cambiará “Sign Out” y se muestra el ID del usuario identificado, este valor siempre será el mismo para todas las ocasiones que el usuario se identifique.

 

Para más información visite Connect with Windows Live y Registering Your Application with Windows Live

Cómo detectar un sistema de 32 ó 64 bits

IntPtr es utilizado nativamente en .Net, por eso el tamaño de su estructura se redimensiona según la capacidad del sistema operativo. Utilizando esta funcionalidad podemos detectar si el sistema operativo trabaja con procesadores de 32 bits o 64 bits, ya que entonces el tamaño de la estructura de IntPtr será de 4 bits en el caso de 32 bits y 8 bits en 64 bits.

' Código VB.Net 
If IntPtr.Size = 8 Then

    ' Máquina con procesador de 64 bits

ElseIf IntPtr.Size = 4 Then

    ' Máquina con procesador de 32 bits

End If

 

// Código C#
if(IntPtr.Size == 8) 
{
    // Máquina con procesador de 64 bits
} 
else if(IntPtr.Size == 4) 
{
    // Máquina con procesador de 32 bits
}

Marcar una función como obsoleta

En ocasiones, sobre todo cuando trabajamos en equipos de desarrollo distribuidos o trabajando en diferentes partes del mismo software, debemos indicar de alguna manera la conveniencia de actualizar las llamadas a alguna función, bien sea por que hay otra función más potente y actualizada para realizar el mismo proceso y/o porque será eliminada.

Visual Studio provee una manera sencilla de “crear este aviso” para el resto de desarrolladores, incluyendo la clausula Obsolete.

' Código Visual Basic
<Obsolete("Esta función es obsoleta, por favor utilice CheckComputer", False)> _
Function CheckSystem() As String

// Código C#
[Obsolete("Esta función es obsoleta, por favor utilice CheckComputer")]
Public string CheckSystem

El que una función o clase esté marcada como obsoleta, no nos impide utilizarla, ya que por defecto, muestra una advertencia o warning en la lista de errores.

Para lograr que el compilador nos marque un error y no una advertencia cuando utilizamos la función obsoleta CheckSystem, debemos cambiar la definición de la función indicando en el parámetro Error el valor True.

' Código Visual Basic
<Obsolete("Esta función es obsoleta, por favor utilice CheckComputer", True)> _
Function CheckSystem() As String

// Código C#
[Obsolete("Esta función es obsoleta, por favor utilice CheckComputer", True)]
Public string CheckSystem

Conocer la Semana de una fecha dada

Ahí va una función que hace eso, calcular la semana de una fecha dada.

Function CalculaSemana(ByVal Fecha As Date) As Integer
    Dim FechaPrimAnyo As Date
    Dim DiaSemanaPrimAnyo As Integer
    Dim DiaSemanaFecha As Integer
    Dim Sumando As Integer
    Dim DiasTranscurridos As Integer

    FechaPrimAnyo = CDate("01/01/" & CStr(Year(Fecha)))
    DiaSemanaPrimAnyo = WeekDay(FechaPrimAnyo)
    DiaSemanaFecha = WeekDay(Fecha)
    DiasTranscurridos = Fecha - FechaPrimAnyo + DiaSemanaPrimAnyo - 1
    CalculaSemana = (DiasTranscurridos  7) + 1
End Function

Publicado en es.comp.lenguajes.visual-basic por Gabriel Ortí i Flores

– – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –

Un código mucho más corto, publicado por Enrique Medina en microsoft.public.es.vb el 28/08/2003

Function CalculaSemana(ByVal Fecha As Date) As Integer
    CalculaSemana = DatePart("ww", Fecha)
End Function

Descargar ficheros de Internet

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")

Seleccionar equipos y carpetas de una red Windows

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

Obtener el símbolo monetario existente en la configuración regional de Windows

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

Obtener la hora del Sistema (milisegundos incluidos)

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

Convertir datos entre diferentes formatos

Se trata de una función, a la que le enviamos cualquier tipo de dato y nos lo devuelve convertido al que queramos, según el indicador que reciba.

Public Function ValidarCampo(Campo As Variant, I As Integer) As Variant
    'SI VIENE VACÍO O CON NULO
    If Campo = "" Or IsNull(Campo) Then
        ValidarCampo = ""
    Else
        Select Case I   'PARA DEVOLVER EL TIPO DE CONVERSION
            Case 1 'CONVERSIÓN A INTEGER
                ValidarCampo = CInt(Campo)
            Case 2 'CONVERSIÓN A LONG
                ValidarCampo = CLng(Campo)
            Case 3 'CONVERSIÓN A DOUBLE
                ValidarCampo = CDbl(Campo)
            Case 4 'CONVERSIÓN A SINGLE
                ValidarCampo = CSng(Campo)
            Case 5 'CONVERSIÓN A FECHA
                ValidarCampo = CDate(Campo)
            Case 6 'CONVERSIÓN A CADENA
                ValidarCampo = CStr(Campo)
        End Select
    End If
End Function

Conocer el número de Años entre dos fechas

Este código calcula el número de años entre dos fechas. Muy válido para calcular la edad de una persona teniendo en cuenta la fecha actual. Usa la función DateSerial de creación de fechas.

Public Function AñosEntre(ByVal Fecha1 As Date, ByVal Fecha2 As Date) As Integer
    Dim Años As Integer
    Años = DateDiff("yyyy", Fecha1, Fecha2)
    If Fecha1 < DateSerial(Year(Fecha1), Month(Fecha2), Day(Fecha2)) Then
        Años = Años - 1
    End If
    AñosEntre = Años
End Function