[Aportes indexados] Pequeña clase de API's en VB

Estado
Cerrado para nuevas respuestas.

Shura

Dragón Ancestral Lvl 2
INTRODUCCION A LAS API´s DE WINDOWs.


Primero que todo, API quiere decir Aplication Program Interface, o lo que es lo mismo Interfase para la programación de Aplicaciones. Las api son funciones ajenas a VB, por lo que tiene que buscar afuera (Windows) en dlls´s o en archivos .exe que trae Windows.

Como dijimos antes el mismo Windows nos deja acceder a las api, que usa para hacer distintas tareas como por ejemplo dejar una ventana Always on top, reiniciar el sistema, Acceder al registro y modificarlo, abrir la lectora de cd...etc (y si... como estas pensando se usan para hacer bromas también xD o daño en algunos casos). En sintesis hacer exactamente todo o casi todo lo que hace windows hacia el usuario.


El armado para llamar alguna función API consta de:


[PRIVATE] + 'DECLARE FUNCTION' + <NOMBREDELAFUNCION> + 'LIB' + <"LIBRERIA"> + 'ALIAS' + (Parametros)

Si la funcion necesita el uso de CONSTANTES es necesario declararlas antes.

Por ejemplo para obtener el nombre de la PC escribiríamos lo siguiente en un módulo para poder distinguir bien el codigo.....o escribirlo en el mismo Form (General) <Poco Recomendado>.-
Código:
 
Private Declare Function NombrePC Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Sub Form_Load()
    Dim Cadena As String
    Cadena = String(255, Chr$(0))
   NombrePC Cadena, 255
   Cadena = Left$(Cadena, InStr(1, Cadena, Chr$(0)))
  MsgBox Cadena
End Sub
 
Como se puede observar se uso la librería "Kernel32" (Es el núcleo del S.O), pero hay otras mas usadas como:

GDI32 > Funciones para manejar la parte gráfica y de pantalla
USER32 > Funciones de uso en general
ADVAPI32 > Funciones de nivel avanzado
WINMM > La parte sonido y multimedia

Shell32, nos sirve para ejecutar algo, por ejemplo abrir el Outlook Express para que alguien nos envie un mail, o abrir el explorador para que entre a un sitio determinado
otras: Comdlg32, winspool.drv, lz32, Ole32 etc.

Donde esta el Api Viewer?
Menu Inicio/Programas/Microsoft Visual Studio 6.0/Herramientas de Microsoft Visual Studio 6.0/(He aqui) Visor de Texto API >O su direccion equivalente en Inglés.

Como usar el api Viewer?
Una vez abierto el API Viewer, tenemos que cargar los datos (Archivos .txt) que trae, ponemos cargar archivo de texto, dependiendo de la pc va tener una pequeña tardanza por lo cual va a preguntar si queremos convertir a una BD para tener acceso mas rápido. Le ponemos si, y usamos, buscando en la parte superior de búsqueda.

Algunos Ejemplos Útiles


*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

Abrir Outlook para que nos envíen un mail

---------------
SHELL32
(Copialo tal cual y pegalo)
---------------
Código:
 
Private 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
 
Const SW_SHOWNORMAL = 1
 
Private Sub Form_Load()
    ShellExecute Me.hwnd, vbNullString, "mailto:shadow_enn_357 @ Hotmail.com", vbNullString, "C:", SW_SHOWNORMAL
End Sub
 
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

Para Obtener la Version de Windows

---------------
KERNEL32
(Copialo tal cual y pegalo)
---------------
Código:
 
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
 
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type
 
Private Sub Form_Load()
    Dim OSInfo As OSVERSIONINFO, PId As String
     Me.AutoRedraw = True
    'Set the structure size
    OSInfo.dwOSVersionInfoSize = Len(OSInfo)
    'Get the Windows version
    Ret& = GetVersionEx(OSInfo)
    'Chack for errors
    If Ret& = 0 Then MsgBox "Error Getting Version Information": Exit Sub
 
    'Print the information to the form
    Select Case OSInfo.dwPlatformId
        Case 0
            PId = "Windows 32s "
        Case 1
            PId = "Windows 95/98"
        Case 2
            PId = "Windows NT "
    End Select
 
    Print "OS: " + PId
    Print "Win version:" + Str$(OSInfo.dwMajorVersion) + "." + LTrim(Str(OSInfo.dwMinorVersion))
    Print "Build: " + Str(OSInfo.dwBuildNumber)
End Sub
 
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

Dibujo y Formas
>Necesita *Dos Timer con Intervalo =100 un *Command Button
---------------
GDI32
(Copialo tal cual y pegalo)
---------------
Código:
 
Private Type POINTAPI
    x As Long
    y As Long
End Type
 
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
 
Private Sub Form_Load()
    Timer1.Interval = 100
    Timer1.Enabled = True
    Timer2.Interval = 100
    Timer2.Enabled = True
    Command1.Caption = "Draw Text"
End Sub
 
'This will draw an Ellipse on the active window
Sub Timer1_Timer()
    Dim Position As POINTAPI
    'Get the cursor position
    GetCursorPos Position
    'Draw the Ellipse on the Screen's DC
    Ellipse GetWindowDC(0), Position.x - 5, Position.y - 5, Position.x + 5, Position.y + 5
End Sub
 
Sub Command1_Click()
    Dim intCount As Integer, strString As String
    strString = "Cool, text on screen !"
    For intCount = 0 To 30
        'Draw the text on the screen
        TextOut GetWindowDC(0), intCount * 20, intCount * 20, strString, Len(strString)
    Next intCount
End Sub
 
Private Sub Timer2_Timer()
    'Draw the text to the active window
    TextOut GetWindowDC(GetActiveWindow), 50, 50, "This is a form", 14
End Sub
 
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

Obtiene Nombre de Usuario
>Necesita un control Timer
---------------
ADVAPI32
(Copialo tal cual y pegalo)
---------------
Código:
 
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
 
Private Sub Form_Load()
    Timer1.Interval = 100
    Timer1.Enabled = True
    Dim strTemp As String, strUserName As String
    'Create a buffer
    strTemp = String(100, Chr$(0))
    'Get the temporary path
    GetTempPath 100, strTemp
    'strip the rest of the buffer
    strTemp = Left$(strTemp, InStr(strTemp, Chr$(0)) - 1)
 
    'Create a buffer
    strUserName = String(100, Chr$(0))
    'Get the username
    GetUserName strUserName, 100
    'strip the rest of the buffer
    strUserName = Left$(strUserName, InStr(strUserName, Chr$(0)) - 1)
 
    'Show the temppath and the username
    MsgBox "Hello " + strUserName + Chr$(13) + "The temp. path is " + strTemp
End Sub
 
Private Sub Timer1_Timer()
    Dim Boo As Boolean
    'Check if this form is minimized
    Boo = IsIconic(Me.hwnd)
    'Update the form's caption
    Me.Caption = "Form minimized: " + Str$(Boo)
End Sub
 
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

Reiniciar PC

-----------
USER32
(Copialo tal cual y pegalo)
----------
Código:
 
Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
 
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
 
Private Sub Form_Load()
    msg = MsgBox("This program is going to reboot your computer. Press OK to continue or Cancel to stop.", vbCritical + vbOKCancel + 256, App.Title)
    If msg = vbCancel Then End
    'reboot the computer
    ret& = ExitWindowsEx(EWX_FORCE Or EWX_REBOOT, 0)
End Sub
 
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
By
Shadow
2003

Nota1:
Algunos ejemplos Fueron sacados del API guide.
Nota2:
Me puedo haber equivocado en algo...o en todo, se aceptan sugerencias.


Función Api que permite abrir y cerrar el lector de CD.
Código:
 
'Api para incluir en un modulo
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 
 
'crear dos botones en un formulario
Private Sub Command1_Click() 
'Se abrirá el CD 
retvalue = mciSendString("set Cdaudio door open", returnstring, 127, 0) 
End Sub 
 
Private Sub Command2_Click() 
'Se cerrará el CD 
retvalue = mciSendString("set Cdaudio door closed", returnstring, 127, 0) 
End Sub
 
Escrito Por sowher'
 

Shura

Dragón Ancestral Lvl 2
El Visual Studios trae una herramienta llamada Spy++ el cual enumera todos los procesos con sus handles , classes y demas informacion. Vamos aprender a buscar el notepad con el API FindWindow() , de igual modo aprenderan a buscar cualquier otro programa para poder cojer su handle.

Abrimos el notepad y luego el Spy++ , vas a Search->Find Window y arrastramos la mira hasta la ventana donde este el notepad. Deberia de aparecernos su handle , Caption y Class, le damos a ok para continuar. Deberia de aparecernos algo asi:

Le damos un click derecho y vemos las propiedades del programa , vamos a la pestaña llamada Class y apuntamos el Class Name que en este caso es Notepad.

Ahora vamos al codigo , ya sowher les dijo como declarar las Api asi que:
Código:
 
 
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
'Creamos un boton y le dejamos por defecto Command1
 
Private Sub Command1_Click()
Dim hndl As Long
hndl = FindWindow("Notepad", vbNullString)
MsgBox hndl
End Sub
 
En mi caso el msgbox me da como resultado "197354" que si lo convertimos en hexadecimal es "302EA". Si vemos la imagen anterior vemos que he encontrado el handle del Notepad.

Escrito Por Crack_X
 

Shura

Dragón Ancestral Lvl 2
OBTENER LAS ETIKETAS
================
Código:
Attribute VB_Name = "Module1"
Option Explicit
 
'encontrar unidad
Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
 
'definir tipo
Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
 
Public Const Disco_CD = 5
Public Const Disco_Fijo = 3
Public Const Disco_Ram = 6
Public Const Disco_Remoto = 4
Public Const Disco_Removible = 2
USARLO:
Código:
Option Explicit
 
'encontrar
Dim Texto As String * 255
Dim Longitud As Long
Dim CadenaResultante1 As Long
Dim i As Integer
 
'definir
Dim Disco As String
Dim CadenaResultante As Long
Dim Informacion As String
 
Dim encontrada, mensaje, tipo As String
 
 
Private Sub Command1_Click()
 
Longitud = Len(Texto)
CadenaResultante1 = GetLogicalDriveStrings(Longitud, Texto)
 
For i = 1 To CadenaResultante1 Step 4
 
encontrada = Mid(Texto, i, 3)
 
Tipo_de_disco
 
mensaje = encontrada & "   '" & tipo
MsgBox mensaje, vbInformation, "Info by VZ"
 
Next i
 
End Sub
 
Sub Tipo_de_disco()
 
Disco = encontrada
 
CadenaResultante = GetDriveType(Disco)
 
Select Case CadenaResultante
Case Disco_Removible
Informacion = "Unidad Removible"
Case Disco_Fijo
Informacion = "Disco Fijo"
Case Disco_Remoto
Informacion = "Unidad Remota"
Case Disco_CD
Informacion = "Unidad CD"
Case Disco_Ram
Informacion = "Unidad Ram"
Case Else
Informacion = "Unidad Desconocida"
End Select
 
tipo = Informacion
 
End Sub
OBTENER LA IP, NOMBRE DEL EQUIPO
==========================
Código:
Private Declare Function inet_ntoa Lib "wsock32.dll" (ByVal addr As Long) As Long
Private Declare Function gethostname Lib "wsock32.dll" (ByVal hostname$, ByVal HostLen As Long) As Long
Private Declare Function gethostbyname Lib "wsock32.dll" (ByVal hostname$) As Long
Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVR As Long, lpWSAD As WSADATAType) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare Function WSAIsBlocking Lib "wsock32.dll" () As Long
Private Declare Function WSACancelBlockingCall Lib "wsock32.dll" () As Long
 
Public CadenaIp As String, NombreEqu As String
'la variable CadenaIp almacenará la ip, la variable NombreEqu alamacenará el nombre del equipo
 
Private Type in_addr
s_addr As Long
End Type
 
Private Type HostEnt
  h_name As Long
  h_aliases As Long
  h_addrtype As Integer
  h_length As Integer
  h_addr_list As Long
End Type
 
Private Const WSADescription_Len = 256
Private Const WSASYS_Status_Len = 128
 
Private Type WSADATAType
  wversion As Integer
  wHighVersion As Integer
  szDescription(0 To WSADescription_Len) As Byte
  szSystemStatus(0 To WSASYS_Status_Len) As Byte
  iMaxSockets As Integer
  iMaxUdpDg As Integer
  lpszVendorInfo As Long
End Type
 
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
Private Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, ByVal Src As Long, ByVal cb&)
 
Public Sub LocalizaIp()
On Error Resume Next
For Each Ip In ObtenerIPLocal()
CadenaIp = Ip
Next
End Sub
 
Private Function ObtenerIPLocal()
On Error Resume Next
 
If Not (StartWinsock()) Then Exit Function
 
Dim hostname As String * 256, hostent_addr As Long
'esta varialbe nos devolverá el nombre de equipo
Dim Host As HostEnt, hostip_addr As Long
Dim ad As in_addr, ipl As Long, ips As String
Dim ip_address() As String, x As Integer
ReDim ip_address(0 To 4)
 
If gethostname(hostname, 256) = -1 Then
Exit Function
Else
hostname = Trim$(hostname)
End If
 
hostent_addr = gethostbyname(hostname)
 
If hostent_addr = 0 Then Exit Function
 
MemCopy Host, hostent_addr, LenB(Host)
MemCopy hostip_addr, Host.h_addr_list, Host.h_length
 
Do
 
MemCopy ad.s_addr, hostip_addr, Host.h_length
ipl = inet_ntoa(ad.s_addr)
 
ips = String$(lstrlen(ipl) + 1, 0)
lstrcpy ips, ipl
 
ip_address(x) = ips
 
Host.h_addr_list = Host.h_addr_list + LenB(Host.h_addr_list)
MemCopy hostip_addr, Host.h_addr_list, Host.h_length
 
x = x + 1
Loop While (hostip_addr <> 0)
 
ReDim Preserve ip_address(x - 1)
 
ObtenerIPLocal = ip_address()
 
NombreEqu = hostname
 
Call EndWinsock
End Function
 
Private Function StartWinsock() As Boolean
On Error Resume Next
Dim StartupData As WSADATAType
StartWinsock = IIf(WSAStartup(&H101, StartupData) = 0, True, False)
End Function
 
Private Sub EndWinsock()
On Error Resume Next
If WSAIsBlocking() Then Call WSACancelBlockingCall
Call WSACleanup
End Sub
OBTENER LA CARPETA DE WINDOWS
========================
Código:
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public DirWindows As String'ESTA Almacena la ruta
 
Public Sub Carpeta_Windows()
Dim Temp As String
Dim Ret As Long
Const MAX_LENGTH = 145
Temp = String$(MAX_LENGTH, 0)
Ret = GetWindowsDirectory(Temp, MAX_LENGTH)
Temp = Left$(Temp, Ret)
If Temp <> "" And Right$(Temp, 1) <> "" Then
DirWindows = Temp & ""
Else
DirWindows = Temp
End If
End Sub
Escrito Por MaLkAvIaN_NeT
 

Shura

Dragón Ancestral Lvl 2
CREAR UN FRON CON APIS:
-------------------------------
Código:
'*********************************************
' Creador de from
' sowher / GEDZAC - Group / 2006
'*********************************************
 
Public Const WS_OVERLAPPED = &H0&
Public Const WS_VISIBLE = &H10000000
Public Const WS_MAXIMIZE = &H1000000
 
Public Const CS_DBLCLKS = &H8
 
Public Type WNDCLASSEX
    cbSize As Long
    style As Long
    lpfnwndproc As Long
    cbClsextra As Long
    cbWndExtra As Long
    hInstance As Long
    hIcon As Long
    hCursor As Long
    hbrBackground As Long
    lpszMenuName As String
    lpszClassName As String
    hIconSm As Long
End Type
 
Declare Function RegisterClassEx Lib "user32" Alias "RegisterClassExA" (pcWndClassEx As WNDCLASSEX) As Integer
Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Long) As Long
Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
 
Sub main()
    RegistrarClase (WindowProcedure)
    
    If Not CrearAplicacion Then
        MsgBox "Falla en la creacion de la aplicacion"
        UnregisterClass "mipropiaclase", App.hInstance
        Exit Sub
    End If
End Sub
 
Private Function RegistrarClase(FuncionMensajes As Long) As Boolean
    Dim clase As WNDCLASSEX
    
    clase.cbSize = 0
    clase.style = CS_DBLCLKS
    clase.lpfnwndproc = FuncionMensajes
    clase.cbClsextra = 0
    clase.cbWndExtra = 0
    clase.hInstance = App.hInstance
    clase.hIcon = 0
    clase.hCursor = 0
    clase.hbrBackground = COLOR_WINDOW + 1
    clase.lpszMenuName = 0
    clase.lpszClassName = "clase"
    clase.hIconSm = 0
    
    RegistrarClase = (RegisterClassEx(clase) <> 0)
End Function
 
Private Function CrearAplicacion() As Boolean
    'Tipos de Ventanas Principales
    hWnd = CreateWindowEx(0, "clase", "Ventana Principal", WS_OVERLAPPED Or WS_VISIBLE Or WS_MAXIMIZE, 0, 0, 500, 400, HWND_DESKTOP, 0, App.hInstance, ByVal 0&)
 
    If hWnd = 0 Then
        CrearAplicacion = False
        Exit Function
    End If
    
    ShowWindow hWnd, SW_SHOWDEFAULT
    CrearAplicacion = True
End Function
Escrito Por sowher
 
Estado
Cerrado para nuevas respuestas.
Arriba