danimay1993

Aca he hecho una busqueda de cuales son los mejores antivirus para que sepan cual es el que les conviene mejor en su computadora. LOS 13 MEJORES ANTIVIRUS PARA ESTE 2009 1.- Kaspersky Anti-Virus 2009 2.- ESET NOD32 Anti-Virus 3.0 3.- AVG Anti-Virus 8.0 4.- McAfee VirusScan Plus 12.1 5.- AVIRA AntiVir Premium 8.1 6.- avast! Professional Edition 4.8 7.- F-Secure Anti-Virus 2009 8.- G DATA AntiVirusKit (AVK) 2009 9.- eScan Anti-Virus 9.0 10.- BitDefender Antivirus 11 11.- Norman Antivirus Anti-Spyware 7.1 12.- TrustPort Antivirus Workstation 2.8 Estos son los mejores 13 para mi no se austede. opinen

Trucos para telefonos moviles nokia, secretos de los móviles nokia y sus diferentes verciones, como saber el imei, activar y desactivar servicios, aumento de la calidad del sonido en móviles móviles nokia, duración de bateria... Para saber el IMEI: Para ver el IMEI debes Teclear en tu movil *#06#. Aparecerá el IMEI en pantalla Para activar / Desactivar reloj SIM: Para activar o desactivar el reloj sim pulsa sobre la pantalla principal de tu móvil *#746025625#. Aumentar el tamaño de la letra en la agenda: Cuando estes sobre un nombre en la agenda, mantén presionada la tecla #. Activar / Desactivar ERF (Enhaced Full Rate): Los teléfonos GSM sólo emiten hacia la antena cuando éste detecta que se habla, por eso en ocasiones se oye entrecortado. Al activarlo aumenta la calidad del sonido pero se gasta mas bateria. Pulsa #3370#, el móvil se reiniciará Activar / Desactivar HFR (Half Rate Mode): Si activamos el HFR, el teléfono emite la señal en períodos más intermitentes, con lo que la calidad de sonido baja, incluso mas que al activar o desactivar el EFR. Lo que se consigue es aumentar la duración de la batería hasta un 30%. Pulsa #4720#, el móvil se reiniciará Para Ver la garantía y algunos datos internos del movil: Pulsa *#92702689#, para salir debes reiniciar el móvil ya que sino no podrás salir. Para ver la versión del software escribe sobre la pantalla principal del móvil *#0000#. Para ocultar el numero de telefono al hacer una llamada Pulsa #31# Para ir al menu de servicios pulsa *#92702689#, podras ver Nº de serie del teléfono, la Fecha de fabricación, Fecha de compra , Fecha de la última reparación, Transfer User Data (sirve para transferir la informacion o otro modelo) y el Life Timer que es el tiempo que lleva encendido NOKIA 1611 *#06# Muestra el IMEI del teléfono. *#170602112302# Versión de software cargada. *#9277689# Pregunta: Warranty code? si ponemos algunos de los codes de abajo. 6232 Fecha de fabricación 7332 Fecha de reparación 7832 Fecha de compra 9268 Numero de serie 37832 Fecha de compra 87267 Transferencia de datos -------------------------------------------------------------------------------- NOKIA 3110 *#06# Muestra IMEI. *#3110# Versión de software. -------------------------------------------------------------------------------- NOKIA 2110 *#06# Muestra IMEI. *#9999## Versión de software. *#170602112302# Versión de software. *#3283# Año de fabricación -------------------------------------------------------------------------------- NOKIA 8110i *#06# Muestra IMEI. *#8110# Versión de software. *#92702689# Pregunta: "Warranty code?" si ponemos algunos de los codes de abajo..: 6232 Fecha de fabricación. 7332 Fecha de reparación. 7832 Fecha de compra. 9268 Numero de serie. 37832 Fecha de compra. 87267 Transferencia de datos. Añadir tonos Poner como SMSC: +358405202999. Enviar un sms con la palabra TONES al nº 99999.Cuando obtengas la respuesta envíala al mismo nº 99999 quitando el asterisco de la melodía que quieras recibir. Si lo haces bien recibirás un SMS que dirá: new ringtone recieved. Lo aceptarás o descartarás como tono nº16. -------------------------------------------------------------------------------- NOKIA 6110 Y 8810 *#06# Muestra IMEI. *#0000# Versión de software. *#92702689# Pregunta: "Warranty code?" si ponemos algunos de los codes de abajo..: 6232 Fecha de fabricación. 7332 Fecha de reparación. 7832 Fecha de compra. 9268 Numero de serie. 37832 Fecha de compra. 87267 Transferencia de datos. Añadir tonos Poner como SMSC: +358405202999. Enviar un sms con la palabra TONES al nº 99999.Cuando obtengas la respuesta envíala al mismo nº 99999 quitando el asterisco de la melodía que quieras recibir. Si lo haces bien recibirás un SMS que dirá: new ringtone recieved. Lo aceptarás o descartarás como tono nº36. -------------------------------------------------------------------------------- NOKIA 5110 *#06# Muestra IMEI. *#0000# Versión de software. *#92702689# Pregunta: "Warranty code?" si ponemos algunos de los codes de abajo..: 6232 Fecha de fabricación. 7332 Fecha de reparación. 7832 Fecha de compra. 9268 Numero de serie. 37832 Fecha de compra. 87267 Transferencia de datos. !!! COMO LIBERAR LOS 5110 !!! Enciende el móvil. Cuando te pida el pin pulsa la tecla de bajar sonido durante 3 segundos y después la tecla C. Cuando la pantalla se ponga en blanco introduce esta secuencia **04*PIN*-PIN*PIN#. Ahora ya puedes meter cualquier tarjeta en tu NOKIA. Este truco solo funciona con las versiones de Software inferiores a la 5.04. Si tienes una superior necesitas cable y los programas que tenemos en la sección de software. -------------------------------------------------------------------------------- Version de software: *#682371158412125# ¿Detectan radar los Nokia? De acuerdo con algunas noticias europeas los móviles Nokia pueden configurarse para localizar los radares de las brigadas de transito. Las noticias salidas a público describen como hipotéticamente es posible hacer que algunos terminales Nokia adviertan a través del timbre siempre que detectan la frecuencia a que funcionan los radares. ¿Otro mito urbano o alguna verdad? Interrogado sobre el asunto el departamento técnico de Nokia calificó la noticia como un "rumor", remitiendo el esclarecimiento para la administración. El procedimiento para activar esta función es el siguiente: en la pantalla inicial elegid la opción menú y después se elige, por este orden:, [Opciones de seguridad], [Grupo cerrado de usuarios], "Sí", "00000", "Aceptar". Después hay que volver a la pantalla de inicio. En pantalla aparece un radar con cinco ceros. Este truco al parecer no funciona en todos los modelos. Según las noticias cuando el móvil detecta la proximidad de un radar suena el timbre, como si fuese una llamada, pero tan solo es un aviso de radar. Para saber el IMEI Teclear *#06#. Aparecerá el IMEI en pantalla. Este número es el mismo que se encuentra en la etiqueta que está en la parte trasera, cuando quitamos la batería. Para hacer desaparecer el IMEI de la pantalla pulsar cualquier tecla. Modos de transmisión y ahorro de baterías: Los NOKIA tienen 3 métodos de transmisión de voz: el método normal, el HFR (Half Full Rate) y el EFR (Enhaced Full Rate). El HFR y el EFR se pueden activar y desactivar con unos códigos. Evidentemente, con estos trucos sólo ahorraremos batería cuando estemos en conversación, ya que en espera el teléfono sigue gastando lo mismo. Tras introducir estos códigos el teléfono se reinicia automáticamente, y tenemos que volver a introducir el PIN: Activar EFR (Enhaced Full Rate) - teclear *3370#, lo que hace este código es que el teléfono emita con una señal más constante, ya que normalmente los teléfonos GSM sólo emiten hacia la antena cuando éste detecta que se habla, por eso en ocasiones, parece como si perdiéramos la última parte de algunas palabras. Si activamos el EFR, la calidad de sonido aumenta, pero evidentemente el teléfono gasta más batería, hasta un 5% más. Recomendable activar cuando estemos en lugares con poca cobertura. Desactivar EFR (Enhaced Full Rate) - teclear #3370#, si desactivamos el EFR, la calidad de sonido disminuye, pero la batería dura como un 5% más. Activar HFR (Half Rate Mode) - teclear *4720#, si activamos el HFR, el teléfono emite la señal en períodos más intermitentes, con lo que la calidad de sonido baja, y además de forma notable, más que al activar o desactivar el EFR, por lo que sólo lo recomiendo para cuando estemos muy justos de batería. No es recomendable activar cuando estemos en lugares con poca cobertura. Aumenta la duración de la batería hasta un 30%. Desactivar HFR (Enhaced Full Rate) - teclear #4720#, si desactivamos el HFR, la calidad de sonido aumenta, pero la batería puede durar un 30% menos Información de servicio: Teclear *#92702689#, éste es un menú que se utiliza en los servicios técnicos de NOKIA. Para movernos por las opciones, utilizamos la misma que para movernos por los menús, la tecla central con dos flechas. Para salir de este menú hay que apagar el teléfono. La información que nos muestra es la siguiente: Nº de serie, o IMEI, del teléfono. No es modificable. Fecha de fabricación (mes y año). No es modificable. Fecha de compra (mes y año). Si esta opción esta en blanco, aparece "mmyy" y nos ofrece la opción de introducirla. Una vez introducida no se puede borrar ni modificar (sólo a través del cable de PC y algunos programas especiales). Fecha de la última reparación (mes y año). No es modificable desde el menú. Si no se ha reparado el teléfono nunca aparece "0000". Transfer User Data? Es para transferir toda la información y configuración del teléfono a otro modelo compatible a través del puerto de infrarrojos. Life Timer El tiempo que lleva encendido. NOKIA 61xx/ 81xx/ 71xx/ 8210 Para saber la versión del software y la fecha de éste: Poner *#0000#. La información que nos muestra es la siguiente: V x.xx - Es la versión del software que lleva nuestro teléfono. Hay varias versiones del software: "5.04", "5.09", "5.10". A veces la versión de software puede ser actualizada a través de cable de conexión a PC y los programas adecuados, o lo pueden hacer en un servicio técnico de NOKIA. 21-01-00 - Es la fecha de fabricación del software del teléfono. NSE-8/9 - Es el código interno de modelo de NOKIA para el 61xx, 71xx, 81xx y 8210.

Obtener el nombre de usuario y de la compañia de Windows: Crear un formulario, añadir dos etiquetas o labels y escribir el siguiente código: Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Sub Form_Load() Dim strUser As String Dim strOrg As String Dim lngLen As Long Dim lngType As Long Dim hKey As Long Dim x As Long Const HKEY_LOCAL_MACHINE = &H80000002 Const REG_SZ = &H1 x = RegOpenKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion", hKey) ' open desired key in registry strUser = Space$(256) lngLen = Len(strUser) x = RegQueryValueEx(hKey, "RegisteredOwner", 0, lngType, ByVal strUser, lngLen) If x = 0 And lngType = REG_SZ And lngLen > 1 Then strUser = Left$(strUser, lngLen - 1) Else strUser = "Unknown" End If strOrg = Space$(256) lngLen = Len(strOrg) x = RegQueryValueEx(hKey, "RegisteredOrganization", 0, lngType, ByVal strOrg, lngLen) If x = 0 And lngType = REG_SZ And lngLen > 1 Then strOrg = Left$(strOrg, lngLen - 1) Else strOrg = "Unknown" End If Label1.Caption = "Usuario: " & strUser Label2.Caption = "Empresa: " & strOrg x = RegCloseKey(hKey) End Sub -------------------------------------------------------------------------------- Forzar a un TextBox para que admita únicamente números: Crear un formulario, añadir un TextBox y escribir el siguiente código: 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 Nuevo: Private Sub Text1_Keypress(KeyAscii As Integer)If Not IsNumeric(Chr$(KeyAscii)) And KeyAscii <> 8 Then KeyAscii = 0End Sub -------------------------------------------------------------------------------- Forzar a un InputBox para que admita únicamente números: Crear un formulario y escribir el siguiente código: Private Sub Form_Load() Dim Numero As String Do Numero = InputBox("Introduzca un numero:" Loop Until IsNumeric(Numero) MsgBox "El numero es el " & Numero Unload Me End Sub -------------------------------------------------------------------------------- Hacer Drag & Drop de un control (ejemplo de un PictureBox): En un formulario, añadir un PictureBox con una imagen cualquiera y escribir el siguiente código: Private DragX As Integer Private DragY As Integer Sub Form_DragDrop(Source As Control, X As Single, Y As Single) Source.Move (X - DragX), (Y - DragY) End Sub Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Si el boton del raton es el derecho, no hacemos nada If Button = 2 Then Exit Sub Picture1.Drag 1 DragX = X DragY = Y End Sub Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Picture1.Drag 2 End Sub -------------------------------------------------------------------------------- Centrar una ventana en Visual Basic: Usar: Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2 En vez de: Form1.Left = Screen.Width - Width \ 2 Form1.Top = Screen.Height - Height \ 2 -------------------------------------------------------------------------------- Ejecuta pausas durante un determinado espacio de tiempo en segundos: Llamada: Espera(5) Sub Espera(Segundos As Single) Dim ComienzoSeg As Single Dim FinSeg As Single ComienzoSeg = Timer FinSeg = ComienzoSeg + Segundos Do While FinSeg > Timer DoEvents If ComienzoSeg > Timer Then FinSeg = FinSeg - 24 * 60 * 60 End If Loop End Sub Llamada: pause segundos Sub Pause(interval) Dim atime atime = Timer Do While Timer - atime < Val(interval) DoEvents Loop End Sub -------------------------------------------------------------------------------- Editor de texto: Seleccionar todo el texto: Text1.SetFocus Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) Copiar texto: Clipboard.Clear Clipboard.SetText Text1.SelText Text1.SetFocus Pegar texto: Text1.SelText = Clipboard.GetText() Text1.SetFocus Cortar texto: Clipboard.SetText Text1.SelText Text1.SelText = "" Text1.SetFocus Deshacer texto: (Nota: esta operación sólo es eficaz con el control Rich TextBox). En un módulo copie esta línea: Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal _ hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long Esta es la instrucción de la función deshacer: UndoResultado = SendMessage(Text1.hwnd, &HC7, 0&, 0& If UndoResultado = -1 Then Beep MsgBox "Error al intentar recuperar.", 20, "Deshacer texto" End If Seleccionar todo el texto: SendKeys "^A" Copiar texto: SendKeys "^C" Pegar texto: SendKeys "^V" Cortar texto: SendKeys "^X" Deshacer texto: SendKeys "^Z" -------------------------------------------------------------------------------- Obtener el directorio de Windows y el directorio de Sistema: En un módulo copiar estas líneas: Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA"_ (ByVal lpBuffer As String, ByVal nSize As Long) As Long Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA"_ (ByVal lpBuffer As String, ByVal nSize As Long) As Long Ponga dos Labels o etiquetas y un botón en el formulario: Label1, Label2, Command1 Hacer doble click sobre el botón y escribir el código siguiente: Private Sub Command1_Click() Dim Car As String * 128 Dim Longitud, Es As Integer Dim Camino As String Longitud = 128 Es = GetWindowsDirectory(Car, Longitud) Camino = RTrim$(LCase$(Left$(Car, Es))) Label1.Caption = Camino Es = GetSystemDirectory(Car, Longitud) Camino = RTrim$(LCase$(Left$(Car, Es))) Label2.Caption = Camino End Sub -------------------------------------------------------------------------------- Ocultar la barra de tareas en Windows 95 y/o Windows NT: En un módulo copiar estas líneas: Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName_ As String, ByVal lpWindowName As String) As Long Declare Function SetWindowPos Lib "user32" (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 En un formulario ponga dos botones y escriba el código correspondiente a cada uno de ellos: 'Oculta la barra de tareas Private Sub Command1_Click() Ventana = FindWindow("Shell_traywnd", "" Call SetWindowPos(Ventana, 0, 0, 0, 0, 0, Oculta) End Sub 'Muestra la barra de tareas Private Sub Command2_Click() Call SetWindowPos(Ventana, 0, 0, 0, 0, 0, Muestra) End Sub -------------------------------------------------------------------------------- Imprimir el contenido de un TextBox en líneas de X caracteres: Añadir un TextBox con las propiedades "Multiline=True" y "ScrollBars=Vertical", y un CommandButton. Hacer doble click sobre él y escribir este código: Private Sub Command1_Click() 'X es 60 en este ejmplo imprimeLineas Text1, 60 End Sub En las declaraciones "Generales" del formulario, escribimos: 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 -------------------------------------------------------------------------------- Leer y escribir un fichero Ini: Declaraciones generales en un módulo: Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA"_ (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As_ String ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As_ String) As Long Declare Function WritePrivateProfileString Lib "kernel32" Alias_ "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As_ Any, ByVal lpString As Any, ByVal lpFileName As String) As Long Leer en "Ejemplo.Ini": Private Sub Form_Load() Dim I As Integer Dim Est As String Est = String$(50, " " I = GetPrivateProfileString("Ejemplo", "Nombre", "", Est, Len(Est), "Ejemplo.ini" If I > 0 Then MsgBox "Tu Nombre es: " & Est End If End Sub Escribir en "Prueba.Ini": Private Sub Form_Unload(Cancel As Integer) Dim I As Integer Dim Est As String Est = "Ejemplo - Apartado" I = WritePrivateProfileString("Ejemplo", "Nombre", Est, "Ejemplo.ini" End Sub (Nota: si I=0 quiere decir que no existe Información en la línea de fichero Ini a la que hacemos referencia. El fichero "Ejemplo.Ini" se creará automáticamente). -------------------------------------------------------------------------------- Crear una barra de estado sin utilizar controles OCX o VBX: Crear una PictureBox y una HScrollBar: Propiedades de la HScrollBar: Max -> 100 Min -> 0 Propiedades de la PictureBox: DrawMode -> 14 - Merge Pen Not FillColor -> &H00C00000& Font -> Verdana, Tahoma, Arial; Negrita; 10 ForeColor -> &H00000000& ScaleHeight -> 10 ScaleMode -> 0 - User ScaleWidth -> 100 Insertar en el formulario o módulo el código de la función: Sub Barra(Tam As Integer) If Tam > 100 Or Tam <> Insertar en el evento Change del control HScrollBar: Private Sub HScroll1_Change() Barra (HScroll1.Value) End Sub En el evento Paint del formulario, escribir: Private Sub Form_Paint() Barra (HScroll1.Value) End Sub -------------------------------------------------------------------------------- Calcular el espacio total y espacio libre de una Unidad de 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 Crear 7 Labels: Escribir el código siguiente: 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 -------------------------------------------------------------------------------- Crear un efecto Shade al estilo de los programas de instalación: Crear un proyecto nuevo y escribir el código siguiente: Private Sub Form_Resize() Form1.Cls Form1.AutoRedraw = True Form1.DrawStyle = 6 Form1.DrawMode = 13 Form1.DrawWidth = 2 Form1.ScaleMode = 3 Form1.ScaleHeight = (256 * 2) For i = 0 To 255 Form1.Line (0, Y)-(Form1.Width, Y + 2), RGB(0, 0, i), BF Y = Y + 2 Next i End Sub -------------------------------------------------------------------------------- Situar el cursor encima de un determinado control (p. ej.: un botón): Escribir el código siguiente en el módulo: Declare Sub SetCursorPos Lib "User32" (ByVal X As Integer, ByVal Y As Integer) Insertar un botón en el formulario y escribir el siguiente código: Private Sub Form_Load() X% = (Form1.Left + Command1.Left + Command1.Width / 2 + 60) / Screen.TwipsPerPixelX Y% = (Form1.Top + Command1.Top + Command1.Height / 2 + 360) / Screen.TwipsPerPixelY SetCursorPos X%, Y% End Sub -------------------------------------------------------------------------------- Menú PopUp en un TextBox: Ejemplo para no visualizar el menú PopUp implícito de Windows: En el evento MouseDown del control TextBox escriba: Private Sub Editor1_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single) If Button = 2 Then Editor1.Enabled = False PopupMenu MiMenu Editor1.Enabled = True Editor1.SetFocus End If End Sub -------------------------------------------------------------------------------- Hacer sonar un fichero Wav o Midi: Insertar el siguiente código en un módulo: Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long Insertar un botón en el formulario y escribir el siguiente código: Private Sub Command1_Click() iResult = mciExecute("Play c:\windows\ringin.wav" End Sub -------------------------------------------------------------------------------- Hacer un formulario flotante al estilo de Visual Basic: Crear un nuevo proyecto, insertar un botón al formulario que inserte un formulario más y un módulo. Pegue el siguiente código en el módulo: Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long Peguar el siguiente código en el formulario principal: Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Unload Form2 End Sub Private Sub Command1_Click() Dim ret As Integer If doshow = False Then ret = SetParent(Form2.hWnd, Form1.hWnd) Form2.Left = 0 Form2.Top = 0 Form2.Show doshow = True Else Form2.Hide doshow = False End If End Sub -------------------------------------------------------------------------------- Comprobar si el programa ya está en ejecución: Crear un nuevo proyecto e insertar el siguiente código: Private Sub Form_Load() If App.PrevInstance Then Msg = App.EXEName & ".EXE" & " ya está en ejecución" MsgBox Msg, 16, "Aplicación." End End If End Sub -------------------------------------------------------------------------------- Hallar el nombre del PC en Windows 95 o Windows NT: Cree un nuevo proyecto e inserte dos ButtonClick y un Módulo: Pegue el siguiente código en el formulario: Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim nPC as String Dim buffer As String Dim estado As Long buffer = String$(255, " " estado = GetComputerName(buffer, 255) If estado <> 0 Then nPC = Left(buffer, 255) End If MsgBox "Nombre del PC: " & nPC End Sub Private Sub Command2_Click() Unload Form1 End Sub Pegue el siguiente código en el módulo: Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long -------------------------------------------------------------------------------- Eliminar el sonido "Beep" cuando pulsamos Enter en un TextBox: Crear un nuevo proyecto e insertar un TextBox: Peguar el siguiente código en el formulario: Private Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Or KeyAscii = 9 Then KeyAscii = 0 End Sub -------------------------------------------------------------------------------- Ocultar y mostrar el puntero del ratón: Crear un nuevo proyecto e insertar dos ButtonClick y un Módulo: Pegue el siguiente código en el formulario: Private Sub Command1_Click() result = ShowCursor(False) End Sub Private Sub Command2_Click() result = ShowCursor(True) End Sub Usar las teclas alternativas Alt+O para ocultarlo y Alt+M para mostrarlo. Peguar el siguiente código en el módulo: Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long -------------------------------------------------------------------------------- Calcular el número de serie de un disco: Crear un nuevo proyecto e insertar el siguiente código en el formulario: Private Declare Function GetVolumeInformation& Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal pVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) Private Sub Form_Load() Dim cad1 As String * 256 Dim cad2 As String * 256 Dim numSerie As Long Dim longitud As Long Dim flag As Long unidad = "C:\" Call GetVolumeInformation(unidad, cad1, 256, numSerie, longitud, flag, cad2, 256) MsgBox "Numero de Serie de la unidad " & unidad & " = " & numSerie End Sub -------------------------------------------------------------------------------- Ejemplo de un mailer en base64. Private Sub Base64_Click() Dim Caracter As String * 1 Dim Trio(3) As Integer Dim Cont As Integer Dim ContLinea As Integer Dim Cuatro(4) As Integer Dim Base64 As String Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" ContLinea = 0 MensajeSaliente = "" MensajeEntrante = "" If Cfg.FicheroAnexo <> "" Then Open NFich For Binary As #3 Len = 3 Cont = 0 ContTotal = 0 Progreso.Max = FileLen(NFich) While Not ContTotal = LOF(3) ContTotal = ContTotal + 1 Caracter = Input(1, 3) Cont = Cont + 1 Trio(Cont) = Asc(Caracter) 'MensajeSaliente = MensajeSaliente + Caracter If Cont = 3 Then Cuatro(1) = Int(Trio(1) / 4) Cuatro(2) = (Trio(1) - Int(Trio(1) / 4) * 4) * 16 + Int(Trio(2) / 16) Cuatro(3) = (Trio(2) - (Int(Trio(2) / 16) * 16)) * 4 + Int(Trio(3) / 64) Cuatro(4) = Trio(3) - Int(Trio(3) / 64) * 64 MensajeEntrante = MensajeEntrante + Mid(Base64, Cuatro(1) + 1, 1) MensajeEntrante = MensajeEntrante + Mid(Base64, Cuatro(2) + 1, 1) MensajeEntrante = MensajeEntrante + Mid(Base64, Cuatro(3) + 1, 1) MensajeEntrante = MensajeEntrante + Mid(Base64, Cuatro(4) + 1, 1) Cont = 0 ContLinea = ContLinea + 4 If ContLinea = 76 Then MensajeEntrante = MensajeEntrante + vbCrLf ContLinea = 0 End If End If DoEvents Wend Select Case Cont Case 1 Cuatro(1) = Int(Trio(1) / 4) Cuatro(2) = (Trio(1) - Int(Trio(1) / 4) * 4) * 16 MensajeEntrante = MensajeEntrante + Mid(Base64, Cuatro(1) + 1, 1) MensajeEntrante = MensajeEntrante + Mid(Base64, Cuatro(2) + 1, 1) + "==" Case 2 Cuatro(1) = Int(Trio(1) / 4) Cuatro(2) = (Trio(1) - Int(Trio(1) / 4) * 4) * 16 + Int(Trio(2) / 16) Cuatro(3) = (Trio(2) - (Int(Trio(2) / 16) * 16)) * 4 MensajeEntrante = MensajeEntrante + Mid(Base64, Cuatro(1) + 1, 1) MensajeEntrante = MensajeEntrante + Mid(Base64, Cuatro(2) + 1, 1) MensajeEntrante = MensajeEntrante + Mid(Base64, Cuatro(3) + 1, 1) + "=" End Select Close #3 End If End Sub ver proyecto 1 http://taringa.net/posts/info/2273239/Crear-en--Visual-Basic-Manual.html ver proyecto 2 http://taringa.net/posts/info/2273271/Crear-en-Visual-Basic-Manual-Part-2.html

Cambiar la clave de producto en Windows XP 1. Ejecutar regedit y buscar la clave HKEY_LOCAL_MACHINE\Software\Microsoft\WindowsNT\CurrentVersion\WPAEvents 2. Abrir la clave oobetimer, borrar el valor hexadecimal CA, y cerrar regedit 3. Ir a Inicio, Ejecutar y escribir %systemroot%\system32\oobe\msoobe.exe /a 4. Nos aparecerá la pantalla de activación de Windows XP, seleccionar activación por teléfono, pulsar en Cambiar clave del producto e introducir la nueva clave y pulsar actualizar. (Las claves que comienzan por F o D han sido baneadas por Microsoft en el SP1) 5. Ejecutar de nuevo %systemroot%\system32\oobe\msoobe.exe /a, y con esto finalizará el proceso de activación

Como desplegar la lista de un ComboBox automáticamente: Insertar un ComboBox y un Botón en un nuevo proyecto y escribir el siguiente código: Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Sub Form_Load() Combo1.Clear Combo1.AddItem "Objeto 1" Combo1.AddItem "Objeto 2" Combo1.AddItem "Objeto 3" Combo1.AddItem "Objeto 4" Combo1.AddItem "Objeto 5" Combo1.AddItem "Objeto 6" Combo1.AddItem "Objeto 7" Combo1.Text = "Objeto 1" End Sub Private Sub Command1_Click() 'ComboBox desplegado Dim Resp As Long Resp = SendMessageLong(Combo1.hwnd, &H14F, True, 0) End Sub Nota: Resp = SendMessageLong(Combo1.hwnd, &H14F, False, 0) oculta la lista desplegada de un ComboBox, aunque esto sucede también cuando cambiamos el focus a otro control o al formulario. -------------------------------------------------------------------------------- Selección y eliminación de todos los elementos de un ListBox: Insertar un ListBox y dos Botón en un nuevo proyecto. Poner la propiedad MultiSelect del ListBox a "1 - Simple" y escriba el siguiente código: Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Sub Form_Load() List1.AddItem "Texto 1" List1.AddItem "Texto 2" List1.AddItem "Texto 3" List1.AddItem "Texto 4" List1.AddItem "Texto 5" List1.AddItem "Texto 6" List1.AddItem "Texto 7" End Sub Private Sub Command1_Click() 'Seleccion de todo el contenido Dim Resp As Long Resp = SendMessageLong(List1.hwnd, &H185&, True, -1) End Sub Private Sub Command2_Click() 'Eliminacion de todos los elementos seleccionados Dim Resp As Long Resp = SendMessageLong(List1.hwnd, &H185&, False, -1) End Sub -------------------------------------------------------------------------------- Calcular el tamaño de fuentes de letra: Es útil para utilizar con la propiedad Resize sobre los controles al cambiar de resolución de pantalla. Escribir el siguiente código: Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function GetDesktopWindow Lib "user32" () As Long Private Sub Form_Load() Dim ObCaps As Long Dim ObDC As Long Dim ObDesktop As Long Dim Cad As String ObDesktop = GetDesktopWindow() ObDC = GetDC(ObDesktop) ObCaps = GetDeviceCaps(ObDC, 88) If ObCaps = 96 Then Cad = "Pequeñas If ObCaps = 120 Then Cad = "Grandes" MsgBox "Fuentes de letra " & Cad End Sub *) Esta función ha sido corregida por un error en las etiquetas, 96 corresponde a pequeñas y 120 a Grandes, agradecimientos a Andrés Moral Gutiérrez por su correción (01/06/1998) -------------------------------------------------------------------------------- Provocar la trasparencia de un formulario: Escribir el siguiente código: Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Sub Form_Load() Dim Resp As Long Resp = SetWindowLong(Me.hwnd, -20, &H20& Form1.Refresh End Sub -------------------------------------------------------------------------------- Pasar de un TextBox a otro al pulsar Enter: Insertar tres TextBox y escribir el siguiente código: Private Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Private Sub Text2_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Private Sub Text3_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub otra forma: Insertar tres TextBox, cambiar la propiedad KeyPreview del formulario a True y escribir el siguiente código: Private Sub Form_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub -------------------------------------------------------------------------------- Usar IF THEN ELSE ENDIF en una misma línea: Insertar un CommandButton y un TextBox y escribir el siguiente código: Private Sub Command1_Click() Dim I As Integer Dim A As String I = 3 A = IIf(I <> 1, "True", "False" Text1.Text = A End Sub -------------------------------------------------------------------------------- Convertir un texto a mayúsculas o minúsculas: Crear un formulario y situar un TextBox. Escribir: Private Sub Text1_Change() Dim I As Integer Text1.Text = UCase(Text1.Text) I = Len(Text1.Text) Text1.SelStart = I End Sub -------------------------------------------------------------------------------- Presentar la ventana AboutBox (Acerca de) por defecto: Escribir el siguiente código en el formulario: 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, "Título Programa", "Copyright 1997, Dueño de la aplicación", Me.Icon) End Sub -------------------------------------------------------------------------------- Incrementar un menú en ejecución: Abrir un proyecto nuevo, y haga doble click sobre el formulario. Meidante el gestór de menús escribir lo siguiente: Caption -> Editor Name -> MnuEditor Pulse Insertar y el botón "->" Caption -> Añadir Name -> MnuAñadir Pulse Insertar Caption -> Quitar Name -> MnuQuitar Enabled -> False Pulse Insertar Caption -> Salir Name -> MnuSalir Pulse Insertar Caption -> - Name -> MnuIndex Index -> 0 Pulse Aceptar Escribir el siguiente código en el formulario: Private ultElem As Integer Private Sub Form_Load() ultElem = 0 End Sub Private Sub MnuQuitar_Click() Unload MnuIndex(ultElem) ultElem = ultElem - 1 If ultElem = 0 Then MnuQuitar.Enabled = False End If End Sub Private Sub MnuSalir_Click() End End Sub Private Sub MnuAñadir_Click() ultElem = ultElem + 1 Load MnuIndex(ultElem) MnuIndex(ultElem).Caption = "Menu -> " + Str(ultElem) MnuQuitar.Enabled = True End Sub -------------------------------------------------------------------------------- Cambiar el fondo de Windows desde Visual Basic: Crear un formulario y escribir: Private 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 Private Sub Form_Load() Dim fallo As Integer fallo = SystemParametersInfo(20, 0, "C:\WINDOWS\FONDO.BMP", 0) End Sub -------------------------------------------------------------------------------- Calcular el número de colores de video del modo actual de Windows: Crear un formulario y un TextBox y escribir: Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long Private Sub Form_Load() i = (2 ^ GetDeviceCaps(Form1.hdc, 12)) ^ GetDeviceCaps(Form1.hdc, 14) Text1.Text = CStr(i) & " colores." End Sub -------------------------------------------------------------------------------- Ajustar un Bitmap a la pantalla: Crear un formulario con un BitMap cualquiera y una etiqueta o Label con los atributos que quiera. Escribir lo siguiente: Private Sub Form_Paint() Dim i As Integer For i = 0 To Form1.ScaleHeight Step Picture1.Height For j = 0 To Form1.ScaleWidth Step Picture1.Width PaintPicture Picture1, j, i, Picture1.Width, Picture1.Height Next Next End Sub Private Sub Form_Resize() Picture1.Left = -(Picture1.Width + 200) Picture1.Top = -(Picture1.Height + 200) Label1.Top = 100 Label1.Left = 100 End Sub -------------------------------------------------------------------------------- Detectar la unidad del CD-ROM: Si para instalar una aplicación o ejecutar un determinado software necesitas saber si existe el CD-ROM:. Crear un formulario con una etiqueta y escribir lo siguiente: Option Explicit Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Private Const DRIVE_REMOVABLE = 2 Private Const DRIVE_FIXED = 3 Private Const DRIVE_REMOTE = 4 Private Const DRIVE_CDROM = 5 Private Const DRIVE_RAMDISK = 6 Function StripNulls(startStrg$) As String Dim c%, item$ c% = 1 Do If Mid$(startStrg$, c%, 1) = Chr$(0) Then item$ = Mid$(startStrg$, 1, c% - 1) startStrg$ = Mid$(startStrg$, c% + 1, Len(startStrg$)) StripNulls$ = item$ Exit Function End If c% = c% + 1 Loop End Function Private Sub Form_Load() Dim r&, allDrives$, JustOneDrive$, pos%, DriveType& Dim CDfound As Integer allDrives$ = Space$(64) r& = GetLogicalDriveStrings(Len(allDrives$), allDrives$) allDrives$ = Left$(allDrives$, r& Do pos% = InStr(allDrives$, Chr$(0)) If pos% Then JustOneDrive$ = Left$(allDrives$, pos%) allDrives$ = Mid$(allDrives$, pos% + 1, Len(allDrives$)) DriveType& = GetDriveType(JustOneDrive$) If DriveType& = DRIVE_CDROM Then CDfound% = True Exit Do End If End If Loop Until allDrives$ = "" Or DriveType& = DRIVE_CDROM If CDfound% Then label1.Caption = "La unidad de CD-ROM corresponde a la unidad: " & UCase$(JustOneDrive$) Else label1.Caption = "Su sistema no posee CD-ROM o unidad no encontrada." End If End Sub -------------------------------------------------------------------------------- Calcular la profundidad de color (bits por pixel) y resolución de Windows: Crear un formulario y un TextBox y escribir: Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long Private Sub Form_Load() Dim col, bit, largo, alto As Integer col = GetDeviceCaps(Form1.hdc, 12) If col = 1 Then bit = GetDeviceCaps(Form1.hdc, 14) If bit = 1 Then Text1.Text = "Resolucion de 1 bit / 2 colores" ElseIf bit = 4 Then Text1.Text = "Resolucion de 4 bits / 16 colores" End If ElseIf col = 8 Then Text1.Text = "Resolucion de 8 bits / 256 colores" ElseIf col = 16 Then Text1.Text = "Resolucion de 16 bits / 65000 colores" Else Text1.Text = "Resolucion de 16 M colores" End If largo = GetDeviceCaps(Form1.hdc, 8) alto = GetDeviceCaps(Form1.hdc, 10) Text1.Text = Text1.Text & " " & largo & "x" & alto & " pixels" End Sub -------------------------------------------------------------------------------- Comprobar si el sistema posee tarjeta de sonido: Crear un formulario y escribir: Private Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long Private Sub Form_Load() Dim inf As Integer inf = waveOutGetNumDevs() If inf > 0 Then MsgBox "Tarjeta de sonido soportada.", vbInformation, "Informacion: Tarjeta de sonido" Else MsgBox "Tarjeta de sonido no soportada.", vbInformation, "Informacion: Tarjeta de sonido" End If End End Sub -------------------------------------------------------------------------------- Crear una ventana con la Información del Sistema: Crear un formulario e insertar un módulo y escribir en el formulario lo siguiente: Private Sub Form_Load() Dim msg As String MousePointer = 11 Dim verinfo As OSVERSIONINFO verinfo.dwOSVersionInfoSize = Len(verinfo) ret% = GetVersionEx(verinfo) If ret% = 0 Then MsgBox "Error Obteniendo Information de la Version" End End If Select Case verinfo.dwPlatformId Case 0 msg = msg + "Windows 32s " Case 1 msg = msg + "Windows 95 " Case 2 msg = msg + "Windows NT " End Select ver_major$ = verinfo.dwMajorVersion ver_minor$ = verinfo.dwMinorVersion build$ = verinfo.dwBuildNumber msg = msg + ver_major$ + "." + ver_minor$ msg = msg + " (Construido " + build$ + "" + vbCrLf + vbCrLf Dim sysinfo As SYSTEM_INFO GetSystemInfo sysinfo msg = msg + "CPU: " Select Case sysinfo.dwProcessorType Case PROCESSOR_INTEL_386 msg = msg + "Procesador Intel 386 o compatible." + vbCrLf Case PROCESSOR_INTEL_486 msg = msg + "Procesador Intel 486 o compatible." + vbCrLf Case PROCESSOR_INTEL_PENTIUM msg = msg + "Procesador Intel Pentium o compatible." + vbCrLf Case PROCESSOR_MIPS_R4000 msg = msg + "Procesador MIPS R4000." + vbCrLf Case PROCESSOR_ALPHA_21064 msg = msg + "Procesador DEC Alpha 21064." + vbCrLf Case Else msg = msg + "Procesador (desconocido)." + vbCrLf End Select msg = msg + vbCrLf Dim memsts As MEMORYSTATUS Dim memory& GlobalMemoryStatus memsts memory& = memsts.dwTotalPhys msg = msg + "Memoria Fisica Total: " msg = msg + Format$(memory& \ 1024, "###,###,###" + "Kb" + vbCrLf memory& = memsts.dwAvailPhys msg = msg + "Memoria Fisica Disponible: " msg = msg + Format$(memory& \ 1024, "###,###,###" + "Kb" + vbCrLf memory& = memsts.dwTotalVirtual msg = msg + "Memoria Virtual Total: " msg = msg + Format$(memory& \ 1024, "###,###,###" + "Kb" + vbCrLf memory& = memsts.dwAvailVirtual msg = msg + "Memoria Virtual Disponible: " msg = msg + Format$(memory& \ 1024, "###,###,###" + "Kb" + vbCrLf + vbCrLf MsgBox msg, 0, "Acerca del Sistema" MousePointer = 0 End End Sub Escribir lo siguiente en el módulo: Type SYSTEM_INFO dwOemID As Long dwPageSize As Long lpMinimumApplicationAddress As Long lpMaximumApplicationAddress As Long dwActiveProcessorMask As Long dwNumberOrfProcessors As Long dwProcessorType As Long dwAllocationGranularity As Long dwReserved As Long End Type Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 End Type Type MEMORYSTATUS dwLength As Long dwMemoryLoad As Long dwTotalPhys As Long dwAvailPhys As Long dwTotalPageFile As Long dwAvailPageFile As Long dwTotalVirtual As Long dwAvailVirtual As Long End Type Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (LpVersionInformation As OSVERSIONINFO) As Long Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS) Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO) Public Const PROCESSOR_INTEL_386 = 386 Public Const PROCESSOR_INTEL_486 = 486 Public Const PROCESSOR_INTEL_PENTIUM = 586 Public Const PROCESSOR_MIPS_R4000 = 4000 Public Const PROCESSOR_ALPHA_21064 = 21064 -------------------------------------------------------------------------------- Mostrar un fichero AVI a pantalla completa: Crear un formulario y escribir: Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Private Sub Form_Load() CmdStr$ = "play e:\media\avi\nombre.avi fullscreen" ReturnVal& = mciSendString(CmdStr$, 0&, 0, 0& End Sub -------------------------------------------------------------------------------- Crear un link con un programa añadiéndolo al grupo de programas situado en Inicio -> Programas o Start -> Programs: Crear un formulario y escribir: Private Declare Function fCreateShellLink Lib "STKIT432.DLL" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long Private Sub Form_Load() iLong = fCreateShellLink("", "Visual Basic", "C:\Archivos de Programa\DevStudio\Vb\vb5.exe", "" End Sub -------------------------------------------------------------------------------- Apagar el equipo, reiniciar Windows, reiniciar el Sistema: Añadir tres botones a un formulario y escribir lo siguiente en el código del formulario: Private Declare Function ExitWindowsEx& Lib "user32" (ByVal uFlags&, ByVal dwReserved& Private Sub Command1_Click() Dim i as integer i = ExitWindowsEx(1, 0& 'Apaga el equipo End Sub Private Sub Command2_Click() Dim i as integer i = ExitWindowsEx(0, 0& 'Reinicia Windows con nuevo usuario End Sub Private Sub Command3_Click() Dim i as integer i = ExitWindowsEx(2, 0& 'Reinicia el Sistema End Sub -------------------------------------------------------------------------------- Borrar un fichero y enviarlo a la papelera de reciclaje: Crear un formulario y escribir el siguiente código: 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 = FileName .fFlags = FOF_ALLOWUNDO End With RetVal = SHFileOperation(SHFileOp) End Sub Private Sub Form_Load() Recycle "c:\a.txt" End Sub El programa preguntará si deseamos o no eliminar el fichero 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. -------------------------------------------------------------------------------- Abrir el Acceso telefónico a Redes de Windows y ejecutar una conexión: Crear un formulario y escribir el siguiente código: Private Sub Form_Load() Dim AbrirConexion As Long AbrirConexion = Shell("rundll32.exe rnaui.dll,RnaDial " & "ConexiónInternet", 1) SendKeys "{ENTER}" End Sub Para Windows 2000/NT V_ID_CONEXION = Shell ("rasphone.exe -d " & V_NOMBRE_DE_LA_CONEXION_DIAL-UP, 1) -------------------------------------------------------------------------------- Situar una ScroolBar horizontal en un ListBox:Crear un formulario y escribir el siguiente código: Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Sub Form_Load() Dim x As Integer, i As Integer For i = 1 To 20 List1.AddItem "El número final de la selección es el " & i Next i x = SendMessage(List1.hwnd, &H194, 200, ByVal 0& End Sub vea la parte 1 http://taringa.net/posts/info/2273239/Crear-en--Visual-Basic-Manual.html vea la parte 3 http://taringa.net/posts/info/2273315/Crear-en-Visual-Basic-Manual-Part-3.html

Como crear un grupo de programas: Muy útil para crear instalaciones por ejemplo: Añadir un textbox y hacerlo oculto. Una vez oculto, escribir estas líneas sustituyendo "Nombre del Grupo" por que que se desea crear, y que lo colocamos en Inicio -> Programas. Private Sub Command1_Click() Text1.LinkTopic = "Progman|Progman" Text1.LinkMode = 2 Text1.LinkExecute "[CreateGroup(" + "Nombre del Grupo" + "]" End Sub -------------------------------------------------------------------------------- Vaciar la carpeta de Documentos de Windows: Inicie un nuevo proyecto y añada el siguiente código: Private Declare Function SHAddToRecentDocs Lib "Shell32" (ByVal lFlags As Long, ByVal lPv As Long) As Long Private Sub Form_Load() SHAddToRecentDocs 0, 0 End Sub -------------------------------------------------------------------------------- Abrir la ventana de Propiedades de agregar o quitar aplicaciones: Añada el siguiente código: Private Sub Command1_Click() X = Shell("Rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl @0" End Sub -------------------------------------------------------------------------------- Uso de Random: La función Rnd o Random posee la virtud de obtener números aleatorios entre 0 y 1: El único inconveniente a la hora de usar Rnd, es que hay que inicializarlo, en otro caso, el resultado de la función Rnd, será siempre el mismo dentro de un determinado ordenador. Por ejemplo, el código: Private Sub Form_Load() Dim Num As Double Num = Rnd MsgBox Num End Sub Nos daría como resultado siempre el mismo número. Para solucionar este problema, debemos escribir la sentencia Randomize antes de llamar a la función Rnd. De esta manera, la función Rnd actuará correctamente. El código quedaría así: Private Sub Form_Load() Dim Num As Double Randomize Num = Rnd MsgBox Num End Sub -------------------------------------------------------------------------------- Calcular la etiqueta o label de un disco duro: Hallar la etiqueta o label del mismo disco duro: Escribir el siguiente código: Private Declare Function GetVolumeInformation& Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal pVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) Private Sub Form_Load() Dim cad1 As String * 256 Dim cad2 As String * 256 Dim numSerie As Long Dim longitud As Long Dim flag As Long unidad = "D:\" Call GetVolumeInformation(unidad, cad1, 256, numSerie, longitud, flag, cad2, 256) MsgBox "Label de la unidad " & unidad & " = " & cad1 End Sub -------------------------------------------------------------------------------- Imprimir un RichTextBox tal y como se ve: Imprimir un RichTextBox con su formato original. Private Sub Command1_Click() On Error GoTo ErrorDeImpresion Printer.Print "" RichTextBox1.SelPrint Printer.hDC Printer.EndDoc Exit Sub ErrorDeImpresion: Exit Sub End Sub Otra forma: En el Formulario [Form1 por defecto] : Private Sub Form_Load() Dim LineWidth As Long Me.Caption = "Rich Text Box Ejemplo de Impresion" Command1.Move 10, 10, 600, 380 Command1.Caption = "&Imprimir" RichTextBox1.SelFontName = "Verdana, Tahoma, Arial" RichTextBox1.SelFontSize = 10 LineWidth = WYSIWYG_RTF(RichTextBox1, 1440, 1440) Me.Width = LineWidth + 200 End Sub Private Sub Form_Resize() RichTextBox1.Move 100, 500, Me.ScaleWidth - 200, Me.ScaleHeight - 600 End Sub Private Sub Command1_Click() PrintRTF RichTextBox1, 1440, 1440, 1440, 1440 End Sub Crear un módulo y escribir: Private Type Rect Left As Long Top As Long Right As Long Bottom As Long End Type Private Type CharRange cpMin As Long cpMax As Long End Type Private Type FormatRange hdc As Long hdcTarget As Long rc As Rect rcPage As Rect chrg As CharRange End Type Private Const WM_USER As Long = &H400 Private Const EM_FORMATRANGE As Long = WM_USER + 57 Private Const EM_SETTARGETDEVICE As Long = WM_USER + 72 Private Const PHYSICALOFFSETX As Long = 112 Private Const PHYSICALOFFSETY As Long = 113 Private Declare Function GetDeviceCaps Lib "gdi32" ( _ ByVal hdc As Long, ByVal nIndex As Long) As Long Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" _ (ByVal hWnd As Long, ByVal msg As Long, ByVal wp As Long, lp As Any) As Long Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" _ (ByVal lpDriverName As String, ByVal lpDeviceName As String, _ ByVal lpOutput As Long, ByVal lpInitData As Long) As Long Public Function WYSIWYG_RTF(RTF As RichTextBox, LeftMarginWidth As Long, _ RightMarginWidth As Long) As Long Dim LeftOffset As Long, LeftMargin As Long, RightMargin As Long Dim LineWidth As Long Dim PrinterhDC As Long Dim r As Long Printer.Print Space(1) Printer.ScaleMode = vbTwips LeftOffset = Printer.ScaleGetDeviceCaps(Printer.hdc, _ PHYSICALOFFSETX), vbPixels, vbTwips) LeftMargin = LeftMarginWidth - LeftOffset RightMargin = (Printer.Width - RightMarginWidth) - LeftOffset LineWidth = RightMargin - LeftMargin PrinterhDC = CreateDC(Printer.DriverName, Printer.DeviceName, 0, 0) r = SendMessage(RTF.hWnd, EM_SETTARGETDEVICE, PrinterhDC, _ ByVal LineWidth) Printer.KillDoc WYSIWYG_RTF = LineWidth End Function Public Sub PrintRTF(RTF As RichTextBox, LeftMarginWidth As Long, _ TopMarginHeight, RightMarginWidth, BottomMarginHeight) Dim LeftOffset As Long, TopOffset As Long Dim LeftMargin As Long, TopMargin As Long Dim RightMargin As Long, BottomMargin As Long Dim fr As FormatRange Dim rcDrawTo As Rect Dim rcPage As Rect Dim TextLength As Long Dim NextCharPosition As Long Dim r As Long Printer.Print Space(1) Printer.ScaleMode = vbTwips LeftOffset = Printer.ScaleGetDeviceCaps(Printer.hdc, _ PHYSICALOFFSETX), vbPixels, vbTwips) TopOffset = Printer.ScaleY(GetDeviceCaps(Printer.hdc, _ PHYSICALOFFSETY), vbPixels, vbTwips) LeftMargin = LeftMarginWidth - LeftOffset TopMargin = TopMarginHeight - TopOffset RightMargin = (Printer.Width - RightMarginWidth) - LeftOffset BottomMargin = (Printer.Height - BottomMarginHeight) - TopOffset rcPage.Left = 0 rcPage.Top = 0 rcPage.Right = Printer.ScaleWidth rcPage.Bottom = Printer.ScaleHeight rcDrawTo.Left = LeftMargin rcDrawTo.Top = TopMargin rcDrawTo.Right = RightMargin rcDrawTo.Bottom = BottomMargin fr.hdc = Printer.hdc fr.hdcTarget = Printer.hdc fr.rc = rcDrawTo fr.rcPage = rcPage fr.chrg.cpMin = 0 fr.chrg.cpMax = -1 TextLength = Len(RTF.Text) Do NextCharPosition = SendMessage(RTF.hWnd, EM_FORMATRANGE, True, fr) If NextCharPosition >= TextLength Then Exit Do fr.chrg.cpMin = NextCharPosition Printer.NewPage Printer.Print Space(1) fr.hDC = Printer.hDC fr.hDCTarget = Printer.hDC Loop Printer.EndDoc r = SendMessage(RTF.hWnd, EM_FORMATRANGE, False, ByVal CLng(0)) End Sub -------------------------------------------------------------------------------- Como obtener el directorio desde donde estamos ejecutando nuestro programa: Escribir el siguiente código: Private Sub Form_Load() Dim Directorio as String ChDir App.Path ChDrive App.Path Directorio = App.Path If Len(Directorio) > 3 Then Directorio = Directorio & "\" End If End Sub -------------------------------------------------------------------------------- Determinar si un fichero existe o no: Escriba el siguiente código: (una de tanta maneras aparte de Dir$()) Private Sub Form_Load() On Error GoTo Fallo x = GetAttr("C:\Autoexec.bat" MsgBox "El fichero existe." Exit Sub Fallo: MsgBox "El fichero no existe." End Sub -------------------------------------------------------------------------------- Capturar la pantalla entera o la ventana activa: Añadir dos botones y escribir el siguiente código: Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Private Sub Command1_Click() 'Captura la ventana activa keybd_event 44, 0, 0&, 0& End Sub Private Sub Command2_Click() 'Captura toda la pantalla keybd_event 44, 1, 0&, 0& End Sub -------------------------------------------------------------------------------- Salvar el contenido de un TextBox a un fichero en disco: Añada el siguiente código: Private Sub Command1_Click() Dim canalLibre As Integer 'Obtenemos un canal libre que nos dará 'el sistema oparativo para poder operar canalLibre = FreeFile 'Abrimos el fichero en el canal dado Open "C:\fichero.txt" For Output As #canalLibre 'Escribimos el contenido del TextBox al fichero Print #canalLibre, Text1 Close #canalLibre End Sub Nuevo Para abrir: Código: Dim foo As Integer foo = FreeFile Open "C:\Archivo.txt" For Input As #foo Text1.Text = Input(LOF(foo), #foo) Close #foo Para guardar: Código: Dim foo As Integer foo = FreeFile Open "C:\Archivo.txt" For Output As #foo Print #foo, Text1.Text Close #foo dialogos: Ese es para Abrir Código: Dim strOpen As String CommonDialog1.ShowOpen strOpen = CommonDialog1.FileName Text1.LoadFile strOpen Text1.LoadFile strClose Ese para guardar Código: Dim strNewFile As String CommonDialog1.ShowSave strNewFile = CommonDialog1.FileName Text1.SaveFile strNewFile vean la 2 parte http://taringa.net/posts/info/2273271/Crear-en-Visual-Basic-Manual-Part-2.html vean la 3 parte http://taringa.net/posts/info/2273315/Crear-en-Visual-Basic-Manual-Part-3.html

Existen varios metodos para actualizar el Antivirus NOD32, pero en todos los casos se requiere obtener una version específica para redes (profesional). Pero que hacer si el equipo que queremos actualizar no tiene conexion a Internet ni a la red. Existe un metodo práctico para hacerlo. REQUISITOS PREVIOS: Lo que necesitamos obligatoriamente es tener acceso a un Antivirus NOD32 instalado y recientemente actualizado via Internet, ya que usaremos los archivos de definicion de virus de esa actualización. Para actualizar otros Antivirus NOD32 en computadoras que no tienen conexion a Internet, procederemos así: En el equipo que contiene el Antivirus NOD32 actualizado recientemente, debemos ir a esta ruta: C:\Archivos de programa\Eset o ala ruta donde decidimos instalar el antivirus NOD32. Una vez en ese directorio, copiaremos los siguientes archivos: nod32.000 nod32.002 nod32.003 nod32.004 nod32.005 nod32.006 Los archivos anteriormente copiados, los podemos pegar en una nueva carpeta llamada "C:\NOD32_UPD" o como lo desees, luego copias esa carpeta a un CD-R, memoria USB, lo envias por e-mail, o como desees transportar esos archivos a la computadora destino. Cuando estes listo, puedes copiar esos archivos en el directorio: C:\Archivos de programa\Eset del computador que tenga el NOD32 instalado y que no disponga de conexion a Internet o a la red local, puedes hacer esto en tantos computadores como desees. Nota: Este procedimiento solo actualizará la base de la lista de virus, no actualiza el motor del antivirus. (Muy raras veces se actualiza este motor).