Hola a todos. Mi nombre es Gustavo Alegre Hidalgo y estoy construyendo esta web destinada a todos los programadores de Visual Basic.
Si quieres colaborar con esta web enviando algún artículo o noticia, no dudes en contactarme. Gracias.
Hola a todos. Mi nombre es Gustavo Alegre Hidalgo y estoy construyendo esta web destinada a todos los programadores de Visual Basic.
Si quieres colaborar con esta web enviando algún artículo o noticia, no dudes en contactarme. Gracias.
Enviar mensajes a toda una red local utilizando Winsock, desde Visual Basic.
En la página web del Guille están 2 ejemplos que elaboré sobre cómo enviar mensajes públicos a toda una red utilizando Winsock y la clase Socket (en .NET). A continuación una pequeña reseña:
Este ejemplo ilustra una manera muy fácil de crear una aplicación para enviar mensajes públicos a toda una red (similar al WinPopup de Win9X o al Mensajero de NT/2k/XP). El trabajo se realiza utilizando un control Winsock que apunta hacia la dirección IP 255.255.255.255 (dirección global o Broadcast) y a un puerto definido por el usuario.
Antes que nada explico un poco la función de UDP: El Protocolo de Datagramas de Usuario (o User Datagram Protocol) consiste en el envío de información de una PC a otra sin una conexión explícita (lo contrario al protocolo TCP que si requiere una conexión desde el cliente al servidor). Este protocolo es muy utilizado para recibir videos y música mediante el conocido streaming.
Al no requerir una conexión explícita, un programa UDP puede ser a la vez cliente como servidor (de ahí el origen a las aplicaciones de igual a igual o P2P), lo cual nos permite hacer programas tipo Chat LAN entre 2 o más computadoras con un mínimo esfuerzo.
Para no hacer muy larga esta página, les escribo los enlaces para que puedan leer mis artículos:
http://www.elguille.info/colabora/vb2005/galegre_BroadcastUDP.htm (para VB 6.0)
http://www.elguille.info/colabora/NET2005/galegre_BroadcastUDPNET.htm (para .NET)
Enviado por Yuri
Código fuente para averiguar el nombre de red de una PC, desde Visual Basic y utilizando API.
' Esta funcion permite saber el nombre de la PC en donde estamos ejecutando una 'aplicacion. Fue expuesta en la lista de noticas de Visual Basic. Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal LpBuffer As String, nSize As Long) As Long Function PCName() As String Dim sBuffer As String Dim lSize As Long sBuffer = Space$(255) lSize = Len(sBuffer) Call GetComputerName(sBuffer, lSize) If lSize > 1 Then PCName = Left$(sBuffer, lSize) If Asc(Right$(PCName, 1)) = 0 Then PCName = Left$(PCName, Len(PCName) - 1) End If Else PCName = "Desconocido" End If End Function 'Llamando la funcion PCName, esta devuelve el nombre de la PC.
Enviado por Yuri
Código fuente para leer y escribir en archivos de configuración local (*.ini).
'Esta funcion la encontre cuando necesitaba validar ciertos parametros de 'manera externa y antes de ejecutar mi sistema. Ahora cada uno le puede 'dar el uso que mas le convenga. No recuerdo exactamente 'donde la encontre pero aclaro que fue asi, no la hago de mi propiedad. 'En un modulo Bas ponemos el siguiente codigo 'Declaración de las funciones API's para escribir y leer archivos INI. 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 'Función para leer los datos en archivos INI: Public Function INI_Read(Filename As String, Key_Value As String, Key_Name As String, Optional ByVal Default As String) As String 'On Error GoTo ErrOut Dim Size As Integer Dim value As String 'Comprobamos que el archivo existe. If Not SYS_FileExists(Filename) Then Err.Raise 53 'Se define el tamaño maximo de caracteres 'que podra tener la variable Value value = Space(200) 'Se utiliza la función para obtener 'el valor de la clave Size = GetPrivateProfileString(Key_Value, Key_Name, "", value, Len(value), Filename) 'Si el tamaño es mayor a -1 entonces 'se ha encontrado el valor de la clave If Size > 0 Then value = Left$(value, Size) Else INI_Read = Default End If 'Devolver el dato... 'Verificar que el dato no sea nulo, 'en caso de ser nulo de se devuelve 'el valor por defecto (Default) If Len(value) Then INI_Read = value Else INI_Read = Default End If Exit Function ErrOut: INI_Read = Default End Function 'Función para escrbir datos en archivos INI. Public Function INI_Write(Filename As String, Key_Value As String, Key_Name As String, value As String) As Long 'On Error GoTo ErrOut Dim Size As Integer 'Escribimos el valor de la clave en el INI Size = WritePrivateProfileString(Key_Value, Key_Name, value, Filename) INI_Write = 1 Exit Function ErrOut: INI_Write = 0 End Function '********************* INVOCACION ***************** 'Si nuestro archivo Ini ( Config.Ini ) es asi [General] Ruta="C:Sistema" BaseDatos="Clientes.Mdb" 'En nuestro programa hacemos asi: cRutaActual = INI_Read("Config.ini", "General", "Ruta", "C:") cBaseDatos = INI_Read( "Config.Ini", "General", "BaseDatos", "Data.Mdb" ) 'El ultimo parametro de invocacion son los valores default en caso no se 'encuentre nada en el archivo Ini, como medida de consistencia '
Cómo matar un proceso si se conoce el nombre del archivo EXE. Un método más seguro para cerrar aplicaciones en vez de utilizar el título de su ventana principal.
Este ejemplo muestra cómo cerrar un proceso con la API de Windows, y utilizando el nombre del EXE a cerrar. Código: Crear un proyecto nuevo de Visual Basic y en el Form1 colocar un TextBox y CommandButton, luego pegar el siguiente código.
Option Explicit Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" _ (ByVal lFlags As Long, ByVal lProcessID As Long) As Long Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" _ (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" _ (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long) Private Type PROCESSENTRY32 dwSize As Long cntUsage As Long th32ProcessID As Long th32DefaultHeapID As Long th32ModuleID As Long cntThreads As Long th32ParentProcessID As Long pcPriClassBase As Long dwFlags As Long szExeFile As String * 260 End Type Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, _ ByVal uExitCode As Long) As Long Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long Private Const PROCESS_TERMINATE = &H1; Private Const PROCESS_CREATE_THREAD = &H2; Private Const PROCESS_VM_OPERATION = &H8; Private Const PROCESS_VM_READ = &H10; Private Const PROCESS_VM_WRITE = &H20; Private Const PROCESS_DUP_HANDLE = &H40; Private Const PROCESS_CREATE_PROCESS = &H80; Private Const PROCESS_SET_QUOTA = &H100; Private Const PROCESS_SET_INFORMATION = &H200; Private Const PROCESS_QUERY_INFORMATION = &H400; Private Const STANDARD_RIGHTS_REQUIRED = &HF0000; Private Const SYNCHRONIZE = &H100000; Private Const PROCESS_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF; Private Sub Command1_Click() Dim hSnapShot As Long, uProceso As PROCESSENTRY32 Dim res As Long, dwIDProceso As Long Dim hProceso As Long, Resultado As Long dwIDProceso = -1 hSnapShot = CreateToolhelpSnapshot(2&, 0&) If hSnapShot <> 0 Then uProceso.dwSize = Len(uProceso) res = ProcessFirst(hSnapShot, uProceso) Do While res If Left$(uProceso.szExeFile, InStr(uProceso.szExeFile, Chr$(0)) - 1) = LCase(Text1.Text) Then 'Si se encuentra el proceso, se guarda su ID. dwIDProceso = uProceso.th32ProcessID Exit Do End If res = ProcessNext(hSnapShot, uProceso) Loop Call CloseHandle(hSnapShot) End If 'Si el proceso no está abierto... If dwIDProceso = -1 Then MsgBox "El proceso """ & LCase(Text1.Text) & """ no está abierto" Else hProceso = OpenProcess(PROCESS_TERMINATE, True, dwIDProceso) Resultado = TerminateProcess(hProceso, 99) CloseHandle hProceso 'Si se cerró correctamente... If Resultado <> 0 Then MsgBox "El proceso """ & LCase(Text1.Text) & """ ha sido cerrado correctamente." Else MsgBox "El proceso """ & LCase(Text1.Text) & """ no pudo ser cerrado." End If End If End Sub
Ejecutar la aplicación y escribir en el cuadro de texto el nombre del EXE a cerrar y luego pulsar el botón.
Un truco para que el contenido de una ficha se muestre apenas se pulse sobre la misma, como los cuadros de diálogo de Windows.
Normalmente en un cuadro de diálogo con fichas (como Propiedades de Pantalla), al hacer clic en alguna de ellas el contenido de la misma se muestra inmediatamente, cosa que no sucede con el control TabStrip de Visual Basic, en el cual la información de la ficha se muestra después que hemos soltado el botón izquierdo del mouse. En este truco vamos a subsanar ese error de diseño utilizando la llamada a la API mouse_event en el evento MouseDown del TabStrip para forzar al mismo a ejecutar el evento Click() antes de soltar el botón izquierdo del mouse.
Option Explicit Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, _ ByVal dx As Long, ByVal dy As Long, _ ByVal cButtons As Long, ByVal dwExtraInfo As Long) Private Const MOUSEEVENTF_LEFTUP = &H4; Private Sub TabStrip1_Click() Dim i As Long For i = 0 To TabStrip1.Tabs.Count - 1 fraFichas(i).Visible = False Next i fraFichas(TabStrip1.SelectedItem.Index - 1).Visible = True End Sub Private Sub TabStrip1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) mouse_event MOUSEEVENTF_LEFTUP, 0&, 0&, 0&, 0& End Sub
Una clase para crear cronómetros ascendentes y cuentas regresivas en tiempo real que supera las limitaciones del control Timer.
En algunas aplicaciones es necesario controlar el tiempo de una determinada tarea, un procedimiento, y de forma más elaborada en proyectos para control de cybercafés. Básicamente para crear cronómetros se usa el control Timer; sin embargo éste tiene sus limitaciones, como la falta de precisión entre eventos Timer y el contador se detiene al hacer CTRL+ALT+SUPR en Windows 9x, lo que hace que éste control no sea el más adecuado para crear cronómetros en tiempo real. Por ello es recomendable utilizar la API de Windows y esta clase simplifica el uso de la función GetTickCount para la creación de cronómetros de cuenta regresiva y normales.
Código fuente de la clase clsCronómetro:
Option Explicit 'Declaración de la API Private Declare Function GetTickCount Lib "kernel32" () As Long 'Variables para el control del tiempo Dim TiempoFinal As Long Dim TiempoParado As Long Dim CuandoParó As Long 'Establece una cuenta regresiva, donde 'el argumento "Segundos" es la cantidad de 'segundos que se quiere fijar. Public Sub EstablecerTiempo(Segundos As Long) TiempoFinal = QuitarDecimales(GetTickCount / 1000) + Segundos TiempoParado = 0 End Sub 'Establece una cuenta libre, osea un cronómetro 'común y corriente. Si deseas puedes establecer el 'argumento "TiempoQueHaTranscurrido" para indicar 'desde dónde va a comenzar el cronómetro. Public Sub EstablecerLibre(Optional TiempoQueHaTranscurrido As Long = 0) TiempoFinal = QuitarDecimales(GetTickCount / 1000) - TiempoQueHaTranscurrido TiempoParado = 0 End Sub 'Agrega tiempo a un cronómetro en curso, donde '"Segundos" es la cantidad de tiempo a agregar. Public Sub AgregarTiempo(Segundos As Long) TiempoFinal = QuitarDecimales(TiempoFinal) + Segundos End Sub 'Utilizar esta función para obtener el tiempo 'en curso de una cuenta regresiva. Public Function ObtenerTiempo() As Long ObtenerTiempo = TiempoFinal - QuitarDecimales(GetTickCount / 1000) + TiempoParado End Function 'Utilizar esta función para obtener el tiempo 'en curso de un cronómetro normal. Public Function ObtenerTiempoLibre() As Long ObtenerTiempoLibre = QuitarDecimales(GetTickCount / 1000) - TiempoFinal - TiempoParado End Function 'Detiene momentaneamente el tiempo de 'un cronómetro en curso. Public Function CongelarTiempo() CuandoParó = QuitarDecimales(GetTickCount / 1000) End Function 'Reanuda el tiempo de un cronómetro en 'curso. Public Function ReanudarTiempo() TiempoParado = TiempoParado + QuitarDecimales(GetTickCount / 1000) - CuandoParó End Function 'Función privada para quitar los decimales que se 'obtienen al llamar a la API GetTickCount. Private Function QuitarDecimales(ByVal Número) As Long On Error Resume Next Dim NúmeroConvertido As String, NúmeroNuevo As String NúmeroConvertido = Número If Len(NúmeroConvertido) <> 1 Then NúmeroNuevo = Left(NúmeroConvertido, InStr(1, NúmeroConvertido, ".") - 1) If Err.Number = 5 Then NúmeroNuevo = NúmeroConvertido Else NúmeroNuevo = NúmeroConvertido End If QuitarDecimales = Val(NúmeroNuevo) End Function
Adicionalmente a la clase puedes usar esta función para convertir los segundos obtenidos con la función ObtenerTiempo u ObtenerTiempoLibre al formato “hh:mm:ss”.
'Función para convertir una cantidad de 'segundos en el formato "hh:mm:ss". Private Function FormatoHoras(Segundos As Long) As String Dim Hora As Long, Minuto As Long, Segundo As Long Dim Tiempo As Single Tiempo = Segundos 'Separa el tiempo en horas, minutos y segundos Hora = Int(Tiempo / 3600) Minuto = Int((Tiempo - Hora * 3600) / 60) Segundo = Tiempo - Hora * 3600 - Minuto * 60 'Formatea el tiempo como cadena FormatoHoras = Format(Hora, "00") & ":" & Format(Minuto, "00") & ":" & Format(Segundo, "00") End Function
Función para detectar si un índice de una matriz de controles está libre y así poder reutilizarlo.
Hay situaciones en que es necesario cargar y descargar controles en tiempo de ejecución. La forma más sencilla de cargar un nuevo control en un formulario es usar una matriz de controles. Sin embargo, si los índices de la matriz no están en orden ascendente (provocado por descargas de algunos de los controles), no hay función intrínseca que permita hallar el primer índice libre de dicha matriz y aprovechar al máximo la numeración de la misma. Para ello sirve esta función: PrimerIndiceLibre, que permite detectar el primer índice libre de una matriz de controles usando bucles, en el caso que la numeración esté completa la función devuelve el último índice de la matriz + 1.
Código de la función:
Public Function PrimerIndiceLibre(Matriz As Object) As Integer On Error GoTo Encontrado Dim IndiceFaltante As Integer Dim Nada As String Dim i As Integer For i = 0 To Matriz. UBound Nada = Matriz(i).Tag DoEvents Next i PrimerIndiceLibre = Matriz.UBound + 1 Exit Function Encontrado: IndiceFaltante = i DoEvents PrimerIndiceLibre = IndiceFaltante Exit Function End Function
Cómo insertar imágenes JPG, GIF y BMP de una forma sencilla.
A veces es necesario aprovechar todos los recursos que nos brinda el control RichTextBox. Si estamos creando un procesador de textos con este control, nos sería interesante hacer que nuestros programas tengan muchas posibilidades (formato, color, viñetas, etc) pero entre una de ellas está la de poder insertar imágenes dentro del documento. Para ello vamos a usar el Portapapeles y una llamada a la API SendMessage para lograr poner la imagen dentro del RichTextBox. El proyecto también tiene el control CommonDialog para abrir la imagen.
Código:
Option Explicit Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hWnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, lParam As Long) As Long Private Const WM_PASTE = &H302; Private Sub cmdInsertarImagen_Click() On Error GoTo ErrorImagen Dim strRutaImagen As String Dim imgLaImagen As Picture Dim strContenidoPortapapeles As String With cdlImagen .DialogTitle = "Insertar imagen" .CancelError = True .Filter = "Todos los archivos de imágenes|*.gif;*.jpg;*.jpe;*.bmp;*.png|" _ & "Imágenes GIF (*.gif)|*.gif|Imágenes JPG (*.jpg, *.jpe)|*.jpg;*.jpe|" _ & "Imágenes de mapas de bits (*.bmp)|*.bmp|Imágenes PNG (*.png)|*.png| _ & "Todos los archivos (*.*)|*.*" .FilterIndex = 1 .Flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly .ShowOpen strRutaImagen = .FileName End With Set imgLaImagen = LoadPicture(strRutaImagen) strContenidoPortapapeles = Clipboard.GetText Clipboard.Clear Clipboard.SetData imgLaImagen SendMessage rtfTexto.hWnd, WM_PASTE, 0, 0 Clipboard.Clear Clipboard.SetText strContenidoPortapapeles Exit Sub ErrorImagen: If Err.Number <> 32755 Then MsgBox "Error " & Err.Number & " " & Err.Description Exit Sub End If End Sub
La imagen queda insertada en el RichTextBox como si de un objeto se tratase. Se puede cambiar de tamaño, mover, y el texto va acompañado de la imagen.
Ejemplo para abrir archivos e imágenes utilizando Drag & Drop y OLE.
Los controles TextBox y PictureBox poseen compatibilidad con la tecnología OLE, la que permite arrastrar y pegar información desde otras aplicaciones y del mismo explorador. En este ejemplo vamos a hacer una programa que permita copiar y mover una imagen de un Picture a otro y a la vez abrir archivos de gráficos arrastrados desde el explorador.
Crea un formulario y coloca en él 2 controles Picture, llámalos picPartida y picDestino respectivamente y cargue cualquier imagen en el picPartida (propiedad Picture)
En el PictureBox picPartida establece la propiedad OLEDragMode a 1-Automatic y OLEDropMode a 0-None, y en el picDestino la propiedad OLEDragMode a 0-Manual y OLEDropMode a 1-Manual. Luego pega en el formulario el siguiente código:
Option Explicit Private Sub picDestino_OLEDragDrop(Data As DataObject, Effect As Long, _ Button As Integer, Shift As Integer, X As Single, Y As Single) 'Si se ha arrrastrado una imagen If Data.GetFormat(vbCFDIB) Then 'Tomamos la información Set picDestino.Picture = Data.GetData(vbCFDIB) 'Si se han arrastrado archivos ElseIf Data.GetFormat(vbCFFiles) Then 'Prevenimos un posible error On Error Resume Next 'Al intentar cargar el primero de los archivos Set picDestino.Picture = LoadPicture(Data.Files(1)) If Err Then 'Si se produce un error 'Indicamos que no es posible abrirlo MsgBox "No es posible abrir el archivo " & Data.Files(1) End If End If 'En caso de que esté pulsada la techa Ctrl If Shift And vbCtrlMask Then 'La operación es mover Effect = vbDropEffectMove End If End Sub Private Sub picDestino_OLEDragOver(Data As DataObject, Effect As Long, _ Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer) 'Si el formato es el apropiado If Data.GetFormat(vbCFDIB) Or Data.GetFormat(vbCFFiles) Then 'En caso de que esté pulsada la techa Ctrl If Shift And vbCtrlMask Then 'La operación es mover Effect = vbDropEffectMove End If Else 'Si el formato no es el esperado Effect = vbDropEffectNone 'No aceptamos End If End Sub
Ejecute la aplicación. Puede arrastrar la imagen del picPartida al picDestino para copiarla. Si mantiene pulsada la tecla CTRL la imagen se moverá. También puede arrastrar archivos de imágenes desde el explorador al picDestino para abrirlos.
Código para cerrar un proceso utilizando el título de la ventana principal del programa. Muy útil en casos que se desee cerrar aplicaciones desde nuestro programa.
Crear un módulo y pegue el siguiente código:
Option Explicit Private Declare Function OpenProcess Lib "kernel32" (ByVal _ dwDesiredAccess As Long, ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Private Declare Function GetExitCodeProcess Lib "kernel32" _ (ByVal hProcess As Long, lpExitCode As Long) As Long Private Declare Function TerminateProcess Lib "kernel32" _ (ByVal hProcess As Long, ByVal uExitCode As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject _ As Long) As Long Private Declare Function GetWindowThreadProcessId Lib "user32" _ (ByVal hwnd As Long, lpdwProcessId As Long) As Long Private Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" (ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Private Declare Function CloseWindow Lib "user32" (ByVal hwnd As Long) As Long Const PROCESS_TERMINATE = &H1; Const PROCESS_QUERY_INFORMATION = &H400; Const STILL_ACTIVE = &H103; Public Sub CerrarProceso(TítuloVentana As String) Dim hProceso As Long Dim lEstado As Long Dim idProc As Long Dim winHwnd As Long winHwnd = FindWindow(vbNullString, TítuloVentana) If winHwnd = 0 Then Debug.Print "El proceso no está abierto": Exit Sub End If Call GetWindowThreadProcessId(winHwnd, idProc) ' Obtenemos el handle al proceso hProceso = OpenProcess(PROCESS_TERMINATE Or _ PROCESS_QUERY_INFORMATION, 0, idProc) If hProceso <> 0 Then ' Comprobamos estado del proceso GetExitCodeProcess hProceso, lEstado If lEstado = STILL_ACTIVE Then ' Cerramos el proceso If TerminateProcess(hProceso, 9) <> 0 Then Debug.Print "Proceso cerrado" Else Debug.Print "No se pudo matar el proceso" End If End If ' Cerramos el handle asociado al proceso CloseHandle hProceso Else Debug.Print "No se pudo tener acceso al proceso" End If End Sub
Por ejemplo, si desea cerrar la calculadora de Windows, llame a la función así: CerrarProceso(“Calculadora”). Donde “Calculadora” es el título de la ventana del programa que desea cerrar.