Trucos Breves III de Visual Basic, ~ Un Tal Chamo

Como aumentar el Tamaño de un RichTextBox en Ejecución (y cualquier TextBox, Picture, etc.)
Private Sub Form_Resize()
If Not Me.WindowState = vbMinimized Then RichTextBox1.Move 0, 0, Me.Width - 100, Me.Height - 400
End If
End Sub

Despliegue Automático de un ComboBox al recibir el Foco...
En primer lugar, debes declarar la funcion en un modulo BAS:
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _lParam As Long) As Long
Y escribe este código en el evento GotFocus del control ComboBox:
Sub Combo1_GotFocus()
Const CB_SHOWDROPDOWN = &H14F
Dim Tmp
Tmp = SendMessage(Combo1.hwnd, CB_SHOWDROPDOWN, 1, ByVal 0&)
End Sub

CheckBox en DBGrid...
El Grid tiene una propiedad Columns que hace referencia a la columna encuestion. La columna
tiene otro objeto ValueItems que determina el aspecto de la columna. La propiedad Presentation
de este objeto determina el modo de presentación. El valor 4 representa a un checkbox.
TDbGrid1.Columns(1).ValueItems.Presentation = 4

Detectar si cambia el contenido de un Control TextBox
Solamente necesitamos un control TextBox y declarar en un Modulo lo siguiente:
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
(Ojo, toda esta declaracion debe estar en una sola linea!!)
En el Evento Click del Form1 colocar lo siguiente:
Sub Form_Click()
    If SendMessage(Text1.hWnd, &HB8, 0, ByVal 0&) = 1 then
        Form1.Caption = "Se ha cambiado el Texto"
    Else
        Form1.Caption = "Se ha dejado igual el Texto"
    End If
End Sub

Una ventana con forma ELIPTICA !!!???
Solamente necesitamos declarar en un Modulo lo siguiente:
Public Declare Function SetWindowRgn Lib "user32" Alias "SetWindowRgn" (ByVal hWnd As Long, _
                ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function CreateEllipticRgn Lib "gdi32" Alias "CreateEllipticRgn" (ByVal X1 As Long, _
                ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
En el evento click de la ventana:
Private Sub Form_Click()
       Dim Xs as Long, Ys as Long
        Xs = Me.Width / Screen.TwipsPerPixelX
        Ys = Me.Height / Screen.TwipsPerPixelY
    SetWindowRgn hWnd, CreateEllipticRng(0, 0, Xs, Ys), True
End Sub

Utilización de los controles DirListBox, DriveListBox y FileListBox
Para ver el funcionamiento de este pequeño visor de iconos necesitamos colocar en un
Form1 (default) los siguientes controles:

1 Control DriveListBox
1 Control DirListBox
1 Control FileListBox
1 Control Picture1
1 Label1

       El Codigo a colocar es el siguiente:
     Private Sub Dir1_Change()
                File1.Path = Dir1.Path
        End Sub

        Private Sub Drive1_Change()
                Dir1.Path = Drive1.Drive
        End Sub

        Private Sub File1_Click()
            Picture1.Picture = LoadPicture(Dir1.Path & "/" & File1.FileName)
            Label1.Caption = "Icono Seleccionado: " & UCase$(File1.FilaName)
        End Sub

        Private Sub File1_PathChange()
            File1.FileName = "*.ICO"
        End Sub

El método ARRANGE

El método ARRANGE se aplica (casi exclusivamente) en los formularios MDI, ya que es utilizado para ordenar de diversas formas los iconos y las ventanas abiertas.
        Este método es el aplicado en un item de menú que (habitualmente) llamamos Ventana, donde, por ejemplo colocaremos como sub-items lo siguiente: Cascada, Mosaico Vertical, Mosaico Horizontal y Organizar Iconos.
        El código para la ejecución se coloca en los eventos CLICK de cada item.
        Ejemplo:
     Private Sub Organizar_Iconos_Click()
        MDIForm.Arrange 3
        End Sub

        Private Sub Mosaico_Vertical_Click()
        MDIForm.Arrange 2
        End Sub

        Private Sub Mosaico_Horizontal_Click()
        MDIForm.Arrange 1
        End Sub

        Private Sub Cascada_Click()
        MDIForm.Arrange 0
        End Sub

Un sencillo Cronómetro

Para ejecutar un lapso de tiempo x (por ejemplo 5 segundos), escribir el siguiente codigo en un Modulo Nuevo:

    Public Sub Esperar(Tiempo as Single)
        Dim ComienzoTiempo as Single
        Dim FinTiempo as Single
        ComienzoTiempo = Timer
        FinTiempo = ComienzoTiempo + Tiempo
        Do While FinTiempo > Timer
                Do Events
                 If ComienzoTiempo > Timer Then
                        FinTiempo = FinTiempo - 24 * 60 * 60
                End If
        Loop
   End Sub

Para "llamarlo" desde un Form comun, colocar (por ejemplo, en el evento Click)

Esperar(5)

Eliminar el "Beep" al pasar el foco de un TextBox a otro control...

Insertar el siguiente Codigo en el evento KeyPress de un TextBox de nuestro Formulario:

                Private Sub Text1_KeyPress(KeyAscii As Integer)
                        If KeyAscii = 13 Or KeyAscii = 9 Then KeyAscii = 0
                End Sub

Situar el Cursor en un Control determinado

Para situar el cursor encima de un control determinado, por ejemplo un Botón, situar el siguiente codigo en un Modulo:

Declare sub SetCursorPos Lib "User32" (ByVal X as Integer, ByVal Y as Integer)

Insertar en siguiente código en el evento Load de el Form:

       Private Sub Form1_Load()
            X % = (Form1.Left + Command1.Left + Command1.Width / 2 + 60 ) / Screen.Twips
            Y% = (Form1.Top + Command1.Top + Command1.Height / 2 + 360) / Screen.Twips
            SetCursorPos X%, Y%
       End Sub

Nota: Para que sea mas fácil la escritura del codigo a colocar en el modulo, Visual Basic trae el Visor de API de Windows

Mostrar / Ocultar el puntero del Mouse

Insertar el siguiente Codigo en los eventos Click de dos botones en nuestro Form

Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long

                Private Sub cmdOcultar_Click()
                    resultado = ShowCursor(False)
                End Sub

                Private Sub cmbMostrar_Click()
                    resultado = ShowCursor(True)
                End Sub

Pasar de un control a otro con "Enter"

Cambiar la Propiedad KeyPreview del control TextBox a True e inserte el siguiente Codigo en el evento KeyPress del Form:

Private Declare Sub Form1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
        KeyAscii = 0
    End If
End Sub

Provocar la Transparencia de un Form

Insertar el siguiente Codigo en un Modulo:

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Nota: Debe estar todo en una sola linea (Usar el Visor de Texto API, que viene con Visual Basic)

Insertar el siguiente Codigo en CommandButton para probar:

Private Sub Command1_Click()
    Dim Resp As Long
    Resp = SetWindowLong(Me.hWnd, -20, &H20&)
    Form1.Refresh
End Sub

Arreglo sugerido por Esteban:

En un módulo:
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const WS_EX_TRANSPARENT = &H20&
Public Const GWL_HINSTANCE = (-6)
Public Const GWL_EXSTYLE = (-20)
Public Const GWL_HWNDPARENT = (-8)
Public Const GWL_ID = (-12)
Public Const GWL_STYLE = (-16)
Public Const GWL_USERDATA = (-21)
Public Const GWL_WNDPROC = (-4)

y en el Form_Load

Call SetWindowLong(Form1.hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT)

Gracias, Esteban!

Centrar una Ventana

Para Centrar una ventana en el medio de la pantalla, colocar el siguiente codigo en el evento Load de un Form:

Me.Move (Sreen.Width - Me.Width) / 2, Me.Move (Screen.Height - Me.Height) / 2

Presentar una pantalla Acerca de... por defecto (1):

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 Sub Command1_Click()
Call ShellAbout(Me.hwnd, "Mi Programa", "Copyright 1999, PMMF", Me.Icon)
End Sub

Utilizando el Control Graph

Primero rellenas las etiquetas del graph, es decir, lo que es la "leyenda", y pones a 0
los datos del Graph (de paso)

' Muchos cajeros, un sólo dato.
grafico_frm.grafico.ColumnCount = (Len(x2) - 1) / 3
ReDim label_y(1 To grafico_frm.grafico.ColumnCount)
' Toma nota de las etiquetas (y)
i = 1
For i1 = 0 To lista_cajeros.ListCount - 1
    If lista_cajeros.Selected(i1) Then
        label_y(i) = lista_cajeros.List(i1)
           ' Nombre de las leyendas
        grafico_frm.grafico.Column = i
        grafico_frm.grafico.ColumnLabel = label_y(i)
        i = i + 1
            If i = (grafico_frm.grafico.ColumnCount + 1) Then
                Exit For
            End If
   End If
Next i1

For i1 = 0 To lista_datos.ListCount - 1
    If lista_datos.Selected(i1) Then
        x = "'" + lista_datos.List(i1) + "'"
        Exit For
    End If
Next i1 ' Después, rellenas los datos.
For i1 = 1 To grafico_frm.grafico.RowCount
For i2 = 1 To grafico_frm.grafico.ColumnCount
    grafico_frm.grafico.Row = i1
    grafico_frm.grafico.Column = i2
    grid.row=i1
    grid.col=i2
    grafico_frm.grafico.Data = val(grid.text)
Next i2
Next i1

(Esperemos que este ejemplo funcione, jeje)

Imprimir el Grafico Resultante del Ejemplo Anterior (Con el Control GRAPH)

Printer.PaintPicture picture1.picture, PosicionVertical, PosicionHorizontal
Printer.EndDoc 'Envia los datos a la impresora

Enviar Faxes Utilizando los controles de VB

Utilizaremos para ello los controles MAPI Messages y MAPI Session para crear un mensaje de Exchange.
Si en el campo de la dirección e-mail empiezas por "Fax: " y continuas con el nº de fax, conseguirás enviar el mensaje a través del servicio MS Fax.

Ten cuidado de utilizar un perfil de Exchange que solo incluya el servicio Fax, no el Internet Mail, porque si no intentará enviarlo por los dos sistemas.

MAPISession1.LogonUI = False
wPerfil = "Configuraciones de MS Exchange"
MAPISession1.UserName = wPerfil
MAPISession1.SignOn
MAPIMessages1.SessionID = MAPISession1.SessionID
Sesion = True
lblEstado = "Creando mensaje..."
MAPIMessages1.ComposeMAPIMessages1.MsgSubject = ""
' No utilizar el campo de texto. Lo intenta imprimir con el Word como
' segunda hoja y falla dando error WordBasic nº 124 (teniendo instalado el Parche)
MAPIMessages1.MsgNoteText = "Este es el texto de la prueba....."
MAPIMessages1.RecipIndex = 0
MAPIMessages1.RecipIndex = NumDestino
MAPIMessages1.RecipType = mapToList
MAPIMessages1.RecipDisplayName = Data1.Recordset.Fields(1)
MAPIMessages1.RecipAddress = "Fax:" & Data1.Recordset.Fields(0)
MAPIMessages1.AttachmentIndex = I
MAPIMessages1.AttachmentPosition = I
MAPIMessages1.AttachmentPathName = wPath
MAPIMessages1.AttachmentName = wName
lblEstado = "Enviando mensaje..."
MAPIMessages1.Send
MAPISession1.SignOff

Un Reporte de CrystalReport en una Ventana??

Dim Frm As Form
Set Frm = New Form1
CrystalReport1.Destination = crptToWindow
CrystalReport1.WindowParentHandle = Form1.hwnd
CrystalReport1.Action = 1Siendo el Form1 MDI.

El uso del Menu Edicion en tiempo de Ejecucion

En un Modulo aparte (o bien dentro de las declaraciones Generales del Form donde vamos a invocarlo)

Declare Function GetActiveWindow Lib "user32" Alias "GetActiveWindow" () As Long

Luego esta porcion de codigo la colocamos en el MDIForm (donde tenemos el Menu Edicion... por ejemplo)
' en el caso de que tenga 2 formularios
' como se cual estoy ocupando ?
' .... de esta manera:
' reviso el primer formulario
If Form1.hWnd = GetActiveWindow Then
.... ' hace esto
End If
' reviso el segundo formulario
If form2.hWnd = GetActiveWindow Then
.... ' hace esto otro
End If

Encriptacion XOR

El operador lógico XOR suministra un interesante algoritmo de encriptación, se codifica en la primera llamada y se decodifica en la segunda. Ejemplo:
Private Sub Form_Load()
Dim s As String
s = "Hola!"
'//Codifica
XORStringEncrypt s, "MiClave"
Show
Print "Codificado: "; s
'//Decodifica
XORStringEncrypt s, "MiClave"
Print "Decodificado: "; s
End Sub

Private Sub XORStringEncrypt(s As String, PassWord As String)
Dim n As Long
Dim i As Long
Dim Char As Long

n = Len(PassWord)
For i = 1 To Len(s)
Char = Asc(Mid$(PassWord, (i Mod n) - n * ((i Mod n) = 0), 1))
Mid$(s, i, 1) = Chr$(Asc(Mid$(s, i, 1)) Xor Char)
Next
End Sub

Leer una Cadena (string) dentro de otra...

En particular existen muchos comando tales conmo: CommandString="Source=File.txt;Path=C:CommonFiles;Title=;..."
Resulta que deseamos obtener lo que corresponde a Path= de la cadena anterior. La siguiente función se usa de esta manera: s = GetSubString(CommandString, "Path=", ";")
Public Function GetSubString( _
s As String, _
StartDelim As String, _
EndDelim As String _
) As String

Dim nStartDelim As Long
Dim nEndDelim As Long

nStartDelim = InStr(s, StartDelim)
If nStartDelim Then
nStartDelim = nStartDelim + Len(StartDelim)
nEndDelim = InStr(nStartDelim, s, EndDelim)
If nEndDelim Then
GetSubString = Mid$(s, nStartDelim, nEndDelim - nStartDelim)
End If
End If
End Function

En el siguiente ejemplo, obtengo el nombre de la base de datos de un DataEnvirnment
Dim DE As New dePPDMMirror

gsDatabaseConnection = DE.cnnPPDMMirror.ConnectionString
gsDatabaseName = GetSubString(gsDatabaseConnection, "Source=", ";")

Set DE = Nothing

Fecha aleatoria
A veces es útil, generalmente para pruebas, generar una fecha aleatoria dentro de un rango, p.e deseo una fecha entre el 1/1/1960 y 1/1/2000, llamariamos a esta función como MyDate=GetRandomDate("1/1/1960", "1/1/2000")
Private Function GetRandomDate(ByVal StartDate As Date, ByVal EndDate As Date) As Date
Static AnotherCall As Boolean
Dim nDays As Single

On Error GoTo ErrorHandler
If Not AnotherCall Then
Randomize Timer
AnotherCall = True
End If
nDays = DateValue(EndDate) - DateValue(StartDate)
GetRandomDate = CDate(DateValue(StartDate) + nDays * Rnd())
Exit Function

ErrorHandler:
GetRandomDate = Null
End Function

Generar un nombre de archivo aleatorio
La siguiente función genera un nombre de archivo aleatorio. Puede ser utile cuando se requieren archivos temporales.
Private Function GenerateRandomFileName() As String
Const MASKNUM As String = "_0123456789"
Const MASKCHR As String = "abcdefghijklmnoprstuvwxyz"
Const MASK As String = MASKCHR + MASKNUM
Const MINLEN As Integer = 4
Const MAXLEN As Integer = 12

Dim nMask As Long
Dim nFile As Long
Dim sFile As String
Dim sExt As String
Dim i As Long
Dim nChr As Long

nFile = MINLEN + (MAXLEN - MINLEN) * Rnd()
nMask = Len(MASK)
For i = 1 To nFile
nChr = Int(nMask * Rnd()) + 1
sFile = sFile + Mid$(MASK, nChr, 1)
Next
nMask = Len(MASKCHR)
For i = 1 To 3
nChr = Int(nMask * Rnd()) + 1
sExt = sExt + Mid$(MASKCHR, nChr, 1)
Next

GenerateRandomFileName = sFile + "." + sExt
End Function
NOTAS

1) La función asume que la semilla de aleatorios fue iniciada previamente (para más informacion, ver "Randomize")
2) Puede obtener el nombre del archivo de temporales de Windows de la siguiente expresión: TempPath = Environ("TEMP") & ""

Trasnformar una Hora a Decimal (y viceversa...)
En algunos cálculos es requerido transformar datos de hora a decimal y viceversa (en Topografía es útil). P.e. la hora 10:30 AM será 10.5 en decimal.
Public Function HourDec(h As Variant) As Variant
If Not IsNull(h) Then
HourDec = Hour(h) + Minute(h) / 60 + Second(h) / 3600
End If
End Function

Public Function DecHour(h As Variant) As Variant
Dim nHour As Integer
Dim nMinutes As Integer
Dim nSeconds As Integer

nHour = Int(h)
nMinutes = Int((h - nHour) * 60)
nSeconds = Int(((h - nHour) * 60 - nMinutes) * 60)
DecHour = nHour & ":" & nMinutes & ":" & nSeconds
End Function
Ejemplo:
Private Sub Command1_Click()
Dim h As Single
Dim d As String
Cls
d = "10:37:58"
h = HourDec(d)
Print "Hora Decimal = "; d
Print "Hora Estándar = "; h
Print "Hora de Decimal a Estándar = "; DecHour(h)
End Sub
El parámetro de HourDec puede ser un dato Date, expresión que retorne Date (por ejemplo la función Now), o una cadena, "hh:mm:ss" como en ejemplo.

Incremento continuo
Desafortunadamente Visual Basic no tiene operador de incrementación continua, es decir el famoso i++ del lenguaje C. Podamos simular algo parecido:
Public Static Function Plus(Optional Start As Variant) As Long
Dim i As Long
If Not IsMissing(Start) Then
i = Start-1
End If
i = i + 1
Plus = i
End Function
Esta pequeña función puede ser extremadamente útil en código para obtener recursos, digamos que es común:
Dim I As Long
I=100
Caption = LoadResString(I)
lblPINCode = LoadResString(1 + I)
fraAccount = LoadResString(2 + I)
optChecking.Caption = LoadResString(3 + I)
optSavings.Caption = LoadResString(4 + I)
...
cmdOK.Caption = LoadResString(n + I)
Supongamos que hacemos un cambio en el archivo recursos : lblPINCode ya no se usa en el formulario, y compilamos el recurso. Para actualizar el código tendremos que ir línea por línea para actualizar el I + x. - Nada práctico. Mientras que si escribimos:
Caption = LoadResString(Plus(100))
lblPINCode = LoadResString(Plus)
fraAccount = LoadResString(Plus)
optChecking.Caption = LoadResString(Plus)
optSavings.Caption = LoadResString(Plus)
...
cmdOK.Caption = LoadResString(Plus)
La actualización mensionada consistirá solo en eliminar la línea: lblPINCode = LoadResString(PlusI). Mejor imposible

Crear Cadenas Multineas de manera practica
Pienso que todos nos hemos hartado de escribir s = s + "algo"& vbCrLf & _ ... etc. La siguiente función es una alternativa simple de crear cadenas multiline:
Public Function StrChain(ParamArray v() As Variant) As String
Dim i As Integer
Dim n As Integer
Dim rtn As String
n = UBound(v)
For i = 0 To n
rtn = rtn & v(i)
If i < n Then
rtn = rtn & vbCrLf
End If
Next
StrChain = rtn
End Function
P.e:
Text1 = StrChain( _
"Hola", _
"cómo", _
"estas")
O simplemente Text1 = StrChain( "Hola", "cómo", "estas"), es más cómodo que:
Text1 = "Hola"& vbCrLf & "cómo" & VbCrLf & "estas"
Claro, suponiendo que las cadenas concatenadas sean extensas, como un SQL o un comando Script.

Saber si un archivo es binario o solo texto
Algunos archivos tienen extensiones personalizadas y algunas veces debemos evaluar si son
o no binarios antes de procesarlos.
Public Function IsBinaryFile(File As String) As Boolean

Const aLf = 10, aCR = 13, aSP = 32
Const MaxRead = 2 ^ 15 - 1

Dim ff As Integer
Dim s As Integer
Dim i As Integer
Dim n As Integer
Dim Rtn As Boolean

On Error GoTo IsBinaryFile_Err

ff = FreeFile
Open File For Binary Access Read As #ff
n = IIf(LOF(ff) > MaxRead, MaxRead - 1, LOF(ff))
Do
i = i + 1
If i >= n Then
IsBinaryFile = False
Rtn = True
Else
s = Asc(Input$(1, #ff))
If s >= aSP Then
Else
If s = aCR Or s = aLf Then
Else
IsBinaryFile = True
Rtn = True
End If
End If
End If
Loop Until Rtn
Close ff
Exit Function

IsBinaryFile_Err:
If ff Then Close ff
MsgBox "Error verifying file " & File & vbCrLf & Err.Description

End Function
Simplemente pase el nombre del archivo al argumento y la función retornata un valor bolean. Por ejemplo MsgBox "¿ Es binario Command.Com ? ... " & IsBinaryFile("command.com").

Estimar el tiempo de proceso
Esta es una vieja técnica que emplean para estimar la duración de un bloque de código o proceso. Es útil para comparar el tiempo de dos o más algoritmos diferentes que resuelven un mismo problema.
Dim t As Single
DoEvents
t = Timer
'// Proceso
...
MsgBox "Elapse time = " & Format(Timer - t, "0.00")
Se redondea a dos decimales porque las milésimas de segundo son insignificantes. Debiera ejecutarse dos o tres veces para un estimado más preciso. Por supuesto, existen técnicas más precisas para evaluación de tiempos, pero esta suele ser aceptable.

Como saber si mi form esta abierto...
El procedimiento IsLoadForm retorna un bolean que indica si el formulario solicitado por su nombre se encuentra abierto. Opcionalmente se puede hacer activo si se encuentra en memoria. La función es útil en interfaces MDI.
Public Function IsLoadForm(ByVal FormCaption As String, Optional Active As Variant) As Boolean
Dim rtn As Integer, i As Integer
rtn = False
Name = LCase(FormCaption)
Do Until i > Forms.Count - 1 Or rtn
If LCase(Forms(i).Caption) = FormCaption Then rtn = True
    i = i + 1
    Loop
If rtn Then
    If Not IsMissing(Active) Then
        If Active Then
            Forms(i - 1).WindowState = vbNormal
        End If
    End If
End If
IsLoadForm = rtn
End Function

Mostrar el contenido de un TextBox a medida que vamos escribiendo...

En programas que ejecutan una tarea larga, me gusta agregar un texto de información al usuario a medida que las tareas se van ejecutando (al etilo de Autocad). La sigueinte técnica fuerza que el texto se muestre continuamente. Use un TextBox Multiline con barras Scroll y nombre txtReport.
'//API - en un modulo aparte...
Private Declare Function SendMessageByVal Lib "user32" Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long _
) As Long
Private Const EM_LINESCROLL As Long = &HB6
Private Const EM_GETLINECOUNT As Long = &HBA

Private Sub Echo(Optional s As String = "")
Static n As Long

On Error Resume Next

With txtReport
If Len(.Text) Then .Text = .Text & vbCrLf
.Text = .Text & s
'//To end of line (with API)
n = SendMessageByVal(.hWnd, EM_GETLINECOUNT, 0, 0)
SendMessageByVal .hWnd, EM_LINESCROLL, 0, n
DoEvents
End With
End Sub
NOTAS
1. Podría usar la línea SendKeys "^{END}", True pero produce un efecto colateral en Windows98 (la barra de las ventana pierde su color)
2. Si desea situar el cursor al final del texto use: txtReport.SelStart = Len(txtReport.Text)

Como contar los caracteres de una cadena...
Option Explicit
Function Cuantos(Inicio, Cadena As String, Caracter As String)
    Dim Resultado, sCuantos
    sCuantos = 0 'Inicializa la suma
        'evita que entre si no hay nada que buscar
    If IsNull(Cadena) Or IsNull(Caracter) Or Len(Cadena) = 0 Or Len(Caracter)= 0 Then Exit Function
        Resultado = InStr(Inicio, Cadena, Caracter) 'localiza la 1ª coincidencia
            Do While Resultado > 0 'y cuenta hasta que termina
                sCuantos = sCuantos + 1
                Inicio = Resultado + 1
                Resultado = InStr(Inicio, Cadena, Caracter)
            Loop
        Cuantos = sCuantos
End Function

Obligar a introducir solamente números (I)
Private Sub txtText1_KeyPress(KeyAscii As Integer)
'solo admitirá dígitos, el punto y la coma
'si se pulsa alguna otra tecla, anulará la pulsación de teclado
If InStr("0123456789.,", Chr(KeyAscii)) = 0 Then
    KeyAscii = 0
End If
End Sub
Sub Text1_Keypress(KeyAscii As Integer)
If KeyAscii <> Asc("9") Then
    'KeyAscii = 8 es el retroceso o BackSpace
        If KeyAscii <> 8 Then
            KeyAscii = 0
        End If
End If
End Sub

Obligar a introducir solamente números (II)
Private Sub txtText1_LostFocus()
If IsNumeric(txtText1) = False then
MsgBox "Lo siento. Debe Ingresar SOLAMENTE Números.",vbInformation,"Cuidado!"
txtText1.SetFocus
End If

Convertir números en texto

Esta función, convierte un número en su correspondiente trascripción a letras. Funciona bien con
números enteros y con hasta 2 decimales, pero más de 2 decimales se pierde y no "sabe" lo que dice.

Debes introducir este código en un módulo (por ejemplo) y realizar la llamada con el número que
deseas convertir. Por Ejemplo: Label1 = Numlet(CCur(Text1))

Option Explicit
Dim Unidades$(9), Decenas$(9), Oncenas$(9)
Dim Veintes$(9), Centenas$(9)

Function Numlet$(NUM#)
    Dim DEC$, MILM$, MILL$, MILE$, UNID$
    ReDim SALI$(11)
    Dim var$, I%, AUX$
    'NUM# = Round(NUM#, 2)
    var$ = Trim$(Str$(NUM#))
        If InStr(var$, ".") = 0 Then
            var$ = var$ + ".00"
        End If

        If InStr(var$, ".") = Len(var$) - 1 Then
            var$ = var$ + "0"
        End If
    var$ = String$(15 - Len(LTrim$(var$)), "0") + LTrim$(var$)
    DEC$ = Mid$(var$, 14, 2)
    MILM$ = Mid$(var$, 1, 3)
    MILL$ = Mid$(var$, 4, 3)
    MILE$ = Mid$(var$, 7, 3)
    UNID$ = Mid$(var$, 10, 3)
    For I% = 1 To 11: SALI$(I%) = " ": Next I%
    I% = 0
    Unidades$(1) = "UNA "
    Unidades$(2) = "DOS "
    Unidades$(3) = "TRES "
    Unidades$(4) = "CUATRO "
    Unidades$(5) = "CINCO "
    Unidades$(6) = "SEIS "
    Unidades$(7) = "SIETE "
    Unidades$(8) = "OCHO "
    Unidades$(9) = "NUEVE "

    Decenas$(1) = "DIEZ "
    Decenas$(2) = "VEINTE "
    Decenas$(3) = "TREINTA "
    Decenas$(4) = "CUARENTA "
    Decenas$(5) = "CINCUENTA "
    Decenas$(6) = "SESENTA "
    Decenas$(7) = "SETENTA "
    Decenas$(8) = "OCHENTA "
    Decenas$(9) = "NOVENTA "

    Oncenas$(1) = "ONCE "
    Oncenas$(2) = "DOCE "
    Oncenas$(3) = "TRECE "
    Oncenas$(4) = "CATORCE "
    Oncenas$(5) = "QUINCE "
    Oncenas$(6) = "DIECISEIS "
    Oncenas$(7) = "DIECISIETE "
    Oncenas$(8) = "DIECIOCHO "
    Oncenas$(9) = "DIECINUEVE "

    Veintes$(1) = "VEINTIUNA "
    Veintes$(2) = "VEINTIDOS "
    Veintes$(3) = "VEINTITRES "
    Veintes$(4) = "VEINTICUATRO "
    Veintes$(5) = "VEINTICINCO "
    Veintes$(6) = "VEINTISEIS "
    Veintes$(7) = "VEINTISIETE "
    Veintes$(8) = "VEINTIOCHO "
    Veintes$(9) = "VEINTINUEVE "

    Centenas$(1) = " CIENTO "
    Centenas$(2) = " DOSCIENTOS "
    Centenas$(3) = " TRESCIENTOS "
    Centenas$(4) = "CUATROCIENTOS "
    Centenas$(5) = " QUINIENTOS "
    Centenas$(6) = " SEISCIENTOS "
    Centenas$(7) = " SETECIENTOS "
    Centenas$(8) = " OCHOCIENTOS "
    Centenas$(9) = " NOVECIENTOS "

    If NUM# > 999999999999.99 Then Numlet$ = " ": Exit Function
        If Val(MILM$) >= 1 Then
            SALI$(2) = " MIL ": '** MILES DE MILLONES
            SALI$(4) = " MILLONES "
                If Val(MILM$) <> 1 Then
                    Unidades$(1) = "UN "
                    Veintes$(1) = "VEINTIUN "
                    SALI$(1) = Descifrar$(Val(MILM$))
                End If
        End If
        If Val(MILL$) >= 1 Then
            If Val(MILL$) < 2 Then
                SALI$(3) = "UN ": '*** UN MILLON
                    If Trim$(SALI$(4)) <> "MILLONES" Then
                        SALI$(4) = " MILLON "
                    End If
                Else
                    SALI$(4) = " MILLONES ": '*** VARIOS MILLONES
                    Unidades$(1) = "UN "
                    Veintes$(1) = "VEINTIUN "
                    SALI$(3) = Descifrar$(Val(MILL$))
                End If
        End If

    For I% = 2 To 9
        Centenas$(I%) = Mid$(Centenas(I%), 1, 11) + "AS"
    Next I%
        If Val(MILE$) > 0 Then
            SALI$(6) = " MIL ": '*** MILES
                If Val(MILE$) <> 1 Then
                    SALI$(5) = Descifrar$(Val(MILE$))
                End If
      End If
        Unidades$(1) = "UNA "
        Veintes$(1) = "VEINTIUNA"
            If Val(UNID$) >= 1 Then
                SALI$(7) = Descifrar$(Val(UNID$)): '*** CIENTOS
                    If Val(DEC$) >= 10 Then
                        SALI$(8) = " CON ": '*** DECIMALES
                        SALI$(10) = Descifrar$(Val(DEC$))
                    End If
            End If
            If Val(MILM$) = 0 And Val(MILL$) = 0 And Val(MILE$) = 0 And Val(UNID$) = 0 Then SALI$(7) = " CERO "
            AUX$ = ""
                For I% = 1 To 11
                    AUX$ = AUX$ + SALI$(I%)
                Next I%
       Numlet$ = Trim$(AUX$)
End Function

Function Descifrar$(numero%)
Static SAL$(4)
Dim I%, CT As Double, DC As Double, DU As Double, UD As Double
Dim VARIABLE$

    For I% = 1 To 4: SAL$(I%) = " ": Next I%
        VARIABLE$ = String$(3 - Len(Trim$(Str$(numero%))), "0") + Trim$(Str$(numero%))
        CT = Val(Mid$(VARIABLE$, 1, 1)): '*** CENTENA
        DC = Val(Mid$(VARIABLE$, 2, 1)): '*** DECENA
        DU = Val(Mid$(VARIABLE$, 2, 2)): '*** DECENA + UNIDAD
        UD = Val(Mid$(VARIABLE$, 3, 1)): '*** UNIDAD
        If numero% = 100 Then
            SAL$(1) = "CIEN "
        Else
            If CT <> 0 Then SAL$(1) = Centenas$(CT)
                If DC <> 0 Then
                    If DU <> 10 And DU <> 20 Then
                        If DC = 1 Then SAL$(2) = Oncenas$(UD): Descifrar$ = Trim$(SAL$(1) + " " + SAL$(2)) then                              Exit Function
                                If DC = 2 Then SAL$(2) = Veintes$(UD): Descifrar$ = Trim$(SAL$(1) + " " + SAL$(2)) then                                              Exit Function
                                End If
                            SAL$(2) = " " + Decenas$(DC)
                                If UD <> 0 Then SAL$(3) = "Y "
                        End If
                            If UD <> 0 Then SAL$(4) = Unidades$(UD)
                    End If
                        Descifrar = Trim$(SAL$(1) + SAL$(2) + SAL$(3) + SAL$(4))
            End Function

Convertir números romanos a árabes (no está probado)

Es muy fácil de utilizar, le pasas la cadena con el número en árabe y te devuelve el número,
necesitas las dos funciones que tienes a continuación.

Function ConvertirArabe(Romano As String) As Integer
Dim Numero As Integer, Valor1 As Integer, Valor2 As Integer, Cadena As String
    If Len(Romano) = 0 Then ConvertirArabe = 0: Exit Function
        Cadena = Trim(Romano)
        Numero = 0
        Do
            Valor1 = VerValor(left(Cadena, 1))
            Cadena = Right$(Cadena, Len(Cadena) - 1)
            Valor2 = VerValor(left(Cadena, 1))
                If Valor1 >= Valor2 Then
                    Numero = Numero + Valor1
                Else
                    Numero = Numero - Valor1
                End If
        Loop Until Len(Cadena) = 0
            ConvertirArabe = Numero
End Function

Function VerValor(Simbolo As String) As Integer
Select Case Simbolo
    Case "I"
        VerValor = 1
    Case "V"
        VerValor = 5
    Case "X"
        VerValor = 10
    Case "L"
        VerValor = 50
    Case "C"
        VerValor = 100
    Case "D"
        VerValor = 500
    Case "M"
        VerValor = 1000
    Case "Q"
        VerValor = 5000
    Case "H"
        VerValor = 10000
End Select
End Function

Convertir números romanos a árabes -2- (no está probado)

Function Num2Roman(ByVal N As Integer) As String
Const Digits = "IVXLCDM"
Dim i As Integer, Digit As Integer, Temp As String
i = 1
Temp = ""
    Do While N > 0
        Digit = N Mod 10
        N = N 10
    Select Case Digit
        Case 1
            Temp = Mid(Digits, i, 1) & Temp
        Case 2
            Temp = Mid(Digits, i, 1) & Mid(Digits, i, 1) & Temp
        Case 3
            Temp = Mid(Digits, i, 1) & Mid(Digits, i, 1) & Mid(Digits, i, 1) & Temp
        Case 4
            Temp = Mid(Digits, i, 2) & Temp
        Case 5
            Temp = Mid(Digits, i + 1, 1) & Temp
        Case 6
            Temp = Mid(Digits, i + 1, 1) & Mid(Digits, i, 1) & Temp
        Case 7
            Temp = Mid(Digits, i + 1, 1) & Mid(Digits, i, 1) & Mid(Digits, i, 1) & Temp
        Case 8
            Temp = Mid(Digits, i + 1, 1) & Mid(Digits, i, 1) & Mid(Digits, i, 1) & Mid(Digits, i, 1) & Temp
        Case 9
            Temp = Mid(Digits, i, 1) & Mid(Digits, i + 2, 1) & Temp
    End Select
i = i + 2
Loop
Num2Roman = Temp
End Function

Seleccionar todo el Texto al recibir el Foco

Insertar el siguiente Codigo en el evento GotFocus de un TextBox:
Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLenght = Len(Text1.Text)
End Sub

Convertir a Mayúsculas/Minúsculas segun vamos escribiendo
Insertar el siguiente Codigo en el evento Change de un control TextBox
                Private Sub Text1_Change()
                    Dim I as Integer
                    Text1.Text = UCase(Text1.Text)
                    I = Len(Text1.Text)
                    Text1.SelStart(I)
                End Sub
Nota: Si queremos convertir a minusculas, solo hay que cambiar UCase por LCase. Este codigo convierte a mayusculas/minusculas segun vamos escribiendo.-

Validar Fechas
Sub ValidarFecha(Fecha As String, valida As Boolean)
Dim cadena As Date On Error GoTo error
cadena = Format(Fecha, "dd/mm/yyyy")
If Not IsDate(cadena) Then
    MsgBox "Compruebe que ha introducido bien la fecha.", vbInformation
    Exit Sub
End If
If cadena > Date Then
    valida = True
    GoTo error
Else
    valida = False
End If
    Exit Sub
error:
MsgBox "La fecha no puede ser posterior a la fecha de hoy.",
    vbInformation, "Fecha inválida"
    valida = True
    Exit Sub
End Sub

Pasar de Decimal a Binario
Function DecimalABinario(ByVal valor As Long) As String
' Declaración de variables privadas a la función
Dim mayor As Integer
Dim retorno As String
Dim a As Integer

' Localizamos el mayor exponente
mayor = 0
Do While True
    If 2 ^ mayor > valor Then
        If mayor > 0 Then
            mayor = mayor - 1
        End If
        Exit Do
    End If
mayor = mayor + 1
Loop

' Calculamos el valor binario
retorno = ""
For a = mayor To 0 Step -1
    If valor < (2 ^ a) Then
        retorno = retorno & "0"
    Else
        retorno = retorno & "1"
        valor = valor - (2 ^ a)
    End If
Next a
DecimalABinario = retorno
End Function

Verificar si una Ventana "X" está cargada
Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" ( _
ByVal lpszClassName As String, ByVal lpszWindow As String) As Long
Llamaremos la función con un:
If FindWindow(vbNullString, Caption) Then
'//Esta abierta ventana con titulo Caption
End If

Sirve para ventanas dentro y fuera de la aplicación, es decir, la usaremos para verificar si un formulario ya a sido cargado o para saber si CALC.EXE esta abierto. Como un detalle, vbNullString es lo que en C se conoce como un puntero nulo, estrictamente el parámetro es la clase de la ventana. También puede ser de utilidad saber que FindWindow retorna el manejador hWnd si la ventana esta abierta.

Inhabilitar por un ratito los botones de la barra Inicio:

Los eventos Resize suelen tener ejecución asíncrona. Cuando un formulario utiliza controles ActiveX complejos (léase acceso a datos) que toman acciones de redimensionamiento, pueden fallar si el usuario, por ejemplo, maximiza la ventana antes de que termine de cargarse el formulario, o situaciones similares. La siguiente técnica permite evitar este efecto.
'//Protect while loading
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const WS_SYSMENU = &H80000

Public Sub EnabledToolBoxMenu(frm As Form, Action As Boolean)
Static rtn, rtnI
If Action Then
If rtnI Then
rtn = SetWindowLong(frm.hwnd, GWL_STYLE, rtnI)
End If
Else
rtnI = GetWindowLong(frm.hwnd, GWL_STYLE)
rtn = rtnI And Not (WS_SYSMENU)
rtn = SetWindowLong(frm.hwnd, GWL_STYLE, rtn)
End If
End Sub
La forma correcta de usar el procedimiento es la siguiente:
Private Loading
Private Sub Form_Load()
Loading=True
'//Código de carga...
Loading=False
EnabledToolBoxMenu Me, True
End Sub
Private Sub Form_Activate()
If Loading Then
EnabledToolBoxMenu Me, False
End If
End Sub
NOTA. Se pueden inhabilitar / habilitar separadamente los bótones. API suministra otras constantes similares a WS_SYSMENU. Ver documentación de SetWindowLong.

Ocultar el Puntero del Mouse

Para este ejemplo agregue un Timer a un formulario y fije la propiedad Interval a 3000. Cada 3 segundos se ocultará el Mouse.

Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long

Private Sub Timer1_Timer()
Static HideMouse As Boolean
HideMouse = Not HideMouse
ShowCursor HideMouse
End Sub

NOTA. No esta garantizado que ShowCursor produzca el efecto deseado.

Ejecutar un programa DOS desde VB
Private Sub Command1_Click()
Shell "C:WINDOWSCOMMANDEDIT.COM", vbNormalFocus
End Sub

Una unica instancia de la aplicacion corriendo a la vez...
En el Sub Main() o en el Form_Load del 1er frm que cargues:
If App.Previnstance Then
MsgBox "La aplicacion solicitada ya se esta ejecutando"
'Pon aqui el codigo para salir del programa
'(Unload de los formularios cargados, set .. = nothing, etc.)
End
End If

Ejecutar Microsoft Word desde VB
Hay que hacer automatización, o sea, instanciar un objeto Word
Dim oWord as new Word.ApplicationoWord.Visible = True 'Si quieres abrir un documento en blanco o uno concreto
oWord.Documents.Add
oWord.Documents.Open "<PathNombre del documento>"

Bloquear el Boton Inicio, Crtl + Tab y Ctrl + Alt + Supr
Declarar en un Módulo lo siguiente:
Public 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
(Ojo, toda esta declaracion debe estar en una sola linea!!)
En el Evento Click del Form1 colocar lo siguiente:
Sub Form_Click()
     Dim blnOld as Boolean
    If MsgBox ("Desea Bloquear ahora?", vbInformation + vbYesNo, "Bloqueo") = vbYes then
        SystemParametersInfo 97&, True, blnOld, 0&
    Else
        SystemParametersInfo 97&, False, blnOld, 0&
    End If
End Sub

Activar/Desactivar el Bloqueo de Mayusculas
Solamente necesitamos declarar en un Modulo lo siguiente:
Public Declare Function GetKeyboardState Lib "user32" Alias "GetKeyboardState" (pbKeyState As Byte) As Long
Public Declare Function SetKeyboardState Lib "user32" Alias "SetKeyboardState" (lppbKeyState As Byte) As Long
Public Type KeyboardBytes
    kbByte(0 To 255) as Byte
End Type
En el Evento Click de la ventana (Form) colocaremos el siguiente codigo y nos fijaremos en la actitud de
la lucecita del Bloqueo de Mayusculas...
Private Sub Form_Click()
    Dim kbArray as KeyboardBytes
    GetKeyboardState kbArray
    kbArray.kbByte(&H14) = IIF(kbArray.kbByte(&H14) = 1, 0, 1)
    SetKeyboardState kbArray
End Sub

Cómo Activar el Protector de Pantallas?
En un modulo, declarar lo siguiente:
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
y en el evento click de un boton:
Private Sub Command1_Click()
Call SendMessage(Me.hWnd, &H112, &HF140, 0&)
End Sub

Ocultar / Mostrar la Barra de Herramientas de WIn95/NT
Poner el siguiente Codigo en un Modulo:
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" (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
Global Ventana as Long
Global Const Muestra = &H40
Global Const Oculta = &H80
(NOTA: Las dos declaraciones deben estar en una misma Linea)

       Poner dos (2) botones en un Form y escribir:
Private Sub Command1_Click()
        Ventana = FindWindow("Shell_Traywnd", " ")
        Call SetWindowPos(Ventana, 0, 0, 0, 0, 0, Oculta)
End Sub

Private Sub Command2_Click()
        Call SetWindowPos(Ventana, 0, 0, 0, 0, 0, Muestra)
End Sub

Cambiar el Papel Tapiz de Win95
Insertar el siguiente Codigo en un 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
Nota: Debe estar todo en una sola linea (Usar el Visor de Texto API, que viene con Visual Basic)
Insertar el siguiente Codigo en el evento Click de un CommandButton
Private Sub Command1_Click()
Dim Cambio as Integer
Cambio = SystemParametersInfo(20, 0, "C:WindowsNubes.bmp", 0)
End Sub

Vaciar la Carpeta de Documentos Recientes
Insertar el siguiente Codigo en un Modulo:
Public Declare Function SHAddToRecentDocs Lib "Shell32" (ByVal lflags As Long, ByVal lpv As Long) As Long
Nota: Debe estar todo en una sola linea (Usar el Visor de Texto API, que viene con Visual Basic)
Insertar el siguiente Codigo en el evento Click de un CommandButton
Private Sub Command1_Click()
SHAddToRecentDocs 0, 0
End Sub
Nota: Esta sentencia No figura en el archivo de texto WinAPI, por lo que deberán tipearla tal cual está.-

Abrir el Ayudante para Agregar/Quitar Programas
Insertar el siguiente Codigo en el evento Click de un CommandButton
Private Sub Command1_Click()
X = Shell ("Rundll32.exe Shell32.dll, Control_RunDLL addwiz.cpl @0")
End Sub

Mandar un E-Mail llamando a la aplicacion por Default
En un Modulo colocar:
Public 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
Public Const SW_SHOW = 5
En el evento click de un boton...
Private Sub Command1_Click()
    Dim X as Long
    X = ShellExecute hWnd, "open", "mailto:lmbeber@hotmail.com", vbNullString, vbNullString, SW_SHOW
End Sub

Apagar, Reiniciar el Equipo, Reiniciar Windows
Agregar el siguiente codigo a un Modulo:
Declare Function ExitWindowsEx Lib "user32" Alias "ExitWindowsEx" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Nota: Debe estar todo en una sola linea (Usar el Visor de Texto API, que viene con Visual Basic)
Agregar el siguiente codigo a tres commandbutton definidos para la prueba, con la propiedad Name segun se describe:
Command1 - cmdApagar
Command2 - cmdReiniciarWindows
Command3 - cmdReiniciarEquipo
El codigo a escribir es el siguiente:
Private Declare Sub cmdApagar_Click()
        Dim i As Integer
        i = ExitWindowsEx(1, 0&)
End Sub
Private Declare Sub cmdReiniciarWindows_Click()
        Dim i As Integer
        i = ExitWindowsEx(0, 0&)
End Sub
Private Declare Sub cmdReiniciarEquipo_Click()
        Dim i As Integer
        i = ExitWindowsEx(2, 0&)
End Sub

Interceptar CRTL + ALT + DEL
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
(Recordar que todas las declaraciones de funciones deben declararse en una sola línea y que habitualmente es mas facil encontrarlo en el archivo WINAPI32.TXT con el Visor de Texto API...)
Private Sub Command1_Click()
Dim res As Integer
Dim bVal As Boolean
If Command1.Caption = "Activado" Then
    Command1.Caption = "Desactivado"
    res = SystemParametersInfo(97, True, bVal, 0)
Else
    Command1.Caption = "Desactivado"
    res = SystemParametersInfo(97, False, bVal, 0)
End If
End Sub

Interceptar CRTL + ALT + DEL II
Private Const SPI_SCREENSAVERRUNNING = 97&
Private Declare Function SystemParametersInfo Lib "User32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
(Recordar que todas las declaraciones de funciones deben declararse en una sola línea y que habitualmente es mas facil encontrarlo en el archivo WINAPI32.TXT con el Visor de Texto API...)
Para deshabilitar estas teclas:
Dim lngRet As Long
Dim blnOld As Boolean
lngRet = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, blnOld, 0&)
Para volver a habilitarlas:
Dim lngRet As Long
Dim blnOld As Boolean
lngRet = SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, blnOld, 0&)
Como recomendación final: asegurate que en el Form_Unload que tengas, haga una llamada a la rutina que vuelve a habilitar estas teclas, así todo volverá a estar como debiera.

Como Recibir Articulos de la Base de Conocimientos de Microsoft?
Si bien esto no es un truco, pero es bastante dificil obtener informacion de parte de los "Dueños del Mundo"
asi es que, buscando por ahi, recibí esta noticia:
Se debe enviar un mensaje a: mshelp@microsoft.com colocando en el "Asunto" Index, para que nos manden el Indice general, o bien el numero del articulo solicitado (ej: mshelp@microsoft.com subject:Q111000)

Número de Serie de un Disco...
Para poder detectar cual es el número de serie, deberemos utilizar una llamada a la API (cuando no?)
que se llama GetVolumeInformation... de la siguiente manera:
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
(todo en una sola lína, no olvidar)
y en el form...
NVolSize = 0: NVolNumber = 0: NMaxCompLength = 0
NFileSFlags = 0: NFileSBuffer = 0: NFileSNames = 0
Ruta = UCase(Left(Ruta, 1)) & ":"
ChDrive Ruta
Nombre = Dir(Ruta, vbVolume)
ret = GetVolumeInformation(Ruta, Nombre, NVolSize, NVolNumber, NMaxCompLength, _
NFileSFlags, NFileSBuffer, NFileSNames)
If ret = 0 Then Label1.Caption = "Numero de Serie del Volumen : " & Left(Hex(NVolNumber), 4) & "-" & Right(Hex(NVolNumber), 4) & vbCrLf & "Nombre del Volumen : " & Nombre

Como saber el Espacio libre del Disco
Crear un módulo y escribir:
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
Private Sub Form_Load()
Dim I1 As Long
Dim I2 As Long
Dim I3 As Long
Dim I4 As Long
Dim Unidad As String
Unidad = "C:/"
GetDiskFreeSpace Unidad, I1, I2, I3, I4
Label1.Caption = Unidad
Label2.Caption = I1 & " Sectores por cluster"
Label3.Caption = I2 & " Bytes por sector"
Label4.Caption = I3 & " N£mero de clusters libres"
Label5.Caption = I4 & " N£mero total de clusters"
Label6.Caption = "Espacio total en disco: " & (I1 * I2 * I4)
Label7.Caption = "Espacio libre en disco: " & (I1 * I2 * I3)
End Sub

(Nota: Este código vale igualmente para los CD-ROM y disquetes. La letra de la unidad puede estar en letra minúscula o mayúscula).

Comprobar si el Protocolo TCP/IP está instalado
Si bien esta no es una solución no muy buena, pero por lo menos sirve...
Mediante acceso a la API, puedes abrir el entorno de red para ver que es lo que hay instalado, y si el TCP/IP
no lo está ,que lo haga el usuario...
El código referente a esto es....
X = Shell("Rundll32.exe shell32.dll,Control_RunDLL NetCPL.cpl @0")

Cómo ejecutar comandos DOS en Win95
dim a
a = Shell("command.com /k dir")
Esto hará que se ejecute el comando DIR y queda la ventana DOS minimizada.
Si se reemplaza la /k por una /c el comando se ejecuta y la ventana DOS se cierra.
Shell ("c:windowscommanddeltree.exe c:eldirectorio a borrar")
Este ejemplo hara que eliminemos un directorio completo... quizas alguien deberia probar con "/y" luego de deltree.exe para ver si pregunta o no... (Escucho comentarios)

Mover un Archivo a la Papelera en lugar de usar KILL
Crear un formulario y escribir el siguiente código (en las declaraciones Generales):
Private Type SHFILEOPSTRUCT
    hWnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Boolean
    hNameMappings As Long
    lpszProgressTitle As String
End Type
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40

Public Sub PapeleraDeReciclaje(ByVal Fichero As String)
Dim SHFileOp As SHFILEOPSTRUCT
Dim RetVal As Long
With SHFileOp
    .wFunc = FO_DELETE
    .pFrom = Fichero
    .fFlags = FOF_ALLOWUNDO
End With
RetVal = SHFileOperation(SHFileOp)
End Sub
Private Sub CommandButton1_Click()
PapeleraDeReciclaje "c:a.txt"
End Sub
El programa preguntará si deseamos o no eliminar el archivo y enviarlo a la papelera de reciclaje. El parámetro .fFlags nos permitirá recuperar el fichero de la papelera si lo deseamos. Si eliminamos esta línea, el fichero no podrá ser recuperado.

Deshabilitar el ingreso de texto en ciertos TextBox...
Private Sub txtCampo_KeyPress(KeyAscii As Integer)
keyascii=0
End Sub

Ejecutar Word con un Archivo "X"
Declare Function ShellExecute Lib "shell32.dll" (ByVal hwnd As Integer, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Lonf) As Long
En un Form... (o un boton...)
Dim X as Long
X = ShellExecute(Me.hWnd, "Open", "PathDeTuDocumentodocumento.doc", "", "c:", 1)
Se puede usar para enviar un correo...
X = ShellExecute(Me.hWnd, "Open", "mailto:lmbeber@lucasnet.com.ar", "", "c:", 1)
O abrir una página Web...
X = ShellExecute(Me.hWnd, "Open", "http://lucasnet.com.ar", "", "c:", 1)
O cualquier otro archivo
X = ShellExecute(Me.hWnd, "Open", "c:windowsmibmp.bmp", "", "c:windows", 1)
A esta función tu le proporcianarás un archivo y ella se encargará de buscar y ejecutar la aplicación relacionada. Es casi mágica... (es como el sueño de cualquier programador, no?)
Para ejecutar la aplicación de alguna forma deseada puedes usar los siguientes valores de nShowCmd:
Const SW_HIDE As Long = 0
Const SW_SHOWNORMAL As Long = 1
Const SW_SHOWMINIMIZED As Long = 2
Const SW_SHOWMAXIMIZED As Long = 3
Const SW_SHOWNOACTIVATE As Long = 4
Const SW_SHOW As Long = 5
Const SW_MINIMIZE As Long = 6
Const SW_SHOWMINNOACTIVE As Long = 7
Const SW_SHOWNA As Long = 8
Const SW_RESTORE As Long = 9
Const SW_SHOWDEFAULT As Long = 10

Escuchar un Archivo MIDI / WAV
Insertar el siguiente Codigo en un Modulo:
Declare Function mciExecute Lib "winmm.dll" ( ByVal lpstrCommand As String)
Insertar el siguiente codigo en el boton del formulario:
Private Sub Command1_Click()
iResult = mciExecute(" Play C:WINDOWSRINGIN.WAV")
End Sub

Escuchar un Archivo MIDI / WAV (2)
Primero tienes que insertar un MMControl en el formulario.
Luego, en propiedades lo haces invisible.
Haz doble click en el formulario y activa la opción LOAD, que se refiere a cuando se carga el formulario.
Finalmente escribe lo siguiente:

MMCONTROL1.FILENAME=("ruta y nombre del archivo Mid")
MMCONTROL1.COMMAND=OPEN 'para abrir el control
MMCONTROL1.COMMAND=PLAY 'para iniciar la ejecución
MMCONTROL1.COMMAND=STOP 'para parar la ejecución
MMCONTROL1.COMMAND=CLOSE 'para cerrar el control

Abrir / Cerrar la Unidad de CD

El procedimiento para lograr esto es el siguiente:

En la sección Declaraciones de un Form, colocar el siguiente código: (podes sacarlo de el API Viewer /Visor de Texto API): (Todo debe ir en una sola linea...!)

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

En el mismo form (ej.: form1) colocar dos botones: Abrir y Cerrar.
En el codigo del boton Abrir, colocamos el siguiente codigo:

ret = mciSendString("set CDAudio door open", returnstring, 127, 0)

Y en el codigo del boton Cerrar, colocamos el siguiente codigo:

ret = mciSendString("set CDAudio door closed", returstring, 127, 0)

Listo!!

Imprimir una imagen

Ejemplo.
El modo de escala en que se trabaja es Pixeles, el modo de impresión es Centímetros, y se imprimirá el contenido creado en un PictureBox usando métodos gráficos (PSet, Line, Circle, ...). Si se desea imprimir el Picture, simplemente en vez de Image, usamos Picture (esta resaltado con cursiva). Se imprime en una área de 4 por 4 cm, con margen 1 cm a la izquierda, 1 cm arriba.
ptrX1 = 1 '//cm
ptrX2 = 5 '//cm
ptrY1 = 1 '//cm
ptrY2 = 5 '//cm
...
With pic_AnyName
Printer.ScaleMode = vbCentimeters
.Parent.ScaleMode = vbCentimeters
.ScaleMode = vbCentimeters
Printer.PaintPicture .Image, _
ptrX1, ptrY1, (ptrX2 - ptrX1), (ptrY2 - ptrY1), _
0, 0, .Width, .Height, vbSrcCopy
.Parent.ScaleMode = vbPixels
.ScaleMode = vbPixels
End With

Imprimir archivos "PRN"
Los archivos PRN son trabajos de impresora generados por Windows en conjunto con el Driver de alguna Impresora. Para generarlos, creamos una Impresora con salida a archivo. Así, podemos generar un archivo de impresora en vez de enviar directamente la salida a Printer. El siguiente procedimiento ejecuta la tarea de Impresión:
Private CancelPrinting As Boolean

Private Sub PrintPRNFile(PRNFile As String)
Const Buffer As Long = 8192

Dim Chunk As String
Dim numLoops As Long
Dim LeftOver As Long
Dim i As Long
Dim FCnl As Long
Dim PCnl As Long

On Error GoTo SubErr

'//Abre el archivo y el port de impresora
Screen.MousePointer = vbHourglass
CancelPrinting = False
FCnl = FreeFile
Open PRNFile For Binary Access Read As #FCnl
PCnl = FreeFile
Open CStr(Printer.Port) For Binary Access Write As #PCnl

'//Calcula el tamaño del archivo
numLoops = LOF(1) Buffer
LeftOver = LOF(1) Mod Buffer

'//lo imprime
Chunk = Space$(Buffer)
For i = 1 To numLoops
Get #FCnl, , Chunk
Put #PCnl, , Chunk
DoEvents
If CancelPrinting Then Exit For
Next
If Not CancelPrinting Then
Chunk = Space$(LeftOver)
Get #FCnl, , Chunk
Put #PCnl, , Chunk
End If

EndSub:
Close #FCnl, #PCnl
Screen.MousePointer = vbDefault
Exit Sub

SubErr:
MsgBox Err.Description, vbInformation, "Impresion del archivo..."
Resume EndSub
End Sub
RECOMENDACIONES.
Es conveniente colocar un Botón para configurar la Impresora antes de enviar el trabajo (un archivo de impresora debe ejecutarse con el mismo controlador de la impresora que lo creo). Adicionamos un control CommonDialog, y:
Private Sub cmdConfig_Click()
cdlPrinterSetup.Flags = cdlPDPrintSetup
cdlPrinterSetup.ShowPrinter
DoEvents
End Sub
También es conveniente crear la opción de cancelar:
Private Sub cmdCancel_Click()
CancelPrinting = True
End Sub

Impresion Directa con VB?
Private Sub Command1_Click()
Open "LPT1" For Output As #1
Print #1, Chr(27) & "W" & Chr(1); "Hola, mundo" & Chr(27) & "W" &
Chr(0) 'Imprime en ancho doble
Print #1, Chr(15) & "Nro. de boleta" & Chr(17) 'Imprime condensado
Close #1
End Sub

Imprimir un TextBox en lineas de X caracteres...
Añade un TextBox con las propiedades "Multiline=True" y "ScrollBars=Vertical", y
un CommandButton. Haz doble click sobre él y escribe este código:
Private Sub Command1_Click()
'X es 60 en este ejmplo
ImprimeLineas Text1, 60
End Sub
Public Sub ImprimeLineas(Texto As Object, Linea As Integer)
Dim Bloque As String
    'Numero de caracteres = NumC
    'Numero de Bloques = NumB
Dim NumC, NumB As Integer
NumC = Len(Texto.Text)
    If NumC > Linea Then
        NumB = NumC Linea
        For I = 0 To NumB
            Texto.SelStart = (Linea * I)
            Texto.SelLength = Linea
            Bloque = Texto.SelText
            Printer.Print Bloque
       Next I
   Else
        Printer.Print Texto.Text
   End If
        Printer.EndDoc
End Sub

Imprimir en modo apaisado/vertical:
printer.Orientation=vbPRPRPPortrait 'horizontal
printer.Orientation=bPRPLandScape 'vertical

Lanzar (o imprimir) un documento de Word cualquiera
Con este código, Word no se abre, imprime el doc, se cierra y libera memoria
Private Sub Command1_Click()
Dim AppWord As Word.Application
Dim DocWord As Word.Document
'Asignamos el documento
Set AppWord = CreateObject("word.application")
Set DocWord = AppWord.Documents.Open("C:hola.doc")
'Colocamos el texto en el marcador
DocWord.Bookmarks("NombreCreador").Select
AppWord.Selection.TypeText Text:=Text1.Text
'Imprimimos en segundo plano
AppWord.Documents(1).PrintOut Background
'Comprobamos que Word no sigue imprimiendo
Do While AppWord.BackgroundPrintingStatus = 1
Loop
'Cerramos el documento sin guardar cambios
AppWord.Documents.Close (wdDotNotSaveChanges)
'Liberamos
Set DocWord = Nothing
'Nos cargamos el objeto creado
AppWord.Quit
Set AppWord = Nothing
End Sub

Imprimir el contenido de un RichTextBox tal como se ve:
Insertar el siguiente Codigo en el evento Click de un CommandButton
Private Sub Command1_Click()
    On Error GoTo ElError
    Printer.Print " "
    RichTextBox1.SelPrint Printer.hDC
    Printer.EndDoc
ElError:
    End Sub

Imprimir en modo Condensado...
En Visual Basic no es necesario enviar códigos de escape como en otros lenguajes para DOS. En Visual y con el objeto printer se puede cambiar la propiedad fontname, fontsize, etc. Por ejemplo, quieres que salga pequeña, el codigo a escribir seria el siguiente:

printer.fontname="Arial" 'u omites esta línea
printer.fontsize=8 'Sale con un tamaño de 8
printer.print "Prueba de impresión"
Ten en cuenta que también es según la impresora. Si es sólo texto si tendrás que usar los códigos de escape pero ya como en otros lenguajes:
printer.print chr$(9) 'creo que era el 9 para imprimir.

Imprimir con todo (incluyendo el tipo de letra, bold, negrita, etc.)
En Vb5 a veces hay problemas con el cambio de Fuentes asi que define esta rutina y seguramente no tendras problemas. Deberiamos declarar el procedimiento en un Modulo y utilizarla cuando queramos
Sub CambiarFuente(Letra, Tamaño, Negrita, Subrayado, Italica As Variant) As Variant
Dim X As New StdFont
With X
    .Name = Letra
    .Size = Tamaño
    .Bold = Negrita
    .Underline = Subrayado
    .Italic = Italica
End With
Set Printer.Font = X
End Sub
Cuando la necesites la llamas asi enviando el nombre de la fuente, el tamaño , Negrita True/False, Subrayado True/False, Italica True/False
Call CambiarFuente("Arial", 12, True, True, True)

Anular el Salto de Pagina
Hemos realizado una aplicación y queremos que imprima UNA UNICA LINEA ante determinados eventos y que no haga salto de página... (nos ha pasado?)
Hemos probado con el ENDDOC pero es lento (si solo espera imprimir una linea) y ademas hece salto de página por cada linea escrita.
Pues bienSe puede imprimir utilizando el puerto paralelo con tres funciones de la API:
-CreateFile
-WriteFile
-CloseHandle
Por Ejemplo:
Private Sub Command1_Click()
Dim res As Long
Dim Linea As String
Dim NumBytes As Long
Dim BytesEscritos As Long
hImpresora = CreateFile("LPT1", GENERIC_WRITE, 0, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, &HFFFFFFFF) 'Esto va en una sola linea...
NumBytes = Len(Text1.Text)
Linea = String(NumBytes + 2, 0)
Linea = Text1.Text + Chr$(13) + Chr$(10)
NumBytes = NumBytes + 2
res = WriteFile(hImpresora, Linea, NumBytes, BytesEscritos, ByVal 0&)
res = CloseHandle(hImpresora)
End Sub
las declaraciones de las funciones son (varían un poco respecto a las del API viewer):
Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Imprimir un Bitmap sin el Form que lo contiene
    Imaginemos la cara que pondria un usuario de Paintbrush o Corel o cualquier otro producto gráfico, si al imprimir un gráfico, le saliera también la ventana que lo contiene, con la barra de herramientas, menues y demás...
    - Oiga... yo quiero que salga solo el gráfico...
    - Está bien, pero Visual Basic solo imprime el Form, asi que...
    Afortunadamente (para todos nosotros, los programadores), tenemos acceso desde VB a funciones que no son propias de VBasic, sino de Windows. Concretamente a la función BitBlt puede ayudarnos a pasar ese mal momento y sin mayores complicaciones.
    La mayor parte de estas funciones (que se parecen más a C / C++ que a VBasic) las podemos encontrar en el ApiViewer que viene con Visual Basic...

Colocamos un Picture en un Form...
Colocamos al Picture la propiedar AutoRedraw en True...
Cargamos una imágen (tiempo de diseño/ejecución) al picture...
Insertamos un Módulo y en él escribimos el siguiente código:

Public Const SRCCOPY = &HCC0020
Public Const NEWFRAME = 1
Public Const PIXEL = 3

'las líneas siguientes, deben estar cin cortes, es decir en una sola linea.
Public Declare Function CreateCompatibleDC Lib "gdi32" Alias "CreateCompatibleDC" (ByVal hdc As Long) As Long

Public Declare Function SelectObject Lib "gdi32" Alias "SelectObject" (ByVal hdc As Long, ByVal hObject As Long) As Long

Public Declare Function StretchBlt Lib "gdi32" Alias "StretchBlt" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

Public Declare Function DeleteDC Lib "gdi32" Alias "DeleteDC" (ByVal hdc As Long) As Long

Public Declare Function Escape Lib "gdi32" Alias "Escape" (ByVal hdc As Long, ByVal nEscape As Long, ByVal nCount As Long, ByVal lpInData As String, lpOutData As Any) As Long

En un Command Button, agregamos el siguiente código:

Private Sub Command1_Click()
Screen.MousePointer = 11 'reloj de arena... se puede usar vbHourGlass
Picture1.Picture = Picture1.Image
'la función StretchBlt necesita coordenadas en Pixeles...
Picture1.ScaleMode = PIXEL
Printer.ScaleMode = PIXEL
Printer.Print " "

hMemoryDC% = CreateCompatibleDC(Picture1.hDC)
hOldBitMap% = SelectObject(hMemoryDC%, Picture1.Picture)

ApiError% = StretchBlt(Printer.hDC, 0, 0, Printer.ScaleWidth, Printer.ScaleHeight,_
hMemoryDC%, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, SRCCOPY)

hOldBitmap% = SelectObject(hMemoryDC%, hOldBitmap%)
ApiError% = DeleteDC(hMemoryDC)

Result% = Escape(Printer.hDC, NEWFRAME, 0, Null, Null)
Printer.EndDoc
Screen.MousePointer = vbDefault 'devolvemos el puntero como estaba.

Si analizamos el código, vemos cuatro fases:

Creamos un contexto de dispositivo compatible con el bitmap que tenemos en el Picture1 mediante la función CreateCompatibleBitmap. Un contexto de dispositivo es un bloque de memoria que usa Windows para representar una superficie de la pantalla. La impresion no es sino una copia de datos entre un dispositivo compatible y la impresora.
Guardamos el objeto actual (SelectObject) y seleccionamos el control Picture1 usando el manejador de contexto del dispositivo de memoria.
Usamos la función StretchBlt para copiar un Bitmap del dispositivo compatible hasta la impresora.
Liberamos los recursos que usamos, es decir el bitmap (SelectObject) y el dispositivo de pantalla (DeleteDC)

Scroll Animado
    Esta es una rutina en Java Script que nos permite tener una animación de texto en la barra de estado del browser que estemos utilizando.
<Script Language="JavaScript">

    </Script>
y listo... A probarlo, viejo, que yo no tengo tiempo... Escucho comentarios!

Modificar el Outlook Express desde el Registro...
    Podremos: Eliminar la pantalla de bienvenida...
                   Cambiar el título a la ventana...
                   Borrar la Password de Acceso...

Eliminar la pantalla de bienvenida...

Vamos al Editor del registro del sistema (Regedit), en la rama HKEY_CURRENT_USER/SOFTWARE/ Microsoft/Outlook Express.
Creamos un nuevo valor DWORD, llamado NoSplash y le camos el valor 1.
Con esto no aparecerá la pantalla de bienvenida de Outlook Express.

Cambiar el título a la Ventana:
Vamos al editor del registro del sistema (Regedit), y buscamos la rama:
HKEY_CURRENT_USERSoftwareMicrosoftOutlook Express. Creamos una entrada (Nuevo Valor de la cadena) llamada WindowTitle (así, todo junto) y le ponemos el nombre que mas nos guste.

Cambiar el título a la Ventana:
Vamos al editor del registro del sistema (Regedit), y buscamos la rama:
HKEY_LOCAL_MACHINESoftwareMicrosoftwindowscurrentVersionpolicies...
Aqui pulsamos en RATTINGS y aparecerán dos valores: Default y Key. El que borramos es el Key, y luego reiniciamos Windows 95/98. Vamos al panel de control, Internet, Propiedades, Seguridad, Asesor de Contenidos, pulsamos en Configuración y listo...!

Arrancar programas desde el ICQ
Muchas veces, deseamos tener una función que nos inicie programas (como el correo electrónico) en el momento en que nos conectamos a Internet. Si usamos el ICQ (click para ir al sitio) es posible que, cuando se detecta una conexión, además de cargarse a si mismo, cargue otros programas. Sólo tenemos que ir a Menú ICQ, Preferences/Connection/Edit Launch List...
Esto es de mucha utilidad para no gastar memoria en programas de Internet (como GetRight) mientras estemos conectados.

Un Tal Chamo

junio 24, 2012