Announcement

Collapse
No announcement yet.

Clipboard Phone Dialer

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

    Clipboard Phone Dialer

    Pretty cool really. Dials the phone number in the clipboard. Got the idea when Googling a local store and then had to manually dial the number. (Wotta pita.) Note it converts letters to numbers (CALL TODAY = 225586329) as well.

    It automatically adds a Country Code and Local Area Code as well (if needed). For example 123-4567 in clipboard dials 0017321234567. - Area and Country codes are set in (C)omport.

    The code and variables are a little sloppy and appear disjointed for posting purposes as much/most is adapted from a much larger personal database program I have rewritten/revised multiple times over 25 years but I think it can still be followed (I hope). (In any case, someone here will no doubt see the idea and come up with something cleaner quicker compacter simpler better codier cooler uncrappier in about 1 hour flat. {grin})

    In any case the way I use is it with a HotKey (a keyboard interrupt used to launch programs. See Hotkey.com). Could be launched from a Desktop shortcut as well, though not nearly as conveniently. Just clip the number and launch the program. Pretty simple and intuitive to use really.

    Also is the code to use it as an Include File so one can use it as an addon to another program. (Just has the PBMain stuff remmed out.)

    After seeing how it's received (tested) here, I'll post the code in Source Code as well.

    '
    Code:
    'PBWIN 9.01 - WinApi 05/2008 - XP Pro SP3
    '
    ' Just a quick little Clipboard Auto dialer.
    '               
    ' Note -  it adds a Country Code automatically if not present
    ' Note -  it adds a local Area Code automatically if not present
    ' Note - not tested outside USA
    '
    ' Contact: [EMAIL="[email protected]"][email protected][/EMAIL] - Use Subject = "Clipboard Auto dialer" (to avoid Jumk Filters)
     
    #Compile Exe  
    #Dim All
     
    #If Not %Def(%WINAPI)
      #Include "WIN32API.INC"
    #EndIf
    '
    'Modem
       %Id_ComPort       = 2630
       %Id_comAtt       = 2631
       %Id_comPreDial   = 2632
       %Id_comBaud      = 2633
       %Id_comRxBuffer  = 2634
       %Id_comTxBuffer  = 2635
       %Id_comStop      = 2636
       %Id_comParity    = 2637
       %Id_comByte      = 2638
       %Id_AreaCode     = 2639 
       %Id_CountryCode  = 2643 
       %Id_Save_Settings =2640
       %Id_Find_Modem   = 2641
       %Id_Cancel       = 2642
    '                     '2644 next
    Type Program_Parameters
       Current_File As String * 15
       Names_On_File(1 To 25) As String * 15
       Local_Area_Code As String * 3
       Country_Code As String * 3
      ComPort As Asciiz  * 5
      ComAtt As Asciiz  * 5
      ComPreDial As Asciiz  * 8
      ComBaud As Long
      comByte As Long
      comParity As Long
      comStop As Long
      comTxBuffer As Long
      comRxBuffer As Long
     
       Extra As String * 1000 'room to add stuff
    End Type
      Global g_Parm As Program_Parameters
    '
    '
    Macro Common_Locals
    ' #Include "C:\Power Basic\Includes\PB9_Variables_Common_to_All_Programs.inc"
      Local col2, col1, ln, fnum, flen, Stile, x, ans, i, col, row, wdth, hght As Long
      Local hDlg1, hWin1, hfont As Dword
      Local l5, l2, l, Phone, p3, p2, fn, n, p1, s, s2 As String
      Local m$, m0$, m1$, m2$, m3$, m4$, m5$, m6$, m7$, m8$, m9$, m10$
    End Macro
    '               
    '****************************************************************************
    '****************************************************************************
    '****************************************************************************
    '****************************************************************************
    '****************************************************************************
    '****************************************************************************
     
    Sub Find_Modem_Comport
    'http://www.powerbasic.com/support/pbforums/showthread.php?t=6468&highlight=modem+detection
    'by Peter Lameijn      'Changes by GHL
      Common_Locals 'easier to just define locals here
     
    Local lCnt&, lRet&, lComm&, lCommProp As CommProp, lCommName As Asciiz * 128, lVal As Long
    Local Ports_Found$
    'Local m0, m1, m3 As String
    'Local col, row, Wdth, hght As Long  
    'Local hwin1, hfont As Dword
    '
      For lCnt = 1 To 10
       lCommName = "COM" + Trim$(Str$(lCnt))
       lComm& = CreateFile (lCommName, _
                            %GENERIC_READ Or %GENERIC_WRITE, _
                            0, _
                            ByVal %Null, _
                            %OPEN_EXISTING, _
                            0, _
                            ByVal %Null)
        Reset lval '<<< necessary
        If (lComm& <> %INVALID_HANDLE_VALUE) Then
          lRet = GetCommModemStatus (lComm&,lVal)
          If lVal Then 
              Ports_Found$ =  Ports_Found$ & lCommName & $CrLf 
             CloseHandle lComm
          End If   
         Else
    '      Print lCommName + " - No such port"
          ? "%INVALID_HANDLE_VALUE",,"Bummer"
          Exit Sub
        End If
      Next
      If Ports_Found$ > "" Then
         m0$ = Ports_Found$ 
         m1$ = "Current Modem Port setting is " & g_Parm.ComPort
        Else
         ? "",, "No Ports Found"
         Exit Sub
      End If
     
       Desktop Get Size To Wdth, hght&
        Col = Wdth \ 4
         Row = hght \ 2               
     
         ? "Ports Fond" & $CrLf & Ports_Found$,, m1$
       Close
    End Sub
     
     
    '
    Function Msg_Reply(Title$, Msg$) As Long 'Yes = 1
        Local hWin, hfont As Dword 'just needed for setup
        Local col, row, wdth, hght As Long
    '
       Desktop Get Size To Wdth, hght&
        Col = Wdth \ 4
         Row = hght \ 2
    ' 
        Title$ = " - " & Title$ '& " -  -  -  -  -  -  -  -  -  -  - Press only Y(es) or N(o) -  -  -  -  -  -  -  -  -  -  - "   
        Graphic Window Title$, Col, Row, 450, 100 To hWin
        Graphic Attach hWin, 0 
        Font New "Comic MS Sans", 48 To hfont '"Comic MS Sans" '"xxrty" 'Fat
        Graphic Set Font hfont
        Graphic Set Pos (10, 20)
        Graphic Print msg$
    '
    NOYN10:
        Graphic Inkey$ To Msg$
          If msg$ = "Y" Or msg$ = "y" Then
             Function = %IdYes 'yes
            ElseIf msg$ = "N" Or msg$ = "n" Then
             Function = %IdNo 'no
            ElseIf msg$ = "C" Or msg$ = "c" Then
             Function = 99 'C
            ElseIf msg$ > "" Then
             Function = -99 
            Else 
             GoTo NOYN10 'keep waiting for answer
          End If                                 
    '      
        Font End hfont '<<< Necessary?
    '    Graphic Window End
    End Function
    '
    '
    Function Expand_Phone_Number(p As String) As Long
     
      Local p1, num, exc, area, cc As String 
      p = Trim$(p)
        'start from end in case truncated number
       num = Right$(p, 4) 
       If Len(p) => 7 Then   exc = Mid$(p, Len(p) - 6, 3)
       If Len(p) => 9 Then  area = Mid$(p, Len(p) - 9, 3)
       cc = "1"
       If Len(p) => 11 Then 
          cc = Mid$(p, 1, Len(p) - 10)
       End If  
       p = cc & "-" & Area  & "-" & exc & "-" & num
    End Function
    '
    Sub Letters_to_Numbers(P$) 
      Local ctr&, x$
      p$ = UCase$(p$)'JIC any lower case
      For ctr =1 To Len(p$)'check whole length
         x$ = Mid$(p$, ctr, 1)'check each character
         Select Case x$ 'Is it a letter?
           Case "A", "B", "C"
             x$ = "2"
           Case "D", "E", "F"
             x$ = "3"
           Case "G", "H", "I"
             x$ = "4"
           Case "J", "K", "L"
             x$ = "5"
           Case "M", "N", "O"
             x$ = "6"
           Case "P", "Q", "R", "S"
             x$ = "7"
           Case "T", "U", "V"
             x$ = "8"
           Case "W", "X", "Y", "Z"
             x$ = "9"
         End Select 
         Mid$(p$, ctr, 1) = x$'Now put character back
      Next ctr
    End Sub                     
    '        
    '        
    Macro Invalid_Number_Msg
       Desktop Get Size To Wdth, hght&
        Col = Wdth \ 4
         Row = hght \ 2                              
         s$ = Left$(s$, 35) 'case too long
         Replace $CrLf With " " In s$ 'messes up dialog header
         Replace $Cr With " " In s$
         Replace $Lf With " " In s$
     
        Graphic Window "Invalid Phone Number - " & s$, Col, Row, 500, 100 To hWin1
        Graphic Attach hWin1, 0 
        Font New "Comic MS Sans", 48 To hfont 
        Graphic Set Font hfont
        Graphic Set Pos (10, 20)
        Graphic Print Phone$
        Graphic Waitkey$ 'from graphic window displaying phone number
        Graphic Window End
    End Macro
    '
    Macro Modem_Msg
       Desktop Get Size To Wdth, hght&
        Col = Wdth \ 4
         Row = hght \ 2               
     
        Graphic Window "No Modem Found " & s$, Col, Row, 500, 100 To hWin1
        Graphic Attach hWin1, 0 
        Font New "Comic MS Sans", 48 To hfont '"Comic MS Sans" '"xxrty" 'Fat
        Graphic Set Font hfont
        Graphic Set Pos (10, 20)
        Graphic Print Phone$
        Graphic Waitkey$ 'from graphic window dosplaying phone number
        Graphic Window End
    End Macro
    '
    Macro Dialing_Window
        Local hWin As Dword 'just needed for setup
       Desktop Get Size To Wdth, hght&
        Col = Wdth \ 4
         Row = hght \ 2
     
        Graphic Window "Dialing " & s$, Col, Row, 500, 100 To hWin
        Graphic Attach hWin, 0 
        Font New "Comic MS Sans", 48 To hfont '"Comic MS Sans" '"xxrty" 'Fat
        Graphic Set Font hfont
        Graphic Set Pos (10, 20)
        Graphic Print Phone$
    End Macro
    '
    Sub Phone_from_Clipboard
      Common_locals         
       Call Parameters_Get
     
         ClipBoard Get Text Phone$
    '    phone$ = "(222)456 7890" 'for testing
     
        Phone$ = Trim$(Phone$)
        p1$ = phone$
        s$ = Phone$ 'for graphic print          
    '    
        If Len(Phone$) < 7 Then 
           Invalid_Number_Msg
           Graphic Window End
            Exit Sub
        End If
    '           
        Replace "-" With "" In phone$
        Replace " " With "" In phone$
        Replace "." With "" In phone$
        Replace "(" With "" In phone$
        Replace ")" With "" In phone$
    '
        phone$ = Trim$(UCase$(Phone$))
    '   
        Local Alph1$
        Alph1$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"   
    '
        i = InStr(Phone$, Any Alph1$) 'look for letters
        If i Then    
           Call Letters_to_Numbers(Phone$) 
        End If
    '   
         'number too low to be valid
        If Val(Phone$) < 111111 Then  
           Invalid_Number_Msg
           Exit Sub
        End If
    '
        'no area code
        If Len(Phone$) < 8 Then  
           Phone$ = g_Parm.Local_Area_Code + Phone$
        End If
    '    
         'Country codes added
        If Left$(Phone$, 1) <> "1" And Len(Phone$) < 11 Then
           Phone$ = g_Parm.Country_Code & Phone$
        End If   
    '    
    'reference [URL]http://www.powerbasic.com/support/pbforums/showthread.php?t=37948[/URL]
        ErrClear
        Local dummy$, ncomm&, Comport$, MilSecs!
        MilSecs! = 2000
        ncomm = FreeFile
    '
        ComPort$ = UCase$(Trim$(g_Parm.Comport)) 
    '                      
       p3$ = Trim$(phone$) ' for working with
       p2$ = phone$
    '
       If Len(phone$) = 11 Then 'area code but no Country code
          Phone$ = g_Parm.Country_Code & Phone$    
       End If   
    '
        Comm Open COMPORT$ As #nComm
         Sleep 100 'jic
        If Err Then 'Exit if port cannot be opened
           m1$ = "---" & COMPORT$ & "---"
           m3$ = "Port cannot be opened"
            ?m1$,,m3$
            Call Modem_Settings 
           Exit Sub  
     
        End If       
    '    
        Comm Set #nComm, Baud     = 115200   ' 9600 baud
        Comm Set #nComm, Byte     = g_Parm.comByte '8        ' 8 bits
        Comm Set #nComm, Parity   = g_Parm.comParity ' %False   ' No parity
        Comm Set #nComm, Stop     = g_Parm.comStop '0        ' 1 stop bit
        Comm Set #nComm, TxBuffer = g_Parm.comRxBuffer '4096     ' 4k transmit buffer
        Comm Set #nComm, RxBuffer = g_Parm.comTxBuffer '4096     ' 4k receive buffer
    '
        m0$ = p1$
        M3$ = "Lift Phone then (Y)es to Dial  or (C)omport for values."
        ans = Msg_Reply(m3$, M0$)     
        Select Case Ans
          Case %IdNo             
            Comm Close #nComm                 
            Exit Sub
          Case 99
            Comm Close #nComm                 
             Call Modem_Settings
           Exit Sub 
          Case - 99
           Exit Sub
        End Select       
          Graphic Window End  
    '
       n$ = Trim$(g_Parm.ComAtt) & $CrLf 
        Comm Send #nComm, n$  ' "AT"
        If Err Then 'Exit if error
           m1$ = "After sending ComAtt (" & n$ &")" & $CrLf & "Error = " & Error$(Err)
            ? m1$,,"Comport Error"
           Exit Sub 
        End If
     
     
        n$ = g_Parm.ComPreDial & Phone$ & $CrLf  
     
        m0$ = Phone$
        M3$ = n$
      '  ans = Msg_Reply(m3$, M0$)     
        Dialing_Window 'show number
     
        Comm Send #nComm, n$  
         Sleep MilSecs! * 1.5 'allow time for whole number to be sent    
     
        If Err Then 'Exit if error
           m1$ = "After sending ATDT"
            ? m1$,,"Comport Error"
           Exit Sub 
        End If     
     
      'Hangup
      Comm Send #nComm, "ATH0" & $CrLf 
    '       
        Sleep MilSecs!      
        x& = Comm(#nComm, RxQue)
         Comm Recv #nComm, x, s2$    'Nothing
    '
        Comm Close #nComm                 
    '
        Graphic Waitkey$ 'from graphic window dosplaying phone number
        Graphic Window End
    ' 
    End Sub
    '
    '***********************************************
    '********** Modems *****************************
    '***********************************************
    CallBack Function Modem_Settings_CB
        Common_Locals
        Select Case CbMsg     'This is TO determine the message TYPE 
           Case %WM_COMMAND  'This processes command messages
                 'test for max entry limits in Textboxes
             Select Case CbCtl
               Case %Id_Save_Settings
                 Control Get Text CB.Hndl, %Id_ComPort     To g_Parm.Comport
                 Control Get Text CB.Hndl, %id_comAtt      To g_Parm.ComAtt
                 Control Get Text CB.Hndl, %Id_comPreDial  To g_Parm.ComPreDial
                 Control Get Text CB.Hndl, %Id_AreaCode    To g_Parm.Local_Area_Code
                 Control Get Text CB.Hndl, %Id_CountryCode To g_Parm.Country_Code
                 Control Get Text CB.Hndl, %Id_ComBaud     To l$: g_Parm.ComBaud  = Val(l$)
                 Control Get Text CB.Hndl, %Id_comRxBuffer To l$: g_Parm.comRxBuffer  = Val(l$)
                 Control Get Text CB.Hndl, %Id_comTxBuffer To l$: g_Parm.comTxBuffer  = Val(l$)
                 Control Get Text CB.Hndl, %Id_comStop     To l$: g_Parm.comStop  = Val(l$)
                 Control Get Text CB.Hndl, %Id_comParity   To l$: g_Parm.comParity  = Val(l$)
                 Control Get Text CB.Hndl, %Id_comByte     To l$: g_Parm.comByte  = Val(l$)
                 Call Parameters_Put
                  ? "Saved"
               '
               Case %Id_Find_Modem
                 Call Find_Modem_Comport'_works
               '
               Case %Id_Cancel
                 Dialog End CB.Hndl
             End Select
        End Select
    End Function
    Sub Modem_Settings
       Common_Locals
         Wdth& = 400
         Hght& = 440
        s$ = Space$(5) + " *  *  *   Modem Settings   *  *  *"
     
    '     Wdth&=LEN(Caption$)
          Stile = Stile Or %WS_CAPTION
       Stile = Stile Or %WS_SYSMENU
       Stile = Stile Or %WS_THICKFRAME
    '   Stile = Stile Or %WS_POPUP
     
       Dialog New Pixels, 0, s$, ,, Wdth&, Hght&, Stile, 0 To hDlg1
     
     
      Col& = 125
       Local LineNum&
      LineNum& = 10  '190
       Local labelwidth&
       LabelWidth& = 15
       Local boxheight&
       BoxHeight& = 22
       l$= "Modem Settings"
       Control Add Label, hDlg1,  - 1, l$, Col&, _
          LineNum&,  (Len(l$) * 10),  15
     
      Col& = 50 
    '  LineNum&=LineNum&+BoxHeight&+2
       l$ = "Com Port"
        Ln& = Len(l$) * 10
        'Local l1&
    '    ln& = 50'Len(l$) * 10 '4
        Col1& = Col& + ln + 5
        Col2& = Col1& + Ln& + 4
     
        l5$ = "Com2"
         l2$ = g_Parm.ComPort
         Local Id&
         Id& = %id_ComPort
          GoSub OptModemSettingsDisplay
     
        l$ = "Baud Rate"
        l5$ = "56000"
         l2$ = Str$(g_Parm.ComBaud)
         Id& = %id_ComBaud
          GoSub OptModemSettingsDisplay
     
       l$ = "Attention Sequence"
        l5$ = "ATZ"
         l2$ = g_Parm.ComAtt
         Id& = %id_comAtt
          GoSub OptModemSettingsDisplay
     
       l$ = "Pre Dial Sequence"
        l5$ = "ATDT,"
         l2$ = g_Parm.ComPreDial
         Id& = %id_comPreDial
          GoSub OptModemSettingsDisplay
     
       l$ = "Receive Buffer"
        l5$ = "2048"
         l2$ = Str$(g_Parm.ComRxBuffer)
         Id& = %id_comRxBuffer
          GoSub OptModemSettingsDisplay
     
       l$ = "Transmit Buffer"
        l5$ = "2048"
         l2$ = Str$(g_Parm.ComTxBuffer)
         Id& = %id_comTxBuffer
          GoSub OptModemSettingsDisplay
     
       l$ = "Parity"
        l5$ = "0"
         l2$ = Str$(g_Parm.ComParity)
         Id& = %id_comParity
          GoSub OptModemSettingsDisplay
     
       l$ = "Stop"
        l5$ = "0"
         l2$ = Str$(g_Parm.ComStop)
         Id& = %id_comStop
          GoSub OptModemSettingsDisplay
     
       l$ = "Byte"
        l5$ = "8"
         l2$ = Str$(g_Parm.ComByte)
         Id& = %id_comByte
          GoSub OptModemSettingsDisplay
     
       l$ = "Local Area Code"
        l5$ = "732 for NJ"
         l2$ = g_Parm.Local_Area_Code
         Id& = %Id_AreaCode
          GoSub OptModemSettingsDisplay
     
       l$ = "Country Code"
        l5$ = "001 for USA"
         l2$ = g_Parm.Country_Code
         Id& = %Id_CountryCode
          GoSub OptModemSettingsDisplay
     
    ' Buttons
      LineNum& = hght - (BoxHeight&) - 10  'LineNum& + (BoxHeight&) + 10             
      Ln = 100
    '      = 2641
    '   %Id_Cancel       = 2642
       l$ = "&Save": Id = %Id_Save_Settings: GoSub Button_Display
       l$ = "&Find Modems": Id = %Id_Find_Modem: GoSub Button_Display
       l$ = "&Cancel": Id = %Id_Cancel: GoSub Button_Display
     
       Dialog Show Modal hDlg1  Call Modem_Settings_CB
    '
     Exit Sub
    '
    OptModemSettingsDisplay:
     
      LineNum& = LineNum& + (BoxHeight&) + 10
        Control Add Label, hDlg1,  - 1, l$,                Col - 40,  LineNum&, ln + 40, BoxHeight&, %SS_RIGHT
        Control Add TextBox, hDlg1, Id&, l2$,              Col1&, LineNum&, Ln&, BoxHeight&,0
        Control Add Label, hDlg1,  - 1, "Normally " + L5$, Col2&, LineNum&, Ln * 2, BoxHeight&', %SS_RIGHT
     
    Return
    Button_Display:                                             
       Control Add Button, hDlg1, Id&, l$, col, LineNum&, Ln, BoxHeight&
       Col = Col + ln + 10
    Return
    End Sub
    '
    '****************************************************************************
    '****************************************************************************
    '****************************************************************************
     
    '
    '
    Function PBMAIN () AS LONG
    '
       Call Phone_from_Clipboard
    '
    End Function 'Applikation kerplunken
    '****************************************************************************
     
    '****************************************************************************
    '****************************************************************************
    '****************************************************************************
     
     
    '****************************************************************************
    '****************************************************************************
    '****************************************************************************
     
     
    '****************************************************************************
    '***************************************************
    '***************************************************
    '
    Sub Parameters_Get        
       common_Locals
       fn$ = CurDir$ & "\Parameters.prm"
          fnum = FreeFile
        Open fn$ For Binary As #fnum
        flen = Lof(#fnum)
        If Flen > 1 Then
           Get #fnum, 1, g_parm
          Else      
           Close #fnum
        End If  
       Close #Fnum 
     
       'g_Parm.Local_Area_Code = "-1" 'unrem to build file while testing/starting 
     
       If Val(g_Parm.Local_Area_Code) < 1 Or _
          Val(g_Parm.Local_Area_Code) > 800 Then '
         g_Parm.Local_Area_Code  = "732"
         g_Parm.Country_Code  = "001"
         g_Parm.ComPort = "COM3"
         g_Parm.ComAtt  = "ATZ"
         g_Parm.ComPreDial = "ATDT"
         g_Parm.ComBaud = 115200
         g_Parm.comByte = 8
         g_Parm.comParity = 0
         g_Parm.comStop = 0
         g_Parm.comTxBuffer = 4096
         g_Parm.comRxBuffer = 4096
     
         Call Parameters_Put 'save them
         ?"Set New Parameters",, FuncName$
       End If   
    End Sub
    '
    Sub Parameters_Put
       common_Locals
       fn$ = CurDir$ & "\Parameters.prm"
       fnum = FreeFile
        Open fn$ For Binary As fnum
        Put #fnum, 1, g_parm
       Close #fnum        
    '   m$ = "New Parameters Set": m1$ = fn$: mb
    End Sub
    '***************************************************
    '***************************************************
    '**********************************************************************
    '**********************************************************************
    '**********************************************************************
    '**********************************************************************
    '**********************************************************************
    '**********************************************************************
    '**********************************************************************
    '
    Include file. Identical except that Macros, Subs, Functions begin with CPD_ to avoid potential conficts.

    '
    Code:
    'PBWIN 9.01 - WinApi 05/2008 - XP Pro SP3
    '
    ' Just a quick little Clipboard Auto dialer.
    '               
    ' Note -  it adds a Country Code automatically if not present
    ' Note -  it adds a local Area Code automatically if not present
    ' Note - not tested outside USA
    '
    ' Contact: [EMAIL="[email protected]"][email protected][/EMAIL] - Use Subject = "Clipboard Auto dialer" (to avoid Jumk Filters)
    ' Gösta H. Lovgren
    ' [URL]http://www.SwedesDock.com[/URL]
    '#Compile Exe  
    '#Dim All
    '#If Not %Def(%WINAPI)
    '  #Include "WIN32API.INC"
    '#EndIf
    '
    'Modem
       %Id_ComPort       = 2630
       %Id_comAtt       = 2631
       %Id_comPreDial   = 2632
       %Id_comBaud      = 2633
       %Id_comRxBuffer  = 2634
       %Id_comTxBuffer  = 2635
       %Id_comStop      = 2636
       %Id_comParity    = 2637
       %Id_comByte      = 2638
       %Id_AreaCode     = 2639 
       %Id_CountryCode  = 2643 
       %Id_Save_Settings =2640
       %Id_Find_Modem   = 2641
       %Id_Cancel       = 2642
    '                     '2644 next
    Type CPD_Program_Parameters
       Current_File As String * 15
       Names_On_File(1 To 25) As String * 15
       Local_Area_Code As String * 3
       Country_Code As String * 3
      ComPort As Asciiz  * 5
      ComAtt As Asciiz  * 5
      ComPreDial As Asciiz  * 8
      ComBaud As Long
      comByte As Long
      comParity As Long
      comStop As Long
      comTxBuffer As Long
      comRxBuffer As Long
     
       Extra As String * 1000 'room to add stuff
    End Type
      Global g_Parm As CPD_Program_Parameters
    '
    '
    Macro CPD_Common_Locals
    ' #Include "C:\Power Basic\Includes\PB9_Variables_Common_to_All_Programs.inc"
      Local col2, col1, ln, fnum, flen, Stile, x, ans, i, col, row, wdth, hght As Long
      Local hDlg1, hWin1, hfont As Dword
      Local l5, l2, l, Phone, p3, p2, fn, n, p1, s, s2 As String
      Local m$, m0$, m1$, m2$, m3$, m4$, m5$, m6$, m7$, m8$, m9$, m10$
    End Macro
    '               
    '****************************************************************************
    '****************************************************************************
    '****************************************************************************
    '****************************************************************************
    '****************************************************************************
    '****************************************************************************
    Sub CPD_Find_Modem_Comport
    'http://www.powerbasic.com/support/pbforums/showthread.php?t=6468&highlight=modem+detection
    'by Peter Lameijn      'Changes by GHL
      CPD_Common_Locals 'easier to just define locals here
    Local lCnt&, lRet&, lComm&, lCommProp As CommProp, lCommName As Asciiz * 128, lVal As Long
    Local Ports_Found$
    'Local m0, m1, m3 As String
    'Local col, row, Wdth, hght As Long  
    'Local hwin1, hfont As Dword
    '
      For lCnt = 1 To 10
       lCommName = "COM" + Trim$(Str$(lCnt))
       lComm& = CreateFile (lCommName, _
                            %GENERIC_READ Or %GENERIC_WRITE, _
                            0, _
                            ByVal %Null, _
                            %OPEN_EXISTING, _
                            0, _
                            ByVal %Null)
        Reset lval '<<< necessary
        If (lComm& <> %INVALID_HANDLE_VALUE) Then
          lRet = GetCommModemStatus (lComm&,lVal)
          If lVal Then 
              Ports_Found$ =  Ports_Found$ & lCommName & $CrLf 
             CloseHandle lComm
          End If   
         Else
    '      Print lCommName + " - No such port"
          ? "%INVALID_HANDLE_VALUE",,"Bummer"
          Exit Sub
        End If
      Next
      If Ports_Found$ > "" Then
         m0$ = Ports_Found$ 
         m1$ = "Current Modem Port setting is " & g_Parm.ComPort
        Else
         ? "",, "No Ports Found"
         Exit Sub
      End If
       Desktop Get Size To Wdth, hght&
        Col = Wdth \ 4
         Row = hght \ 2               
     
         ? "Ports Fond" & $CrLf & Ports_Found$,, m1$
       Close
    End Sub
     
    '
    Function CPD_Msg_Reply(Title$, Msg$) As Long 'Yes = 1
        Local hWin, hfont As Dword 'just needed for setup
        Local col, row, wdth, hght As Long
    '
       Desktop Get Size To Wdth, hght&
        Col = Wdth \ 4
         Row = hght \ 2
    ' 
        Title$ = " - " & Title$ '& " -  -  -  -  -  -  -  -  -  -  - Press only Y(es) or N(o) -  -  -  -  -  -  -  -  -  -  - "   
        Graphic Window Title$, Col, Row, 450, 100 To hWin
        Graphic Attach hWin, 0 
        Font New "Comic MS Sans", 48 To hfont '"Comic MS Sans" '"xxrty" 'Fat
        Graphic Set Font hfont
        Graphic Set Pos (10, 20)
        Graphic Print msg$
    '
    NOYN10:
        Graphic Inkey$ To Msg$
          If msg$ = "Y" Or msg$ = "y" Then
             Function = %IdYes 'yes
            ElseIf msg$ = "N" Or msg$ = "n" Then
             Function = %IdNo 'no
            ElseIf msg$ = "C" Or msg$ = "c" Then
             Function = 99 'C
            ElseIf msg$ > "" Then
             Function = -99 
            Else 
             GoTo NOYN10 'keep waiting for answer
          End If                                 
    '      
        Font End hfont '<<< Necessary?
    '    Graphic Window End
    End Function
    '
    '
    Function CPD_Expand_Phone_Number(p As String) As Long
     
      Local p1, num, exc, area, cc As String 
      p = Trim$(p)
        'start from end in case truncated number
       num = Right$(p, 4) 
       If Len(p) => 7 Then   exc = Mid$(p, Len(p) - 6, 3)
       If Len(p) => 9 Then  area = Mid$(p, Len(p) - 9, 3)
       cc = "1"
       If Len(p) => 11 Then 
          cc = Mid$(p, 1, Len(p) - 10)
       End If  
       p = cc & "-" & Area  & "-" & exc & "-" & num
    End Function
    '
    Sub CPD_Letters_to_Numbers(P$) 
      Local ctr&, x$
      p$ = UCase$(p$)'JIC any lower case
      For ctr =1 To Len(p$)'check whole length
         x$ = Mid$(p$, ctr, 1)'check each character
         Select Case x$ 'Is it a letter?
           Case "A", "B", "C"
             x$ = "2"
           Case "D", "E", "F"
             x$ = "3"
           Case "G", "H", "I"
             x$ = "4"
           Case "J", "K", "L"
             x$ = "5"
           Case "M", "N", "O"
             x$ = "6"
           Case "P", "Q", "R", "S"
             x$ = "7"
           Case "T", "U", "V"
             x$ = "8"
           Case "W", "X", "Y", "Z"
             x$ = "9"
         End Select 
         Mid$(p$, ctr, 1) = x$'Now put character back
      Next ctr
    End Sub                     
    '        
    '        
    Macro CPD_Invalid_Number_Msg
       Desktop Get Size To Wdth, hght&
        Col = Wdth \ 4
         Row = hght \ 2                        
         s$ = Left$(s$, 35) 'case too long
         Replace $CrLf With " " In s$ 'messes up dialog header
         Replace $Cr With " " In s$
         Replace $Lf With " " In s$
        Graphic Window "Invalid Phone Number - " & s$, Col, Row, 500, 100 To hWin1
        Graphic Attach hWin1, 0 
        Font New "Comic MS Sans", 48 To hfont '"Comic MS Sans" '"xxrty" 'Fat
        Graphic Set Font hfont
        Graphic Set Pos (10, 20)
        Graphic Print Phone$
        Graphic Waitkey$ 'from graphic window dosplaying phone number
        Graphic Window End
    End Macro
    '
    Macro CPD_Modem_Msg
       Desktop Get Size To Wdth, hght&
        Col = Wdth \ 4
         Row = hght \ 2               
     
        Graphic Window "No Modem Found " & s$, Col, Row, 500, 100 To hWin1
        Graphic Attach hWin1, 0 
        Font New "Comic MS Sans", 48 To hfont '"Comic MS Sans" '"xxrty" 'Fat
        Graphic Set Font hfont
        Graphic Set Pos (10, 20)
        Graphic Print Phone$
        Graphic Waitkey$ 'from graphic window dosplaying phone number
        Graphic Window End
    End Macro
    '
    Macro Dialing_Window
        Local hWin As Dword 'just needed for setup
       Desktop Get Size To Wdth, hght&
        Col = Wdth \ 4
         Row = hght \ 2
     
        Graphic Window "Dialing " & s$, Col, Row, 500, 100 To hWin
        Graphic Attach hWin, 0 
        Font New "Comic MS Sans", 48 To hfont '"Comic MS Sans" '"xxrty" 'Fat
        Graphic Set Font hfont
        Graphic Set Pos (10, 20)
        Graphic Print Phone$
    End Macro
    '
    Sub CPD_Phone_from_Clipboard
      CPD_Common_locals         
       Call CPD_Parameters_Get
     
         ClipBoard Get Text Phone$
    '    phone$ = "(222)456 7890" 'for testing
        Phone$ = Trim$(Phone$)
        p1$ = phone$
        s$ = Phone$ 'for graphic print          
    '    
        If Len(Phone$) < 7 Then 
           CPD_Invalid_Number_Msg
           Graphic Window End
            Exit Sub
        End If
    '           
        Replace "-" With "" In phone$
        Replace " " With "" In phone$
        Replace "." With "" In phone$
        Replace "(" With "" In phone$
        Replace ")" With "" In phone$
    '
        phone$ = Trim$(UCase$(Phone$))
    '   
        Local Alph1$
        Alph1$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"   
    '
        i = InStr(Phone$, Any Alph1$) 'look for letters
        If i Then    
           Call CPD_Letters_to_Numbers(Phone$) 
        End If
    '   
         'number too low to be valid
        If Val(Phone$) < 111111 Then  
           CPD_Invalid_Number_Msg
           Exit Sub
        End If
    '
        'no area code
        If Len(Phone$) < 8 Then  
           Phone$ = g_Parm.Local_Area_Code + Phone$
        End If
    '    
         'Country codes added
        If Left$(Phone$, 1) <> "1" And Len(Phone$) < 11 Then
           Phone$ = g_Parm.Country_Code & Phone$
        End If   
    '    
    'reference [URL]http://www.powerbasic.com/support/pbforums/showthread.php?t=37948[/URL]
        ErrClear
        Local dummy$, ncomm&, Comport$, MilSecs!
        MilSecs! = 2000
        ncomm = FreeFile
    '
        ComPort$ = UCase$(Trim$(g_Parm.Comport)) 
    '                      
       p3$ = Trim$(phone$) ' for working with
       p2$ = phone$
    '
       If Len(phone$) = 11 Then 'area code but no Country code
          Phone$ = g_Parm.Country_Code & Phone$    
       End If   
    '
        Comm Open COMPORT$ As #nComm
         Sleep 100 'jic
        If Err Then 'Exit if port cannot be opened
           m1$ = "---" & COMPORT$ & "---"
           m3$ = "Port cannot be opened"
            ?m1$,,m3$
            Call CPD_Modem_Settings 
           Exit Sub  
     
        End If       
    '    
        Comm Set #nComm, Baud     = 115200   ' 9600 baud
        Comm Set #nComm, Byte     = g_Parm.comByte '8        ' 8 bits
        Comm Set #nComm, Parity   = g_Parm.comParity ' %False   ' No parity
        Comm Set #nComm, Stop     = g_Parm.comStop '0        ' 1 stop bit
        Comm Set #nComm, TxBuffer = g_Parm.comRxBuffer '4096     ' 4k transmit buffer
        Comm Set #nComm, RxBuffer = g_Parm.comTxBuffer '4096     ' 4k receive buffer
    '
        m0$ = p1$
        M3$ = "Lift Phone then (Y)es to Dial  or (C)omport for values."
        ans = CPD_Msg_Reply(m3$, M0$)     
        Select Case Ans
          Case %IdNo             
            Comm Close #nComm                 
            Exit Sub
          Case 99
            Comm Close #nComm                 
             Call CPD_Modem_Settings
           Exit Sub 
          Case - 99
           Exit Sub
        End Select       
          Graphic Window End  
    '
       n$ = Trim$(g_Parm.ComAtt) & $CrLf 
        Comm Send #nComm, n$  ' "AT"
        If Err Then 'Exit if error
           m1$ = "After sending ComAtt (" & n$ &")" & $CrLf & "Error = " & Error$(Err)
            ? m1$,,"Comport Error"
           Exit Sub 
        End If
     
        n$ = g_Parm.ComPreDial & Phone$ & $CrLf  
     
        m0$ = Phone$
        M3$ = n$
      '  ans = CPD_Msg_Reply(m3$, M0$)     
        Dialing_Window 'show number
        Comm Send #nComm, n$  
         Sleep MilSecs! * 1.5 'allow time for whole number to be sent    
     
        If Err Then 'Exit if error
           m1$ = "After sending ATDT"
            ? m1$,,"Comport Error"
           Exit Sub 
        End If     
      'Hangup
      Comm Send #nComm, "ATH0" & $CrLf 
    '       
        Sleep MilSecs!      
        x& = Comm(#nComm, RxQue)
         Comm Recv #nComm, x, s2$    'Nothing
    '
        Comm Close #nComm                 
    '
        Graphic Waitkey$ 'from graphic window dosplaying phone number
        Graphic Window End
    ' 
    End Sub
    '
    '***********************************************
    '********** Modems *****************************
    '***********************************************
    CallBack Function CPD_Modem_Settings_CB
        CPD_Common_Locals
        Select Case CbMsg     'This is TO determine the message TYPE 
           Case %WM_COMMAND  'This processes command messages
                 'test for max entry limits in Textboxes
             Select Case CbCtl
               Case %Id_Save_Settings
                 Control Get Text CB.Hndl, %Id_ComPort     To g_Parm.Comport
                 Control Get Text CB.Hndl, %id_comAtt      To g_Parm.ComAtt
                 Control Get Text CB.Hndl, %Id_comPreDial  To g_Parm.ComPreDial
                 Control Get Text CB.Hndl, %Id_AreaCode    To g_Parm.Local_Area_Code
                 Control Get Text CB.Hndl, %Id_CountryCode To g_Parm.Country_Code
                 Control Get Text CB.Hndl, %Id_ComBaud     To l$: g_Parm.ComBaud  = Val(l$)
                 Control Get Text CB.Hndl, %Id_comRxBuffer To l$: g_Parm.comRxBuffer  = Val(l$)
                 Control Get Text CB.Hndl, %Id_comTxBuffer To l$: g_Parm.comTxBuffer  = Val(l$)
                 Control Get Text CB.Hndl, %Id_comStop     To l$: g_Parm.comStop  = Val(l$)
                 Control Get Text CB.Hndl, %Id_comParity   To l$: g_Parm.comParity  = Val(l$)
                 Control Get Text CB.Hndl, %Id_comByte     To l$: g_Parm.comByte  = Val(l$)
                 Call CPD_Parameters_Put
                  ? "Saved"
               '
               Case %Id_Find_Modem
                 Call CPD_Find_Modem_Comport'_works
               '
               Case %Id_Cancel
                 Dialog End CB.Hndl
             End Select
        End Select
    End Function
    Sub CPD_Modem_Settings
       CPD_Common_Locals
         Wdth& = 400
         Hght& = 440
        s$ = Space$(5) + " *  *  *   Modem Settings   *  *  *"
    '     Wdth&=LEN(Caption$)
          Stile = Stile Or %WS_CAPTION
       Stile = Stile Or %WS_SYSMENU
       Stile = Stile Or %WS_THICKFRAME
    '   Stile = Stile Or %WS_POPUP
       Dialog New Pixels, 0, s$, ,, Wdth&, Hght&, Stile, 0 To hDlg1
     
      Col& = 125
       Local LineNum&
      LineNum& = 10  '190
       Local labelwidth&
       LabelWidth& = 15
       Local boxheight&
       BoxHeight& = 22
       l$= "Modem Settings"
       Control Add Label, hDlg1,  - 1, l$, Col&, _
          LineNum&,  (Len(l$) * 10),  15
      Col& = 50 
    '  LineNum&=LineNum&+BoxHeight&+2
       l$ = "Com Port"
        Ln& = Len(l$) * 10
        'Local l1&
    '    ln& = 50'Len(l$) * 10 '4
        Col1& = Col& + ln + 5
        Col2& = Col1& + Ln& + 4
     
        l5$ = "Com2"
         l2$ = g_Parm.ComPort
         Local Id&
         Id& = %id_ComPort
          GoSub OptModemSettingsDisplay
        l$ = "Baud Rate"
        l5$ = "56000"
         l2$ = Str$(g_Parm.ComBaud)
         Id& = %id_ComBaud
          GoSub OptModemSettingsDisplay
       l$ = "Attention Sequence"
        l5$ = "ATZ"
         l2$ = g_Parm.ComAtt
         Id& = %id_comAtt
          GoSub OptModemSettingsDisplay
       l$ = "Pre Dial Sequence"
        l5$ = "ATDT,"
         l2$ = g_Parm.ComPreDial
         Id& = %id_comPreDial
          GoSub OptModemSettingsDisplay
       l$ = "Receive Buffer"
        l5$ = "2048"
         l2$ = Str$(g_Parm.ComRxBuffer)
         Id& = %id_comRxBuffer
          GoSub OptModemSettingsDisplay
       l$ = "Transmit Buffer"
        l5$ = "2048"
         l2$ = Str$(g_Parm.ComTxBuffer)
         Id& = %id_comTxBuffer
          GoSub OptModemSettingsDisplay
       l$ = "Parity"
        l5$ = "0"
         l2$ = Str$(g_Parm.ComParity)
         Id& = %id_comParity
          GoSub OptModemSettingsDisplay
       l$ = "Stop"
        l5$ = "0"
         l2$ = Str$(g_Parm.ComStop)
         Id& = %id_comStop
          GoSub OptModemSettingsDisplay
       l$ = "Byte"
        l5$ = "8"
         l2$ = Str$(g_Parm.ComByte)
         Id& = %id_comByte
          GoSub OptModemSettingsDisplay
     
       l$ = "Local Area Code"
        l5$ = "732 for NJ"
         l2$ = g_Parm.Local_Area_Code
         Id& = %Id_AreaCode
          GoSub OptModemSettingsDisplay
     
       l$ = "Country Code"
        l5$ = "001 for USA"
         l2$ = g_Parm.Country_Code
         Id& = %Id_CountryCode
          GoSub OptModemSettingsDisplay
     
    ' Buttons
      LineNum& = hght - (BoxHeight&) - 10  'LineNum& + (BoxHeight&) + 10             
      Ln = 100
    '      = 2641
    '   %Id_Cancel       = 2642
       l$ = "&Save": Id = %Id_Save_Settings: GoSub Button_Display
       l$ = "&Find Modems": Id = %Id_Find_Modem: GoSub Button_Display
       l$ = "&Cancel": Id = %Id_Cancel: GoSub Button_Display
       Dialog Show Modal hDlg1  Call CPD_Modem_Settings_CB
    '
     Exit Sub
    '
    OptModemSettingsDisplay:
      LineNum& = LineNum& + (BoxHeight&) + 10
        Control Add Label, hDlg1,  - 1, l$,                Col - 40,  LineNum&, ln + 40, BoxHeight&, %SS_RIGHT
        Control Add TextBox, hDlg1, Id&, l2$,              Col1&, LineNum&, Ln&, BoxHeight&,0
        Control Add Label, hDlg1,  - 1, "Normally " + L5$, Col2&, LineNum&, Ln * 2, BoxHeight&', %SS_RIGHT
    Return
    Button_Display:                                             
       Control Add Button, hDlg1, Id&, l$, col, LineNum&, Ln, BoxHeight&
       Col = Col + ln + 10
    Return
    End Sub
    '
    '****************************************************************************
    '****************************************************************************
    '****************************************************************************
    '
    '
    'Function PBMAIN () AS LONG
    ''
    '   Call CPD_Phone_from_Clipboard
    ''
    'End Function 'Applikation kerplunken
    '****************************************************************************
    '****************************************************************************
    '****************************************************************************
    '****************************************************************************
     
    '****************************************************************************
    '****************************************************************************
    '****************************************************************************
     
    '****************************************************************************
    '***************************************************
    '***************************************************
    '
    Sub CPD_Parameters_Get        
       CPD_common_Locals
       fn$ = CurDir$ & "\Parameters.prm"
          fnum = FreeFile
        Open fn$ For Binary As #fnum
        flen = Lof(#fnum)
        If Flen > 1 Then
           Get #fnum, 1, g_parm
          Else      
           Close #fnum
        End If  
       Close #Fnum 
    '   
       'g_Parm.Local_Area_Code = "-1" 'unrem to build file while testing/starting 
    '
       If Val(g_Parm.Local_Area_Code) < 1 Or _
          Val(g_Parm.Local_Area_Code) > 800 Then '
         g_Parm.Local_Area_Code  = "732"
         g_Parm.Country_Code  = "001"
         g_Parm.ComPort = "COM3"
         g_Parm.ComAtt  = "ATZ"
         g_Parm.ComPreDial = "ATDT"
         g_Parm.ComBaud = 115200
         g_Parm.comByte = 8
         g_Parm.comParity = 0
         g_Parm.comStop = 0
         g_Parm.comTxBuffer = 4096
         g_Parm.comRxBuffer = 4096
    '     
         Call CPD_Parameters_Put 'save them
         ?"Set New Parameters",, FuncName$
       End If   
    End Sub
    '
    Sub CPD_Parameters_Put
       CPD_common_Locals
       fn$ = CurDir$ & "\Parameters.prm"
       fnum = FreeFile
        Open fn$ For Binary As fnum
        Put #fnum, 1, g_parm
       Close #fnum        
    '   m$ = "New Parameters Set": m1$ = fn$: mb
    End Sub
    '***************************************************
    '***************************************************
    '**********************************************************************
    '**********************************************************************
    '**********************************************************************
    '**********************************************************************
    '**********************************************************************
    '**********************************************************************
    '**********************************************************************
    'End Clipboard_Dialer.Inc 
    '
    It's a pretty day. I hope you enjoy it.

    Gösta

    JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
    LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/
Working...
X
😀
🥰
🤢
😎
😡
👍
👎