Utilización de algunas APIS de windows en VB

UTILIZACIÓN DE ALGUNAS API'S DE WINDOWS EN VISUAL BASIC

sndPlaySound (Ejecutar sonidos .WAV)

API

'Código para el Modulo
Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
'Código para el procedimiento
'Definimos las variables
Dim CadenaResultante As Long
Const SND_SYNC = &H0
Const SND_NODEFAULT = &H2
CadenaResultante = sndPlaySound("nombre_direccion_archivo.wav", SND_SYNC Or SND_NODEFAULT)

Ejecutar el programa lector de archivos WAV,RMI,AVI,MOV,GT,MPEG,MPG,M1V,MP2,MPA del Windows.

Dim x As Double
'Reemplaza Ubicacion_NombreArchivo por el archivo que quieres escuchar en el momento que se ejecute el programa
'Abre el programa
x = Shell("C:\WINDOWS\rundll32.exe C:\WINDOWS\SYSTEM\amovie.ocx,RunDll /open Ubicacion_NombreArchivo", 1)
'Abre el programa, ejecuta el archivo y cierra el programa
x = Shell("C:\WINDOWS\rundll32.exe C:\WINDOWS\SYSTEM\amovie.ocx,RunDll /play /close c:\windows\ymh8.wav", 1)

FindExecutable (Busca el archivo ejecutable asociado a un archivo, y muestra el icono)

API

Busca el archivo ejecutable asociado a un archivo, y muestra el icono del archivo ejecutable en un picture

'Código para el Modulo
'Funcion que busca el ejecutable
Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
'Funciones para el icono
'hDC- Device context of the control to be drawn to
'x, y- coordinates of where to draw the icon in the control
'hIcon-Handle of an icon
Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
'hinst- The instance handle of the application calling ExtractIcon. Should be the name of your EXE file, or VB.EXE at runtime
'lpszExeName- Module containing icons
'iIcon%- number of the icon in the file. If you put -1 for this, it returns the amount of icons in a file
'The return value should be: 1)An icon handle 2)1 if it's not a EXE, DLL, or ICO file 3)NULL if no icons are in a file
Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
'lpModuleName- The filename of a module, to get the handle of it.
Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
'Código para el procedimiento
'Definimos las variables
Dim CadenaResultante As Long
Dim AplicacionAsociada As String * 255
Dim Fichero As String
Dim FicheroEjecutable As String
Dim NumeroIconos As Integer
Dim Icono As Integer
Dim Res As Integer
'Inicializamos las variables
Fichero = "archivo a buscar el ejecutable"
CadenaResultante = FindExecutable(Fichero, "", AplicacionAsociada)
'mostramos el resultado
If Not IsEmpty(AplicacionAsociada) Then
   Print Left(AplicacionAsociada, (InStr(AplicacionAsociada, Chr(0))) - 1)
   FicheroEjecutable = Left(AplicacionAsociada, (InStr(AplicacionAsociada, Chr(0))) - 1)
End If
'mostramos el icono de la aplicación
NumeroIconos = ExtractIcon(0, FicheroEjecutable, -1)
If NumeroIconos > 0 Then
   Icono = ExtractIcon(0, FicheroEjecutable, 0)
   Res = DrawIcon(Picture1.hdc, 0, 0, Icono)
End If

GetKeyboardStateByString - SetKeyboardStateByString (Seleccionar y Deseleccionar el Bloque Numerico del teclado)

API

Seleccionar y deseleccionar el Bloque Numerico del teclado.
Para ellos se utilizan dos botones.

'Código para el Modulo
Public Declare Sub GetKeyboardStateByString Lib "user32" Alias "GetKeyboardState" (ByVal pbKeyState As String)
Public Declare Sub SetKeyboardStateByString Lib "user32" Alias "SetKeyboardState" (ByVal lppbKeyState As String)
Public Const VK_NUMLOCK = &H90
'Código para el procedimiento
'Boton 1 para seleccionar el Bloq Num
Private Sub Command1_Click()
   Dim NumLockKey As String * 256
   NumLockKey = Space$(256)
   GetKeyboardStateByString (NumLockKey)
   Mid$(NumLockKey, VK_NUMLOCK + 1, 1) = Chr$(1)
   Call SetKeyboardStateByString(NumLockKey)
End Sub
Boton 2 para deseleccionar el Bloq Num
Private Sub Command2_Click()
   Dim NumLockKey As String * 256
   NumLockKey = Space$(256)
   GetKeyboardStateByString (NumLockKey)
   Mid$(NumLockKey, VK_NUMLOCK + 1, 1) = Chr$(0)
   Call SetKeyboardStateByString(NumLockKey)
End Sub

FindWindow (Indica si una aplicación determinada esta en ejecución)

API

'Código para el Modulo
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'Creamos una función que nos indicara si una aplicación determinada esta abierta
Function EsUnico(TituloVentana As String) As Long
   'Buscar una ventana con una Caption determinado y devuelve 0 si no la encuentra, y sino, el manejador de la misma
   Dim hWnd As Long
   hWnd = FindWindow(vbNullString, TituloVentana)
   EsUnico = IIf(hWnd = 0, 0, hWnd)
End Function
'Código para el procedimiento
Dim CadenaResultante As Long
CadenaResultante = EsUnico("Nombre_Caption_del_programa")
If CadenaResultante <> 0 Then Print "la aplicacion esta en uso"

SystemParametersInfo (Activa/Desactiva las teclas de Escape - CTRL+ALT+SUB - ALT+TAB - CRTL+ESC)

API

'Código para el Modulo
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Public Const SPI_SCREENSAVERRUNNING = 97&
'Código para el procedimiento
'Desactivar teclas de Escape
Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1&, 0&, 0&)
'Activar teclas de Escape
Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0&, 0&, 0&)

GetSysColor (Devuelve los colores del Windows) API

'Código para el Modulo
Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Public Const COLOR_ACTIVEBORDER = 10 'borde de una ventana activa
Public Const COLOR_ACTIVECAPTION = 2 'Titulo de una ventana activa
Public Const COLOR_APPWORKSPACE = 12 'Fondo de escritorio MDI
Public Const COLOR_BACKGROUND = 1 'Escritorio de Windows
Public Const COLOR_BTNFACE = 15 'Botón
Public Const COLOR_BTNHIGHLIGHT = 20 'Realzado de 3D del botón
Public Const COLOR_BTNSHADOW = 16 'Oscurecimiento de 3D del botón
Public Const COLOR_BTNTEXT = 18 'Texto del botón
Public Const COLOR_CAPTIONTEXT = 9 'Texto del titulo de la ventana
Public Const COLOR_GRAYTEXT = 17 'Texto gris, o cero si se utiliza una oscilación de color
Public Const COLOR_HIGHLIGHT = 13 'Fondo de un item seleccionado
Public Const COLOR_HIGHLIGHTTEXT = 14 'Texto de un item seleccionado
Public Const COLOR_INACTIVEBORDER = 11 'Borde de una ventana inactiva
Public Const COLOR_INACTIVECAPTION = 3 'Titulo de una ventana inactiva
Public Const COLOR_INACTIVECAPTIONTEXT = 19 'Texto de una ventana inactiva
Public Const COLOR_MENU = 4 'Menú
Public Const COLOR_MENUTEXT = 7 'Texto del menú
Public Const COLOR_SCROLLBAR = 0 'Barra de desplazamiento
Public Const COLOR_WINDOW = 5 'Fondo de ventana
Public Const COLOR_WINDOWFRAME = 6 'Marco de ventana
Public Const COLOR_WINDOWTEXT = 8 'Texto de ventana
Public Const COLOR_3DDKSHADOW = 21 'Sombra oscura de 3D
Public Const COLOR_3DFACE = COLOR_BTNFACE 'Color en los objetos oscurecidos de 3D
Public Const COLOR_3DHILIGHT = COLOR_BTNHIGHLIGHT 'Color de realzado de 3D
Public Const COLOR_3DLIGHT = 22 'Color claro de los objetos oscurecidos de 3D
Public Const COLOR_INFOBK = 24 'Color del fondo de las microayudas
Public Const COLOR_INFOTEXT = 23 'Color del texto de las microayudas
'Código para el procedimiento
'Devuelve el color del borde de la ventana activa en formato RGB
print GetSysColor(COLOR_ACTIVECAPTION)
'Devuelve el color del borde de la ventana activa en formato Hexadecimal
print GetSysColor(COLOR_ACTIVECAPTION) And &HFFFFFF

GetACP (Determina la página de código ANSI vigente) API

'Código para el Modulo
Declare Function GetACP Lib "kernel32" () As Long
'Código para el procedimiento
Dim CadenaResultante As Long
CadenaResultante = GetACP()
Select Case CadenaResultante
   Case 874
      Print "Tailandés"
   Case 932
      Print "Japonés"
   Case 936
      Print "Chino"
   Case 949
      Print "Coreano"
   Case 950
      Print "Chino (Taiwan y Hong Kong)"
   Case 1200
      Print "Unicode"
   Case 1250
      Print "Europeo del este"
   Case 1251
      Print "Cirílico"
   Case 1252
      Print "EE. UU. y Europeo del oeste"
   Case 1253
      Print "Griego"
   Case 1254
      Print "Turco"
   Case 1255
      Print "Hebreo"
   Case 1256
      Print "Árabe"
   Case 1257
      Print "Báltico"
End Select

SetWindowPos (Esconder y mostrar la barra de tareas del Windows) API

'Código para el Modulo
'Busca en la lista de vantanas, la primera ventana de nivel superior que satisface las condiciones especificadas
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'Especifica un nuevo estado y una nueva posición para una ventana
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
'hwnd = manejador de la ventana
'constantes para hWndInsertAfter
'Determina la posicion de la ventana en la lista de ventanas
Public Const HWND_BOTTOM = 1 ' Final de la lista
Public Const HWND_TOP = 0 ' Inicio de la lista
Public Const HWND_TOPMOST = -1 ' Inicio de la lista por encima de cualquier ventana de nivel superior
Public Const HWND_NOTOPMOST = -2 ' Coloca la venta al inicio de la lista, debajo de las de nivel superior
'constantes para wFlags
Public Const SWP_FRAMECHANGED = &H20 ' The frame changed: send WM_NCCALCSIZE
Public Const SWP_DRAWFRAME = SWP_FRAMECHANGED ' Dibuja un marco alrededor de la ventana
Public Const SWP_HIDEWINDOW = &H80 ' Esconde la ventana
Public Const SWP_NOACTIVATE = &H10 ' no activa la ventana
Public Const SWP_NOMOVE = &H2 ' mantiene la posicion actual
Public Const SWP_NOREDRAW = &H8 ' la ventana no se redibuja automáticamente
Public Const SWP_NOSIZE = &H1 ' Mantiene el tamaño actual
Public Const SWP_NOZORDER = &H4 ' Mantiene la posicion vigente en la lista de ventanas
Public Const SWP_SHOWWINDOW = &H40 'Presenta en pantalla la ventana
'x,y = coordenadas de la ventana
'cx,cy = Ancho y algo de la ventana
Global HwndVentana As Long
Global CadenaResultante As Long
'Código para el procedimiento
'Oculta la barra de tareas
HwndVentana = FindWindow("Shell_traywnd", "")
CadenaResultante = SetWindowPos(HwndVentana, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
'Devuelve cero en caso de error
'Muestra la barra de tareas
CadenaResultante = SetWindowPos(HwndVentana, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
'Devuelve cero en caso de error

ExitWindowsEx (Apaga o Reinicia el Windows 95/98) API

'Código para el Modulo
Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Const EWX_FORCE = 4 ' Fuerza la terminacion de un proceso que no responde
Public Const EWX_LOGOFF = 0 ' Termina un proceso y sale del Windows
Public Const EWX_REBOOT = 2 ' Reinicia el sistema
Public Const EWX_SHUTDOWN = 1 ' para el sistema
'Código para el procedimiento
'Reinica el sistema
Dim CadenaResultante As Long
Dim x As Long
CadenaResultante = ExitWindowsEx(EWX_FORCE Or EWX_REBOOT, x)
'Devuelve cero en caso de error
'Apagar el sistema
CadenaResultante = ExitWindowsEx(EWX_FORCE Or EWX_SHUTDOWN, x)
'Devuelve cero en caso de error

GetSystemInfo (Información sobre el Hardware) API

'Código para el Modulo
Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
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
Global Sistema As SYSTEM_INFO
'Código para el procedimiento
GetSystemInfo Sistema
Print "El tamaño de página es : " & Format(Sistema.dwPageSize, "#,###")
Print "Dirección inferior de memoria : " & Format(Sistema.lpMinimumApplicationAddress, "#,###")
Print "Dirección superior de memoria : " & Format(Sistema.lpMaximumApplicationAddress, "#,###")
Print "Cantidad de Procesadores : " & Format(Sistema.dwNumberOrfProcessors, "#,###")
Print "Procesador : " & Sistema.dwProcessorType