Ejemplos usando el Api de windows para Visual basic

233 - Api tapiRequestMakeCall - marcador de teléfono

Programa realizado por Helmuth Campos

Hola, les dejo un codigo de una utilidad que hice, permite marcar un número determinado, llamando al dialer de windows,usando el TAPI de 32 bits, es muy útil

Formulario con el marcador de teléfono

vista previa del formulario para el marcador de telefono

Descargar ejemplo

Código fuente

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 Declare Function tapiRequestMakeCall& Lib "TAPI32.DLL" ( _ ByVal DestAddress$, _ ByVal AppName$, _ ByVal CalledParty$, _ ByVal Comment$) Const TAPIERR_NOREQUESTRECIPIENT = -2& Const TAPIERR_REQUESTQUEUEFULL = -3& Const TAPIERR_INVALDESTADDRESS = -4& Const FICHERO = "Dialer2.LOG" 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 'Declaración de las constantes Const WM_USER = &H400 'Declaración de las constantes Const EM_LIMITTEXT = WM_USER + 21 'Utilidades para un menú de edición: 'Declaración de las constantes Const EM_GETSEL = WM_USER + 0 Const EM_SETSEL As Long = &HB1 Const EM_REPLACESEL = WM_USER + 18 Const EM_UNDO = WM_USER + 23 Const EM_LINEFROMCHAR = WM_USER + 25 Const EM_GETLINECOUNT = WM_USER + 10 ' Const WM_CUT = &H300 Const WM_COPY = &H301 Const WM_PASTE = &H302 Const WM_CLEAR = &H303 Private Sub CmdDial_Click() Dim buff As String Dim nResult As Long 'Invoca a tapiRequestMakeCall. si tapiRequestMakeCall devuelve 0, el 'recado es aceptado . Y se le llama al Marcador de teléfono de Windows 'para marcar al número determinado. nResult = tapiRequestMakeCall&(Trim$(TxtNumber), CStr(Caption), "Test Dialer", "") 'Mostrar el error sucedido If nResult <> 0 Then buff = "Error de dialer nro : " Select Case nResult Case TAPIERR_NOREQUESTRECIPIENT buff = buff & "El dialer de Windows, no se inicia, o no existe." Case TAPIERR_REQUESTQUEUEFULL buff = buff & "Las llamadas del Dialer de Windows, están llenas." Case TAPIERR_INVALDESTADDRESS buff = buff & "El número marcado es inválido." Case Else buff = buff & "Error desconocido." End Select MsgBox buff End If '------------------------------------------------------ ' Aceptar '------------------------------------------------------ Dim scmd As String Dim nf As Integer Dim i As Integer Dim n As Integer Dim k As Integer Dim stmp As String Dim sProg As String scmd = UCase$(Trim$(TxtNumber.Text)) If Len(scmd) Then 'Añadir el comando al List1 y grabarlo 'Comprobar si ya está el comando n = List1.ListCount i = False For k = 0 To n - 1 If scmd = List1.List(k) Then i = True Exit For End If Next 'Si no está, añadirlo a la lista If Not i Then List1.AddItem scmd End If n = List1.ListCount k = 1 If n > 50 Then 'Grabar 50 comandos como máximo k = n - 50 + 1 End If nf = FreeFile Open FICHERO For Output As nf For i = n To k Step -1 stmp = List1.List(i - 1) Print #nf, stmp Next Close nf List1.Clear End If End Sub Private Sub Command1_Click() TxtNumber.SelText = 1 End Sub Private Sub Command10_Click() TxtNumber.SelText = "*" End Sub Private Sub Command11_Click() TxtNumber.SelText = 0 End Sub Private Sub Command12_Click() TxtNumber.SelText = "#" End Sub Private Sub Command2_Click() TxtNumber.SelText = 2 End Sub Private Sub Command3_Click() TxtNumber.SelText = 3 End Sub Private Sub Command4_Click() TxtNumber.SelText = 4 End Sub Private Sub Command5_Click() TxtNumber.SelText = 5 End Sub Private Sub Command6_Click() TxtNumber.SelText = 6 End Sub Private Sub Command7_Click() TxtNumber.SelText = 7 End Sub Private Sub Command8_Click() TxtNumber.SelText = 8 End Sub Private Sub Command9_Click() TxtNumber.SelText = 9 End Sub Private Sub EnableDial() CmdDial.Enabled = Len(Trim$(TxtNumber)) > 0 End Sub Private Sub Form_Load() EnableDial On Error GoTo propieinválida Dim nf As Integer Dim stmp As String 'Efecto3D 0, 1, Label1 'Efecto3D 2, 3, Label2 'Efecto3D 4, 5, List1 'Efecto3D 6, 7, Text1 List1.Clear CmdDial.Enabled = False 'Leer el archivo de últimos comandos If Len(Dir$(FICHERO)) Then nf = FreeFile Open FICHERO For Input As nf Do While Not EOF(nf) Line Input #nf, stmp List1.AddItem stmp Loop Close nf List1.ListIndex = 0 End If Exit Sub propieinválida: If Err = 380 Then MsgBox "El archivo Dialer2.log, lo dejaste (0) bits", 48, "Propiedad inválida" End If Resume Next End Sub Private Sub Form_Resize() On Error Resume Next 'Centra el formulario completamente Move (Screen.Width - Width) \ 29, (Screen.Height - Height) \ 29 End Sub Private Sub List1_Click() CmdDial.Enabled = True TxtNumber.Text = List1.List(List1.ListIndex) End Sub Private Sub List1_KeyUp(KeyCode As Integer, Shift As Integer) Const KEY_DEL = 46 Dim i As Integer Select Case KeyCode Case KEY_DEL 'borrar este item del List i = List1.ListIndex List1.RemoveItem i If i > 1 Then List1.ListIndex = i - 1 End If End Select End Sub Private Sub MnuAcerca_Click(Index As Integer) Call ShellAbout(Me.hwnd, "Marcador de teléfono 1.0", "Copyright 2007, Dj_Dexter", Me.Icon) End Sub Private Sub MnuActualizar_Click(Index As Integer) On Error GoTo propieinválida1 Dim nf2 As Integer Dim stmp2 As String 'Efecto3D 0, 1, Label1 'Efecto3D 2, 3, Label2 'Efecto3D 4, 5, List1 'Efecto3D 6, 7, Text1 List1.Clear CmdDial.Enabled = False 'Leer el archivo de últimos comandos If Len(Dir$(FICHERO)) Then nf2 = FreeFile Open FICHERO For Input As nf2 Do While Not EOF(nf2) Line Input #nf2, stmp2 List1.AddItem stmp2 Loop Close nf2 List1.ListIndex = 0 End If Exit Sub propieinválida1: If Err = 380 Then MsgBox "El archivo Dialer2.log, lo dejaste (0) bits", 48, "Propiedad inválida" End If Resume Next End Sub Private Sub MnuCopiar_Click(Index As Integer) If SendMessage(Screen.ActiveForm.ActiveControl.hwnd, WM_COPY, 0, ByVal 0&) Then End If End Sub Private Sub MnuCortar_Click(Index As Integer) If SendMessage(Screen.ActiveForm.ActiveControl.hwnd, WM_CUT, 0, ByVal 0&) Then End If End Sub Private Sub MnuDeshacer_Click(Index As Integer) UndoResultado = SendMessage(TxtNumber.hwnd, &HC7, 0&, 0&) If UndoResultado = -1 Then Beep MsgBox "Error al intentar recuperar.", 20, "Undo" End If End Sub Private Sub MnuElimina_Click(Index As Integer) If SendMessage(Screen.ActiveForm.ActiveControl.hwnd, WM_CLEAR, 0, ByVal 0&) Then End If End Sub Private Sub MnuPegar_Click(Index As Integer) If SendMessage(Screen.ActiveForm.ActiveControl.hwnd, WM_PASTE, 0, ByVal 0&) Then End If End Sub Private Sub MnuSale_Click(Index As Integer) End End Sub Private Sub MnuSelectodo_Click(Index As Integer) ' seleccionarlo todo SendMessage TxtNumber.hwnd, EM_SETSEL, 0&, -1& End Sub Private Sub TxtNumber_Change() EnableDial End Sub

Buscar en Recursos vb