NOTA: Esta página está traducida por un traductor de esos gratuitos, no es una página normal.

API of windows (1º)
any functions interestings OF API of Windows (16 and 32 bits)

Actualizado the 19-Feb-1997
Pincha aquí yes quieres see the new archive onto THE API

Functions and examples:

1. Sendmessage: the than ever hay than tener to hand
2. Setwindowword: create windows flotantes
3. Handling of windows ...
4. Getvolumeinformation: read the volume of a drive (32 bits)
5. Getdrivetype: check the type of unit
6. Let a window ever visible
7. To wear Sleep in lieu of Doevents
8. Handling of record
9. Dialogs comunes OF API
10. Icons on the bar of task
11. Marcador of phones of Win95
12. Sleep parece than don't sirve for sustituir to doevents ...
13. To wear Gettickcount in lieu of Timer
    Example of Gettickcount()
14. Files of declarations OF API (16 and 32 bits)
15. Read the label of volume and the número of series (sólo 32 bits)
16. the línea actual and the número of lines a -box
17. Usage of Postmessage in lieu of Sendmessage

1.- Sendmessage: the than ever hay than tener to hand

'declaration  OF  API  of  16 bits 
Declare Function Sendmessage Lib "User" _ 
        (Byval hwnd As Integer, Byval wmsg As Integer, _ 
         Byval wparam As Integer, lparam As Any) As Long 
'declaration  OF  API  of  32 bits. 
Declare Function Sendmessage Lib "User32" Alias "Sendmessagea" _ 
        (Byval hwnd As Long, Byval wmsg As Long, _ 
         Byval wparam As Long, lparam As Long) As Long 
 
 
'utilities  a    of edition : 
' 
'declaration  the constantes  
Global Const WM_USER = &H400 
Global Const EM_GETSEL = WM_USER + 0 
Global Const EM_SETSEL = WM_USER + 1 
Global Const EM_REPLACESEL = WM_USER + 18 
Global Const EM_UNDO = WM_USER + 23 
Const EM_LINEFROMCHAR = WM_USER + 25 
Const EM_GETLINECOUNT = WM_USER + 10 
' 
Global Const WM_CUT = &H300 
Global Const WM_COPY = &H301 
Global Const WM_PASTE = &H302 
Global Const WM_CLEAR = &H303 
' 
'undo: 
    'notice: yes se ago of this shape , 
    'don't is necessary  to wear  a variable   for assign   the boldness  devuelto. 
    If Sendmessage(Screen.Activeform.Activecontrol.hwnd, EM_UNDO, 0, Byval 0&) Then 
    End If 
    'también: x = Sendmessage(Screen.Activeform.Activecontrol.hwnd, EM_UNDO, 0, Byval 0&) 
'copiar: 
    If Sendmessage(Screen.Activeform.Activecontrol.hwnd, WM_COPY, 0, Byval 0&) Then 
    End If 
'cut: 
    If Sendmessage(Screen.Activeform.Activecontrol.hwnd, WM_CUT, 0, Byval 0&) Then 
    End If 
'erase: 
    If Sendmessage(Screen.Activeform.Activecontrol.hwnd, WM_CLEAR, 0, Byval 0&) Then 
    End If 
'pegar: 
    If Sendmessage(Screen.Activeform.Activecontrol.hwnd, WM_PASTE, 0, Byval 0&) Then 
    End If 
'select  all : 
    If Sendmessage(Screen.Activeform.Activecontrol.hwnd, EM_SETSEL, 0, Byval &HFFFF0000) Then 
    End If 
 
 
'create  a  Textbox with 64 KB in lieu of  32

Global Const WM_USER = &H400 
Global Const EM_LIMITTEXT = WM_USER + 21 
 
Dim LTMP As long 
LTMP = Sendmessage(Text1.hwnd, EM_LIMITTEXT, 0, Byval 0&)

Declare Function Setwindowword Lib "User" (Byval hwnd As Integer, Byval nindex As Integer, Byval wnewword As Integer) As Integer 
Declare Function Setwindowword Lib "User32" Alias "Setwindowword" (Byval hwnd As Long, Byval nindex As Long, Byval wnewword As Long) As Long 
 
 
'create  a window  flotante al style  the  -buffet 
'when se minimiza  the window  father, también it ago ésta. 
Const SWW_hparent = -8 
 
'on Form_Load (suponiendo than  the window  father is Form1) 
If Setwindowword(hwnd, SWW_hparent, form1.hwnd) Then 
End If

'declaration  of functions   for take   the lists   of tasks  
Declare Function Getwindow Lib "user" (Byval hwnd As Integer, Byval wcmd As Integer) As Integer 
Declare Function Getwindowtext Lib "user" (Byval hwnd As Integer, Byval lpstring As String, Byval nmaxcount As Integer) As Integer 
Declare Function Getwindowtextlength Lib "user" (Byval hwnd As Integer) As Integer 
Declare Function Iswindowvisible Lib "User" (Byval hwnd As Integer) As Integer 
'declarations  for  32 bits 
Declare Function Getwindow Lib "user32" Alias "Getwindow" (Byval hwnd As Long, Byval wcmd As Long) As Long 
Declare Function Getwindowtext Lib "user32" Alias "Getwindowtexta" (Byval hwnd As Long, Byval lpstring As String, Byval cch As Long) As Long 
Declare Function Getwindowtextlength Lib "user32" Alias "Getwindowtextlengtha" (Byval hwnd As Long) As Long 
Declare Function Iswindowvisible Lib "user32" (Byval hwnd As Long) As Long 
 
'constantes  for  Getwindow 
Const GW_HWNDFIRST = 0 
Const GW_HWNDLAST = 1 
Const GW_HWNDNEXT = 2 
Const GW_HWNDPREV = 3 
Const GW_OWNER = 4 
Const GW_CHILD = 5

'values  of  retorno  of  Getdrivetype 
Public Const DRIVE_REMOVABLE = 2 
Public Const DRIVE_FIXED = 3 
Public Const DRIVE_REMOTE = 4 
'estos types  don't  están on  the file  of the declarations   OF  API  of  16 bits 
Public Const DRIVE_CDROM = 5 
Public Const DRIVE_RAMDISK = 6 
' 
Declare Function Getdrivetype Lib "Kernel" (Byval ndrive As Integer) As Integer 
Declare Function Getdrivetype Lib "Kernel32" Alias "Getdrivetypea" (Byval ndrive As String) As Long 
 
 
Dim ldrive As Long 
Dim szroot As String 
 
szroot="D:\" 'put aquí  the unit   OF CD -ROM or  the than  queramos check 
ldrive= Getdrivetype(szroot) 
If ldrive = DRIVE_CDROM Then 
    'is  A CD -ROM/Compact-Disc 
End If 

'declaration  for to wear  windows ever visibles  
'version  for  16 bits 
Declare Function Setwindowpos Lib "User" (Byval hwnd As Integer, Byval hwndinsertafter As Integer, Byval X As Integer, Byval AND As Integer, Byval cx As Integer, Byval cy As Integer, Byval wflags As Integer) As Integer 
'version  for  32 bits 
Declare Function Setwindowpos Lib "User32" Alias "Setwindowpos" (Byval hwnd As Long, Byval hwndinsertafter As Long, Byval x As Long, Byval and As Long, Byval cx As Long, Byval cy As Long, Byval wflags As Long) As Long 
 
 
' Setwindowpos Flags 
Const SWP_NOSIZE = &H1 
Const SWP_NOMOVE = &H2 
'const SWP_NOZORDER = &H4 
'const SWP_NOREDRAW = &H8 
Const SWP_NOACTIVATE = &H10 
'const SWP_DRAWFRAME = &H20 
Const SWP_SHOWWINDOW = &H40 
'const SWP_HIDEWINDOW = &H80 
'const SWP_NOCOPYBITS = &H100 
'const SWP_NOREPOSITION = &H200 
Const SWP_FLAGS = SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW Or SWP_NOACTIVATE 
 
 
'código  for put  on Form_Load 
 
'of  this shape  there is not  necessary  to wear  a variable   for assign   the boldness  devuelto: 
If Setwindowpos(hwnd, -1, 0, 0, 0, 0, SWP_FLAGS) Then 
End if 

while (Peekmessage(&msg, NULL, 0, 0, PM_REMOVE)) { 
    Translatemessage(&msg); 
    Dispatchmessage(&msg); 
}

Public Declare Sub Sleep Lib "kernel32" Alias "Sleep" (Byval dwmilliseconds As Long)

Sleep 0&

Public Const HKEY_CLASSES_ROOT = &H80000000 
 
Declare Function Regqueryvalue Lib "advapi32.dll" Alias "Regqueryvaluea" _ 
    (Byval hkey As Long, Byval lpsubkey As String, Byval lpvalue As String, _ 
     lpcbvalue As Long) As Long 
 
'busca  a input  on  the record  
Private Function Queryregbase(Byval Entry As String, Optional vkey) As String 
    Dim buf As String 
    Dim buflen As Long 
    Dim hkey As Long 
    'yes  don't  se especifica  the  clave  of record , to wear HKEY_CLASSES_ROOT 
    If Ismissing(vkey) Then 
        hkey = HKEY_CLASSES_ROOT 
    Else 
        hkey = CLNG(vkey) 
    End If 
     
    On The error local  Resume Next 
    buf = Space$(300) 
    buflen = Len(buf) 
    'search  the input  especificada and devolver  the boldness  assigned  
    If Regqueryvalue(hkey, Entry, buf, buflen) = 0 Then 
        If buflen > 1 Then 
            'he format devuelto is ASCIIZ, thus than remove  the ultimate  character 
            Queryregbase = Left$(buf, buflen - 1) 
        Else 
            Queryregbase = "" 
        End If 
    Else 
        Queryregbase = "" 
    End If 
    'desactivar  the detecting   of errores  
    On The error local  Goto 0 
End Function

Private Sub Buscarextensionid(sext As String) 
    Dim lret As Long 
    Dim skey As String 
    Dim svalue As String 
    Dim hkey As Long 
    Dim sexe As String 
    Dim sicon As String 
    Dim licon As Long 
    Dim sprogid As String 
    Dim i As Integer 
     
    Caption = "Show asociaciones  the  : " & sext 
    List2.Visible  = True 
    List2.Clear 
    List2.Additem "Values  of record   for  " & sext 
    ' 
    'search on  the record   the extent ... 
    sprogid = Queryregbase(sext) 
    If Len(sprogid) Then 
        List2.Additem "Clave: " & sprogid 
        skey = sprogid & "\Defaulticon" 
        List2.Additem skey 
        svalue = Queryregbase(skey) 
        If Len(svalue) Then 
            i = Instr(svalue, ",") 
            If i Then 
                sicon = Left$(svalue, i - 1) 
                licon = Val(Mid$(svalue, i + 1)) 
            Else    'don't tiene program  for  Defaulticon 
                sicon = svalue 
                licon = 0 
                svalue = "" 
            End If 
        End If 
        List2.Additem "   Icon  of : " & sicon 
        List2.Additem "   Icon nº: " & licon 
    ' 
        'gets  the program  associated  by default   for unlock  
    'don't quiere say than  this  sea  the than  se ejecute when se haga double-click 
        skey = sprogid & "\Shell\Open\Command" 
        svalue = Queryregbase(skey) 
        If Len(svalue) Then 
            i = Instr(svalue, ".") 
            If i Then 
                i = Instr(i, svalue, " ") 
                If i Then 
                    sexe = Trim$(Left$(svalue, i - 1)) 
                Else 
                    sexe = Trim$(svalue) 
                End If 
            Else 
                sexe = Trim$(svalue) 
            End If 
        End If 
        List2.Additem skey 
        List2.Additem "   Program associated:: " & sexe 
    End If 
End Sub

'claves  of record  
Public Const HKEY_CLASSES_ROOT = &H80000000 
Public Const HKEY_CURRENT_USER = &H80000001 
Public Const HKEY_LOCAL_MACHINE = &H80000002 
Public Const HKEY_USERS = &H80000003 
' 
'para  the values  devueltos for the functions   of handling   of record  
Public Const ERROR_SUCCESS = 0& 
Public Const ERROR_ DON'T _MORE_ITEMS = 259& 
' 
' Data types  Reg... 
Public Const REG_SZ = 1 
' 
'declarations  OF  API  of windows   for  32 bits 
Declare Function Regqueryvalue Lib "advapi32.dll" Alias "Regqueryvaluea" (Byval hkey As Long, Byval lpsubkey As String, Byval lpvalue As String, lpcbvalue As Long) As Long 
Declare Function Regenumkey Lib "advapi32" Alias "Regenumkeya" (Byval hkey As Long, Byval isubkey As Long, Byval lpszname As String, Byval cchname As Long) As Long 
Declare Function Regopenkey Lib "advapi32" Alias "Regopenkeya" (Byval hkey As Long, Byval lpszsubkey As String, phkresult As Long) As Long 
Declare Function Regclosekey Lib "advapi32" (Byval hkey As Long) As Long 
Declare Function Regcreatekey Lib "advapi32.dll" Alias "Regcreatekeya" (Byval hkey As Long, Byval lpsubkey As String, phkresult As Long) As Long 
Declare Function Regsetvalue Lib "advapi32.dll" Alias "Regsetvaluea" (Byval hkey As Long, Byval lpsubkey As String, Byval dwtype As Long, Byval lpdata As String, Byval cbdata As Long) As Long 
Declare Function Regdeletekey Lib "advapi32.dll" Alias "Regdeletekeya" (Byval hkey As Long, Byval lpsubkey As String) As Long 
 
'declarations  THE    of  16 bits 
Declare Function Regqueryvalue Lib "shell.dll" (Byval hkey As Long, Byval lpsubkey As String, Byval lpvalue As String, lpcbvalue As Long) As Long 
Declare Function Regenumkey Lib "shell.dll" (Byval hkey As Long, Byval isubkey As Long, Byval lpszname As String, Byval cchname As Long) As Long 
Declare Function Regopenkey Lib "shell.dll" (Byval hkey As Long, Byval lpszsubkey As String, phkresult As Long) As Long 
Declare Function Regclosekey Lib "shell.dll" (Byval hkey As Long) As Long 
Declare Function Regcreatekey Lib "shell.dll" (Byval hkey As Long, Byval lpsubkey As String, phkresult As Long) As Long 
Declare Function Regsetvalue Lib "shell.dll" (Byval hkey As Long, Byval lpsubkey As String, Byval dwtype As Long, Byval lpdata As String, Byval cbdata As Long) As Long 
Declare Function Regdeletekey Lib "shell.dll" (Byval hkey As Long, Byval lpsubkey As String) As Long 
 

'Declarations  THE    of  16 bits 
'unlock and keep 
Declare Function Getopenfilename Lib "commdlg.dll" (lpofn As tagopenfilename) As Integer 
Declare Function Getsavefilename Lib "commdlg.dll" (lpofn As tagopenfilename) As Integer 
'search and replace (aún  don't  he could ponerlas on walking???) 
Declare Function Findtext Lib "commdlg.dll" (lpfr As tagfindreplace) As Integer 
Declare Function Replacetext Lib "commdlg.dll" (lpfr As tagfindreplace) As Integer 
'para  the printer  
Declare Function Printdlg Lib "commdlg.dll" (tagpd As tagprintdlg) As Integer 
' 
 
'Declarations  for  32 bits 
'unlock and keep 
Declare Function Getopenfilename Lib "comdlg32.dll" Alias "Getopenfilenamea" (popenfilename As OPENFILENAME) As Long 
Declare Function Getsavefilename Lib "comdlg32.dll" Alias "Getsavefilenamea" (popenfilename As OPENFILENAME) As Long 
Declare Function Getfiletitle Lib "comdlg32.dll" Alias "Getfiletitlea" (Byval lpszfile As String, Byval lpsztitle As String, Byval cbbuf As Integer) As Integer 
'search and replace 
Declare Function Findtext Lib "comdlg32.dll" Alias "Findtexta " (pfindreplace As FINDREPLACE) As Long 
Declare Function Replacetext Lib "comdlg32.dll" Alias "Replacetexta" (pfindreplace As FINDREPLACE) As Long 
'para  the printer  
Declare Function Printdlg Lib "comdlg32.dll" Alias "Printdlga" (pprintdlg As PRINTDLG) As Long 
Declare Function Pagesetupdlg Lib "comdlg32.dll" Alias "Pagesetupdlga" (ppagesetupdlg As PAGESETUPDLG) As Long 
'para  the colors  
Declare Function Choosecolor Lib "comdlg32.dll" Alias "Choosecolora" (pchoosecolor As CHOOSECOLOR) As Long 
'las fonts 
Declare Function Choosefont Lib "comdlg32.dll" Alias "Choosefonta" (pchoosefont As CHOOSEFONT) As Long 

'--------------- 
Private Type TIPONOTIFICARICONO 
    cbsize As Long 
    hwnd As Long 
    uid As Long 
    uflags As Long 
    ucallbackmessage As Long 
    hicon As Long 
    sztip As String * 64 
End Type 
'------------------ 
Private Const NIM_ADD = &H0 
Private Const NIM_MODIFY = &H1 
Private Const NIM_DELETE = &H2 
Private Const WM_MOUSEMOVE = &H200 
Private Const NIF_MESSAGE = &H1 
Private Const NIF_ICON = &H2 
Private Const NIF_TIP = &H4 
Private Const WM_LBUTTONDBLCLK = &H203 
Private Const WM_LBUTTONDOWN = &H201 
Private Const WM_LBUTTONUP = &H202 
Private Const WM_RBUTTONDBLCLK = &H206 
Private Const WM_RBUTTONDOWN = &H204 
Private Const WM_RBUTTONUP = &H205 
'-------------------- 
Private Declare Function Shell_Notifyicon Lib "shell32" _ 
    Alias "Shell_Notifyicona" (Byval dwmessage As Long, _ 
    pnid As TIPONOTIFICARICONO) As Boolean 
'-------------------- 
Private Declare Function Winexec& Lib "kernel32" _ 
    (Byval lpcmdline As String, Byval ncmdshow As Long) 
'-------------------- 
Dim t As TIPONOTIFICARICONO 
 
 
Private Sub Form_Load() 
    If App.Previnstance Then 
        mnuacerca_Click 
        Unload Me 
        End 
    End If 
'--------------------------------- 
    t.cbsize = Len(t) 
    t.hwnd = picgancho.hwnd 
    t.uid = 1& 
    t.uflags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE 
    t.ucallbackmessage = WM_MOUSEMOVE 
    t.hicon = Me.Icon 
'--------------------------------- 
    t.sztip = "Example  of bar   of tasks ..." & Chr$(0) ' Is  a  string  of  "C" ( \0 ) 
    Shell_Notifyicon NIM_ADD, t 
    Me.Hide 
    App.Taskvisible = False 
End Sub

Private Declare Function tapirequestmakecall& Lib "TAPI32.DLL" (Byval Destaddress&, Byval Appname$, Byval Calledparty$, Byval Comment$) 
 
 
Private Sub Command1_Click() 
    Dim Valdev&, Number$, Nombreprog$, Quien$ 
    Number = "123-4567" 
    Nombreprog = "My Program" 
    Quien = "Pepe" 
    Valdev = tapirequestmakecall(Number, Nombreprog,Quien,"") 
End Sub 

'la declaration  this    for  16 and 32 bits: 
#If Win32 Then 
    Declare Function Gettickcount Lib "kernel32" () As Long 
#Else 
    Declare Function Gettickcount Lib "User" () As Long 
#End If

Dim T1 As Long 
Dim T2 As Long 
Dim L As Long 
 
T1 = Gettickcount() 
For L = 1 to 320000 
    Doevents 
Next 
T2 = Gettickcount() 
Print "Duration: "; T2 - T1 ; " milisegundos." 

' 
'proof  of  Timer,               (21:00 14/Ene/96) 
Option Explicit 
 
'declaration  OF  API 
#If Win32 Then 
    Private Declare Function Gettickcount Lib "Kernel32" () As Long 
#Else 
    Private Declare Function Gettickcount Lib "User" () As Long 
#End If 
 
 
'para know than doing debe take  the  botón 
Dim Counting As Boolean 
'variables  the   
Dim g1 As Long 
Dim g2 As Long 
Dim g3 As Long 
'variables  the  1 
Dim t1 As Long 
Dim t2 As Long 
'boldness  the   
Dim vtimer As Long 
'flag  for cancel   the loop  
Dim Cancel As Boolean 
'boldness máximo  of items   to show  
Dim Maxbucle As Long 
 
Private Sub cmdiniciar_Click() 
    Count 
End Sub 
 
Private Sub cmdsalir_Click() 
    Cancel = True 
    Doevents 
    Counting = True 
    Count 
    Unload Me 
End Sub 
 
Private Sub Form_Load() 
    ' 
    Timer1.Interval = 1000 
    Timer1.Enabled = False 
    Text1 = "1000" 
    Maxbucle = 20000 
End Sub 
 
Private Sub Text1_Change() 
    ' 
    Dim vtmp 
    Static Yaestoy As Boolean 
     
    'don't enter while se procesa... 
    If Yaestoy Then Exit Sub 
     
    Yaestoy = True 
     
    vtmp = Val(Text1) \ 10 
    If vtmp > VSCROLL1.Min Then 
        vtmp = VSCROLL1.Min 
    End If 
    If vtmp  (g3 + 1) * 1000 Then 
        g3 = g3 + 1 
        Show 
    End If 
    Doevents 
End Sub 
 
Private Sub Show() 
    Label2(0) = t2 
    Label2(1) = g3 
End Sub 
'

	API of 32 bits (win32api.zip 146 KB)
	API of 16 bits for windows 3.1 (win31api.zip 33,9 KB)
	API of 16 bits for windows 3.0 (win30api.zip 25,6 KB)
	API of 16 bits extensions for windows 3.1 (Win31ext.zip 7,86 KB)

'--------------------------------------------------------------------------- 
'form  of proof   for read   the label  and  the  número  of series  of a drive . 
'                                                                (18/Feb/97) 
'--------------------------------------------------------------------------- 
Option Explicit 
 
'declaration  the  , sólo está on  THE  API  of  32 bits 
' 
Private Declare Function Getvolumeinformation Lib "Kernel32" _ 
    Alias "Getvolumeinformationa" (Byval lprootpathname As String, _ 
                                    Byval lpvolumenamebuffer As String, _ 
                                    Byval nvolumenamesize As Long, _ 
                                    lpvolumeserialnumber As Long, _ 
                                    lpmaximumcomponentlength As Long, _ 
                                    lpfilesystemflags As Long, _ 
                                    Byval lpfilesystemnamebuffer As String, _ 
                                    Byval nfilesystemnamesize As Long) As Long 
 
 
Private Sub Command1_Click() 
    'doing 
    Dim lvsn As Long, n As Long, s1 As String, s2 As String 
    Dim unit As String 
    Dim stmp As String 
     
    On The error local  Resume Next 
     
    'se debe specify  the directory  root 
    unit = Trim$(Text1) 
     
    'reserve space  the strings  than se pasarán al API 
    s1 = String$(255, Chr$(0)) 
    s2 = String$(255, Chr$(0)) 
    n = Getvolumeinformation(unit, s1, Len(s1), lvsn, 0, 0, s2, Len(s2)) 
    's1 será  the label   of volume  
    'lvsn tendrá  the boldness   of  Volume Serial Number (número  of series   of volume ) 
    's2  the type   of archives : FAT, etc. 
 
    'convertirlo  to  hexadecimal  for  mostrarlo like on  the  Dir. 
    stmp = Hex$(lvsn) 
     
    Label3(0) = s1 
    Label3(1) = Left$(stmp, 4) & "-" & Right$(stmp, 4) 
    Label3(2) = s2 
End Sub 
 
 
Private Sub Command2_Click() 
    Unload Me 
    End 
End Sub 
 
 
Private Sub Form_Unload(Cancel As Integer) 
    'asegurarnos  of  "releases"  the memory . 
    Set Form1 = Nothing 
End Sub

Const WM_USER = 1024 
Const EM_GETLINECOUNT = WM_USER + 10 
Const EM_LINEFROMCHAR = WM_USER + 25 
Totallineas = Sendmessage(Text1.hwnd, EM_GETLINECOUNT, 0, 0&) 
Lineaactual = Sendmessage(Text1.hwnd, EM_LINEFROMCHAR, -1, 0&) + 1 

'declaration  OF  API  of  32 bits 
Declare Function Postmessage Lib "User32" Alias "Postmessagea" _ 
        (Byval hwnd As Long, Byval wmsg As Long, _ 
         Byval wparam As Long, Byval lparam As Long) As Long 
 
'declaration  OF  API  of  16 bits 
Declare Function Postmessage Lib "User" _ 
        (Byval hwnd As Integer, Byval wmsg As Integer, _ 
         Byval wparam As Integer, lparam As Any) As Integer