Announcement

Collapse
No announcement yet.

Email checker in Source Code forum

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

  • #21
    Originally posted by Gösta H. Lovgren-2 View Post
    Sorry, Mel, the but euro_siren bit the dust.
    Oh well. I thought it was cool.
    There are no atheists in a fox hole or the morning of a math test.
    If my flag offends you, I'll help you pack.

    Comment


    • #22
      I am SO esscited! Tonight I added a Graphic Inkey to Mike Doty's nifty Sleeper routine (http://www.powerbasic.com/support/pb...ad.php?t=40472) that overlays the Title in the Loud MessageBox. (No Dialog Set Text for graphic windows - or at least I didn't see it.) AND it's the first time ever using Threads for me (have never seen/had a need). Just too much joy for this old heart all in one night. Am goin' to bed.

      Pretty cool I think {grin}.

      '
      Code:
      ' Program checks to see if there are Messages waiting and if so
      ' 1) it checks the messages against Filter list of of unwanteds
      ' 2) then bring up the Default Email Client .
      '
      ' *******************************************************
      '
      '       Inspired by and much/most taken from:                          
      'Mel Bishop & others
      'http://www.powerbasic.com/support/pbforums/showthread.php?t=40417
      '
      ' *******************************************************
      '
      'Program expects to find these two files:
      ' 1) "checkmail.ini"  'Password, User Name, etc.
      '    Example file: (don't include remarks or spaces)       
      '     mail.Exit109.com 'mail server
      '     REAL_Man         'User 
      '     YoullNeverGuess  'Password
      '
      ' 2) "Email_Filters.txt" - containing lines of text to Delete emails with any in them
      '         Example file:
      '    From: FreeFind report robot <[EMAIL="[email protected]"][email protected][/EMAIL]>
      '    Subject: [xxcopy] Digest Number
      '    <[EMAIL="[email protected]"][email protected][/EMAIL]> 
      'note Last line must NOT NOT be blank (see next item)
      '
      ' *******************************************************
      '    Here's a story, sad but true ...  (Can you finish that line?)
      ' Program doesn't do a lot of error checking so that's on you
      '                                                              
      ' *******************************************************
      '
      'PBWIN 9.01 - WinApi 05/2008 - XP Pro SP3
      '
      #Dim All 
      #Compile Exe  
      #Optimize SPEED 'Fly baby, fly
      #Debug Display On 'off in production code
      #Include "WIN32API.INC"
      '
      ' *******************************************************
      '  just easier to make globals for now                '
      Global G_Inky, gsResults, s, te, fi, sPop3Host, sUser, sPassword As String   
      Global hTracking As Long 'for tracking file 
      Global hwin As Dword, Title As String, msg1$, msg As String, Graphic_msg As String * 48 'for Graphic window
      Global hdlg As Dword                   
      Global My_Filters$(), Bummers$()
      Global g_Exit_Flag As Long
      '
      %BUFFER_LEN = 1024          '
      %Hesitate = 1000 'Hesitate between msgs to give time to see
      'Ids = even numbers, Associated Label = Id + 1
      %Id_Pop3Host = 1000 
      %Id_User_Name = 1002
      %Id_Password = 1004
      %Id_Save_And_Continue_Btn = 1006
      %Id_No_Set_Ini_So_Quit_Btn = 1008
      '
      ' *******************************************************
      '
      Macro Graphic_Window_Setup
          Local hfont As Dword 'just needed for setup
          Local col, row, wdth, hght As Long
          Local Tit As String 
      '    
         Desktop Get Size To Wdth, hght&
          Col = 10 
          Row = hght - 200'    (Hght \ 2) - 8           
          'reset title$
           Tit$ = Space$(Wdth \ 5) 'seems to work okay for 1024 w
          CSet Tit$ = " -  -  -  -  -  -  -  -  -  -  - " & Title$ & " -  -  -  -  -  -  -  -  - " 
          Graphic Window Tit$, Col, Row, wdth - 20, 100 To hWin
          Graphic Attach hWin, 0 
          Font New "Comic MS Sans", 48 To hfont '"Comic MS Sans" '"xxrty" 'Fat
          Graphic Set Font hfont
      End Macro
      '  
      Macro Graphic_Display_Msg
          Graphic Set Pos (1, 20)
          CSet Graphic_msg = msg1$
          Graphic Print Graphic_msg
      End Macro
      '
      ' *******************************************************
      '
      Macro ptf =  Print #hTracking,  'labor saver
      '
      ' *******************************************************
      '
      Macro Set_Up_Logging_File
        Local Track_File As String
          Track_File = CurDir$ & "\MYEMAIL.TXT"         
          Kill Track_File 'previous runs
         hTracking = FreeFile
           Open Track_File For Append As #hTracking
           ptf Time$, Date$   'new top line
      End Macro
      '
      ' *******************************************************
      '
      Sub Ini_New
       Local dlg_wd, dlg_ht, stile, Id, Wd, Hgt, Row, Col As Long
       Local Hdlg1, hfont1 As Dword
       Local l, l1, tit As String
       
       Tit$ = Space$(90)     
        dlg_Wd = 400
        dlg_ht = 200
        CSet tit$ = "Set up Initialization"
        Dialog New Pixels, hdlg1, tit$, , , dlg_wd, dlg_ht To hdlg1
      '
       Font New "Comic MS Sans", 12 To hfont1 
       Wd = 100
       Hgt = 20
       Row = 10
       Col = 10
      '
       Id = %Id_Pop3Host:  l$ = "Server Name": l1$ = sPop3Host: GoSub IN_Tb
       Id = %Id_User_Name: l$ = "User Name":   l1$ = sUser    : GoSub IN_Tb
       Id = %Id_Password:  l$ = "Password":    l1$ = sPassword: GoSub IN_Tb
      ' 
       Wd = 180
       Id = %Id_Save_And_Continue_Btn:  l$ = "Soldier On": GoSub IN_Btn
       Id = %Id_No_Set_Ini_So_Quit_Btn: l$ = "Quit this mess": GoSub IN_Btn
      '       now resize Dialog to fit
       Dlg_ht = Row + (hgt * 3) 
        Dialog Set Size hDlg1, Dlg_wd&, Dlg_ht&
        Dialog Show Modal hDlg1   Call Ini_Dialog_Processor
       Exit Sub 
      '
      In_Btn:
        Reset stile
         stile = Stile And %BS_Center
        Control Add Button, hdlg1, Id, l$, col, row, wd, hgt, stile  
         Control Set Font  hdlg1, Id, hfont1
        Col = Col + wd + 10
      Return
      '
      IN_Tb:                            
        Reset stile
        Control Add TextBox, hdlg1, Id, l1$, Col + Wd + 5, Row, Wd + wd + 70, Hgt, stile
        stile = Stile And %ss_Notify
          stile = Stile And %ss_Right
        Control Add Label, hdlg1, Id + 1, l$ & " ", Col, Row, Wd, Hgt, stile
      '
         Control Set Font  hdlg1, Id, hfont1
         Control Set Font  hdlg1, Id + 1, hfont1 
       Row = Row + Hgt + 10 
      Return
      '
      End Sub
      '
      '
      CallBack Function Ini_Dialog_Processor
        Select Case CB.Msg     'This is TO determine the message TYPE 
           '       
           Case %WM_INITDIALOG'<- Initialiaton when the program loads 
           '
           Case %WM_SYSCOMMAND 'Traps Any Alt key but only F4 closes              
           '
           Case %WM_COMMAND  'This processes command messages
             Select Case CB.Ctl
               Case %Id_Save_And_Continue_Btn
                 Select Case CB.CtlMsg
                   Case %BN_CLICKED
                     Call Ini_Set(CB.Hndl)   
                     Dialog End CB.Hndl
                 End Select
               Case %Id_No_Set_Ini_So_Quit_Btn 
                 Select Case CB.CtlMsg
                   Case %BN_CLICKED
                     g_Exit_Flag = 1
                     Dialog End CB.Hndl
                 End Select
             End Select
        End Select
      End Function                    
      '
      'get textbox values and print to new .ini file
      Sub Ini_Set(Hndl As Dword)
       Local f As String
       Local fnum, Id As Long
         fnum = FreeFile
         f$ = "checkmail.ini"
         Open f$ For Output As #fnum  
      '
         Id = %Id_Pop3Host : Control Get Text Hndl, Id To f$: Print #fnum, f$ 
         Id = %Id_User_Name: Control Get Text Hndl, Id To f$: Print #fnum, f$ 
         Id = %Id_Password : Control Get Text Hndl, Id To f$: Print #fnum, f$ 
       Close #fnum
      End Sub
      '
      ' *******************************************************
      '
      Macro Initialization_Stuff
        Local fnum, hTCP, Result, NumberOfMessages, MsgSize As Long         '
        Local tmr As Dword
        
          fi$ = "checkmail.ini"                                       '
          te$ = Dir$(fi$)
                                                       '
          If te$ = "" Then 'no file yet so:
      '      WinBeep 500, 1000 
            sPop3Host = "Mail.PowerBasic.com"
            sUser = "Lance_Borje_Hanlin"
            sPassword = "Its_a_Secret"
            Call Ini_New
            ptf "error",, "No .Ini file"
             If g_Exit_Flag = 1 Then Exit Function                       '
          End If                                  
                                                                      '
       '   fi$ = "checkmail.ini" 'while testing
          fnum = FreeFile
          Open fi$ For Input As #fnum                                    '
          Line Input #fnum,te$                                           ' e-Mail host
          sPop3Host = Remove$(te$," ")                                '
                                                                      '
          Line Input #fnum,te$                                           ' Your user name
          sUser = Remove$(te$," ")                                    '
                                                                      '
          Line Input #fnum,te$                                           ' Password
          sPassWord = Remove$(te$," ")                                '
                                                                      '
          Close #fnum 
      '
          s$ = fi$ & $CrLf & "          ISP: " & sPop3Host & $CrLf  & _                           ' parameters.
               "      User ID: " & sUser & $CrLf      & _                          '
          "     Password: " & sPassWord & $CrLf
          ptf s$
      '
        Call Retrieve_Filter_Array
      '  
         ptf Time$ & " Starting email check"
      End Macro                                                                
      '
      ' *******************************************************
      ' file of lines used to delete unwanted emails
      Sub Retrieve_Filter_Array
        ptf Time$ & " Getting Filter$()"
      '
        Local flen, ctr, fnum As Long
        Local fle  As String
      '
         fnum = FreeFile
          Open "Email_Filters.txt"  For Binary As fnum
           flen = Lof(fnum)   
         Fle$ = Space$(flen)'create a space to put the file
         Get fnum,,fle$  'put the file in the space
         Close fnum 
      '
         ctr = ParseCount(fle$, $CrLf) 
            Dim My_Filters$(1 To ctr)
          Parse Fle$, My_Filters$(), $CrLf 
      End Sub
      '
      ' *******************************************************
      '
      Sub Retrieve_Messages(hTcp As Long, Num_Msgs As Long)
       Local Msg_Number, ctr, i As Long
       Local msg, s, buffer As String
        ptf Using$("#, Messages", Num_Msgs) & "********** Starting ************" & $CrLf 
         msg1$ = Using$("#, Messages", Num_Msgs): Graphic_Display_Msg
         Call   Retrieve_Filter_Array 'get array  of bummers
         
       Do Until Msg_Number = Num_Msgs 'sent from Stat
          Incr Msg_Number 
            If Msg_Number > Num_Msgs Then GoTo Close_Retrieve 'done
             msg1$ = Using$("Retrieving ## of #, ", Msg_Number, Num_Msgs): Graphic_Display_Msg': Sleeper(%Hesitate)
      '    
          Tcp Print hTCP, "RETR" + Str$(Msg_Number)
          Tcp Line hTCP, Buffer$ 'get the answer
         ptf Using$("#, ", Msg_Number) & buffer$ & "   &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&"
            'something not right here
            If Left$(Buffer$, 3) <> "+OK" Then 
              ptf Using$("Buffer error at # ", Msg_Number) & Buffer$
              GoTo Close_Retrieve
            End If         
      '
            'now get rest of msg
           Reset Msg$
           Do
              Tcp Line hTCP, Buffer
              If Buffer = "." Then 'end of email
                'ptf "**************** exit internal DO by period - ."
                  Exit Do
              End If
      '
              If Left$(Buffer, 2) = ".." Then 'dunno why
                  Buffer = "." + Mid$(Buffer, 3)
              End If
      '
              Msg$ = msg$ & Buffer$ & $CrLf 
           Loop
      '
        Local i1 As Long
          i = InStr(msg$, "From:")
            i1 = InStr(i + 1, Msg$, $CrLf)
      '       msg1$ = Mid$(msg$, i + 5, i1 -i - 1): Graphic_Display_Msg
      '
            ptf Msg$ & $CrLf & $CrLf  & $CrLf  
      '
            'now do filter magic
            If Filter_Magic(msg$) > 0 Then 'bummer found
               Tcp Print hTCP,"DELE" + Str$(Msg_Number)
               Tcp Line hTCP, Buffer                          
               ptf Buffer & "  XXXXXXXXXXXXXXXXXXXX Deleted XXXXXXXXXXXXXXXXXXXXXXXX"
               msg1$ = Using$("Deleted #, ", ctr) & msg1$: Graphic_Display_Msg: Sleeper(%Hesitate) 'let us see it
               Incr ctr
            End If
       Loop  'get next msg
      Close_Retrieve:
        Pop3Quit(hTcp)
        ptf $CrLf & "************ Closed ************"
        ptf Using$("Found #, bummers", ctr)
         If ctr Then 'print bummers
           For i = LBound(Bummers$()) To UBound(Bummers$())
               ptf Using$("### ", i) & Bummers$(i)
           Next i
         End If
      End Sub 
      '
      ' *******************************************************
      '
      Function Filter_Magic(m As String) As Long
        Local flag, ctr, i, i1, ub As Long  
        Local f As String
           'check email against filter array
        For ctr = 1 To UBound(My_Filters$())
           If InStr(m$, My_Filters$(ctr)) Then 'got a bummer
              Incr Flag 
              ReDim Preserve Bummers$(UBound(Bummers$()) + 1)'<<< Works
              'ReDim Preserve Bummers$(1 To UBound(Bummers$()) + 1)'<<< Error 9
              ub = UBound(Bummers$()) 'ub easier
              Bummers$(ub) =  My_Filters$(ctr) & $CrLf 'filter line
      '        
              i = InStr(m$, "From:")
                i1 = InStr(i + 4, m$, $CrLf)  'find end of from line
      '
              Bummers$(ub) = Bummers$(ub) & Mid$(m$, i, i1 - i) & $CrLf  'Add to array  
              i = InStr(m$, "Subject:")
                i1 = InStr(i + 4, m$, $CrLf)  'find end of line
      ' 
              Bummers$(ub) = Bummers$(ub) & Mid$(m$, i, i1 - i) & $CrLf  
           End If    
        Next ctr
      ' 
         'now check for specifics using my page evals
        f$ = "AIT Web Server <[EMAIL="[email protected]"][email protected][/EMAIL]>"
        If InStr(m$, f$) Then
           'now check for spam senders
      '     Incr Flag 
        End If
      '
        Function = flag 'got a match
      End Function  
      '
      ' *******************************************************
      '
      Macro Pop_Account_Reached
        If hTCP > -1 Then                                             '  |
          Result = Pop3GetStat (hTCP&, NumberOfMessages&, MsgSize&)   '  |
      '                                                                 '  |
          If Result = 0 Then                                          '  |
            LogIt  "Messages:" + Str$(NumberOfMessages&)              '  |
            LogIt  "Length:"   + Str$(MsgSize&)                       '  |
           Else                                                        '  |
            LogIt "Error getting POP3 STAT"                           '  |
          End If                                                      '  |
      '                                                                '  |
      '    Result = Pop3Quit (hTCP) 'don't close here                                   '  |
          If result = -1 Then                                         '<:|
            LogIt "Error occurred closing server"                     ' ||
          Else                                                        '<:|
            LogIt "Bye, no problems"                                  ' ||
          End If                                                      '<:|
        'error connecting to POP3                                     '  |
         Else                                                          '  |
          Select Case hTCP                                            '  |
            Case -151:LogIt "No OK on POP3 open"                      '  |
            Case -152:LogIt "Bad user name"                           '  |
            Case -153:LogIt "Bad password"                            '  |
            Case Else:LogIt "Error connecting to POP3 "+ Str$(hTCP)   '  |
          End Select                                                  '  |
        End If                                                        '  |
      End Macro
      '
      ' *******************************************************
      '
      Sub Messages_Waiting(nTcp As Long, NumberOfMessages As Long)
        Local tmr As Long
             tmr = Timer
             Call Retrieve_Messages(nTcp, NumberOfMessages)
             gsResults = gsResults & $CrLf & _
                         Using$(" Took #, seconds", Timer - tmr)
             msg1$ = Using$(" Took #, seconds gettin #, Messages", Timer - tmr, NumberOfMessages): Graphic_Display_Msg: Sleeper(%Hesitate)
             ptf
             ptf gsResults  
             msg1$ = "Revving up email client": Graphic_Display_Msg: Sleeper(%Hesitate)
             Bring_Up_Default_Email_Client
      End Sub
      '
      ' *******************************************************
      '
      Function PBMain          
        'If Logging file not wanted then Rem this and turn Debug Off at top of program        
        '         Or
        ' Leave Debug On and Rem this and Search & Replace "ptf " with "'ptf " 
        Set_Up_Logging_File 
      '
        Initialization_Stuff 'Locals, UserName, etc.
         If g_Exit_Flag = 1 Then Exit Function 'from new Ini stuff
      '
         Title$ = "Checking for Pesky Email": Graphic_Window_Setup
          msg1$ = "Starting Now (S for Settings)": Graphic_Display_Msg: Sleeper(10000)'10 seconds
            Select Case g_Inky$ 'set in Ini_New         
               Case "s", "S"
                 Call Ini_New   
                 If g_Exit_Flag = 1 Then Exit Function
            End Select
      '
         msg1$ = "Getting Connection": Graphic_Display_Msg': Sleeper(%Hesitate)
          hTCP = Pop3Connect(sPop3Host, sUser, sPassword) 'connecting
      '
         msg1$ = "Getting Stats": Graphic_Display_Msg: Sleeper(%Hesitate)
         Pop_Account_reached 'returns email stats from server
      '          
        If NumberOfMessages > 0 Then                
           Call Messages_Waiting(hTcp, NumberOfMessages) 'Does filter thing and launches email program        
          Else
           msg1$ = "No new Messages": Graphic_Display_Msg
           
           Graphic Waitkey$ To Msg$
           Sleeper(5000)
        End If                                                      '  |
      End Function 'Applikation befurschtunken
      '
      ' *******************************************************
      '
      ' From Kev Peel                                                 '
      ' [URL]http://www.powerbasic.com/support/pbforums/showthread.php?t=16318[/URL]
      '
      Function Bring_Up_Default_Email_Client As Long
          Local sName As String, zTmp As Asciiz * %BUFFER_LEN, zMailClient As Asciiz * %BUFFER_LEN
        ' Get mail name...
          sName = GetReg(%HKEY_LOCAL_MACHINE, "SOFTWARE\Clients\Mail", "", "")
       
        ' Get mail program name...
          zTmp = GetReg(%HKEY_LOCAL_MACHINE, "SOFTWARE\Clients\Mail\" + sName + "\shell\open\command", "", "")
       
        ' Must expand environment strings like %ProgramFiles% (if any)
          ExpandEnvironmentStrings zTmp, zMailClient, SizeOf(zMailClient)
       
        ' If in quotes, then get whats inside the quotes...
          If InStr(zMailClient, Chr$(34)) Then zMailClient = Parse$(zMailClient, Chr$(34), 2)
       
          If zMailClient = "" Then
           ' Can't find it...
            MessageBox 0, "Couldn't find the default mail client", "MainClientFinder", %MB_ICONHAND
            Function = -99
          Else
           ' Execute mail client
             ShellExecute 0, "open", zMailClient, "", "", %SW_SHOW
             Function = 99 'successful
          End If
      End Function
      '
      ' *******************************************************
      '
      Function Pop3Connect (Pop3Host As String, User As String, _     '
                            password As String) As Long               '
          Local nTCP   As Long  'for server access                                      '
          Local Buffer As String                                      '
          'added this                                                 '
          Local LstErr As String                                      '
                                                                      '
          On Error GoTo Pop3Error                                     '
          LstErr = "Error opening POP3 server"                        '
          nTCP = FreeFile                                             '
         msg1$ = "Tcp Open pop3": Graphic_Display_Msg': Sleeper(%Hesitate)
          Tcp Open "pop3" At Pop3Host As nTCP                         '
          Tcp Line nTCP, Buffer                                       '
          If Left$(Buffer, 3) <> "+OK" Then                           '
              LstErr = "No OK on POP3 open"                           '
              Error 151                                               '
          End If                                                      '
         msg1$ = "Tcp User": Graphic_Display_Msg': Sleeper(%Hesitate)
          Tcp Print nTCP, "USER " + User                              '
          Tcp Line nTCP, Buffer                                       '
          If Left$(Buffer, 3) <> "+OK" Then                           '
              LstErr = "Bad mail user name"                           '
              Error 152                                               '
          End If                                                      '
         msg1$ = "Tcp Pass": Graphic_Display_Msg': Sleeper(%Hesitate)
          Tcp Print nTCP, "PASS " + password                          '
          Tcp Line nTCP, Buffer                                       '
          If Left$(Buffer, 3) <> "+OK" Then                           '
              LstErr = "Bad mail password"                            '
              Error 153                                               '
          End If                                                      '
          LstErr = ""                                                 '
          Function = nTCP                                             '
          Pop3ConnErr:                                                '
          Exit Function                                               '
      Pop3Error:                                                      '
      '    Close nTCP                                                  '
          Function = -(ErrClear)                                      '
          Resume Pop3ConnErr                                          '
      End Function                                                    '
                                                                      '
      '---------------------------------------------------------------'
      ' Disconnect from POP3 mail server                              '
      '                                                               '
      Function Pop3Quit (ByVal nTCP As Long) As Long                  '
          Local Buffer As String                                      '
          Tcp Print nTCP, "QUIT"                                      '
          Tcp Line nTCP, Buffer                                       '
          If Left$(Buffer, 3) <> "+OK" Then                           '
              Function = -1  'error                                   '
              ? "Error",, FuncName$                                           '
          End If                                                      '
          Close nTCP                                                  '
      End Function                                                    '
                                                                      '
      '---------------------------------------------------------------'
      ' Get the status of the POP3 account                            '
      '                                                               '
      Function Pop3GetStat (ByVal nTCP As Long, _                     '
                              Messages As Long, _                     '
                              MsgSize As Long) As Long                '
          Local Buffer As String                                      '
          'add this                                                   '
          Local LstErr As String                                      '
          Tcp Print nTCP, "STAT"                                      '
          Tcp Line nTCP, Buffer                                       '
          If Left$(Buffer, 3) <> "+OK" Then                           '
              Function = -154  'error                                 '
              LstErr = "Error getting POP3 STAT"                      '
              Exit Function                                           '
          End If                                                      '
          Messages = Val(Parse$(Buffer, " ", 2))                      '
          MsgSize  = Val(Parse$(Buffer, " ", 3))                      '
          Function = 0                                                '
      End Function                                                    '
                                                                      '
      ' From Kev Peel                                                 '
      ' [URL]http://www.powerbasic.com/support/pbforums/showthread.php?t=16318[/URL]
      '                                                                '
      Function GetReg(ByVal iLocation As Long, _
                       ByVal sSubKeys As String, _
                      ByVal sValueName As String, _
                      ByVal sDefault As String) As String
         Local hKey As Dword, zRegVal As Asciiz * %BUFFER_LEN
          If iLocation = 0 Then iLocation = %HKEY_CURRENT_USER
          '
          If RegOpenKeyEx(iLocation, Trim$(sSubKeys, "\"), 0, %KEY_READ, hKey) = %ERROR_SUCCESS Then
            If RegQueryValueEx(hKey, ByCopy sValueName, 0, %REG_SZ, zRegVal, %BUFFER_LEN) _
                         <> %ERROR_SUCCESS Then GoTo RegStringDefault:
          Else
            RegStringDefault:
            zRegVal = sDefault
          End If
          '
          If hKey Then RegCloseKey hKey
          '
          Function = zRegVal
      End Function'
      ' *******************************************************
      '                                                                '
      Sub LogIt(s As String)                                          '
          s = s + $CrLf    
          ptf Time$ & "   " & s$                                           '
          gsResults = gsResults + s                                   '
      End Sub                                                     '
      '
      '
      ' *******************************************************
      '
       'http://www.powerbasic.com/support/pbforums/showthread.php?t=40472
       'Mik Doty
      Function Sleeper(milliseconds As Dword) As Long
         Local hThread As Dword
         If Len(Command$) Then                'override passed value
           milliseconds = Abs(Val(Command$))  'use value in COMMAND$
         End If
        Thread Create TimedMessageBoxThread(milliseconds) To hThread
         Sleep 50
        WaitForSingleObject hThread, milliseconds
        Thread Close hThread To hThread
      End Function
      '
      Thread Function TimedMessageBoxThread(ByVal milliseconds As Dword) As Long
       #If %Def(%Pb_Cc32)
        ? "Press ENTER to continue or WAIT" + Using$(".# Seconds", milliseconds / 1000) 
        WAITKEY$
       #Else             
          Local hWin2 As Dword
          Local col, row, wdth, hght As Long
          Local Tit  As String 
      '    
         Desktop Get Size To Wdth, hght&
          Col = 10 
          Row = hght - 200'get above other graphic window
          'reset title$
           Tit$ = Space$(Wdth \ 5) 'seems to work okay for 1024 width
           
          CSet Tit$ = Using$(" - - Press a key or wait .# Seconds - -", MilliSeconds / 1000) 
          Graphic Window Tit$, Col, Row, wdth - 20, 15 To hWin2
          Graphic Attach hWin2, 0 
          Graphic WAITKEY$ To G_Inky
          Graphic Window End  
      '  ? "Click OK to continue or WAIT" + Str$(milliseconds) + " milliseconds"', %MB_SYSTEMMODAL, "Waiting on you"
       #EndIf
      End Function    
      '
      ' *******************************************************
      '
      '
      Note the .exe is on my website (link above).

      ==========================================
      An uneducated man has one great advantage
      over an educated man.
      He does not know
      what is not possible.
      Swede
      ==========================================
      Last edited by Gösta H. Lovgren-2; 5 May 2009, 10:52 PM. Reason: Replaced with updated code with exciting enhancements {laughing}
      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/

      Comment


      • #23
        Dunno if any are interested but I replaced the code above with exciting mind blowing astonishing new features. {geez, I can make myself laugh pretty easily}.

        When the program starts up, if no .ini is present, it automatically (requiring no effort from the user) pops up a handsome Ini Dialog where Server, User name, etc. can be entered. Or the user can access the Ini Dialog at start up via a special key...

        It has been exhaustively tested (I ran it at least twice) before being posted here so ...

        (Website .exe updated too. Link posted previously)

        ==============================
        In this world nothing is sure
        but death and taxes.
        Ben Franklin
        ==============================
        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/

        Comment


        • #24
          I don't expect anyone else is usinig this email checker (I've found it indispensible for pre checking for unwanted emails - not necessarily spam) but if he is I made some changes. It was brutally slow with large attachments. And I didn't realize why /(Well, I knew but didn't realize.)

          Anyway reading another thread mentioning concatenation the other day, it just struck me today that was the reason the program was slow. Far slower than Eudora is when retrieving the email, for example

          By pre-allocating the message to be retrieved size, it now checks the mail as fast, maybe even faster, than Eudora.

          Here's the code JIC anyone is interested: (.exe is at link below)
          '
          Code:
          ' Program checks to see if there are Messages waiting and if so
          ' 1) it checks the messages against Filter list of of unwanteds
          ' 2) then bring up the Default Email Client .
          '
          ' *******************************************************
          '
          '       Inspired by and much/most taken from:                          
          'Mel Bishop & others
          'http://www.powerbasic.com/support/pbforums/showthread.php?t=40417
          '
          ' *******************************************************
          '
          'Program expects to find these two files:
          ' 1) "checkmail.ini"  'Server, Password, User Name : Example file: (don't include remarks or spaces)       
          '     mail.Exit109.com 'mail server
          '     REAL_Man         'User 
          '     YoullNeverGuess  'Password
          '
          ' 2) "Email_Filters.txt" - containing lines of text to Delete emails with any in them: Example file:
          '    From: FreeFind report robot <[EMAIL="[email protected]"][email protected][/EMAIL]>
          '    Subject: [xxcopy] Digest Number
          '    <[EMAIL="[email protected]"][email protected][/EMAIL]>     
          '    Below please find a special message from one of our advertisers
          '
          'note Last line must NOT NOT be blank (see next item)
          'file can be as many lines as wanted
          ' *******************************************************
          '    Here's a story, sad but true ...  (Can you finish that line?)
          ' Program doesn't do a lot of error checking so that's on you
          '                                                              
          ' *******************************************************
          '
          'PBWIN 9.01 - WinApi 05/2008 - XP Pro SP3
          '
          #Dim All 
          #Compile Exe 
          #Optimize SPEED 'Fly baby, fly
          #Debug Display On 'off in production code
          #Include "WIN32API.INC"
          '
          ' *******************************************************
          '  just easier to make globals for now                '
          Global g_Title, G_Inky, gsResults, s, te, fi, sPop3Host, sUser, sPassword As String   
          Global hTracking As Long 'for tracking file 
          Global hwin, hfont As Dword, Title, msg1, msg, msg2 As String
          Global Graphic_msg As String * 50 'for top line Graphic window
          'Global Graphic_msg1 As String * 200 'for 1st line Graphic window
          
          Global Graphic_msg As String * 50 'for top line Graphic window
          Global Graphic_msg1 As String * 200 'for 1st line Graphic window
          Global Graphic_msg2 As String * 70 'for 2nd line Graphic window
          Global Graphic_msg3 As String * 120 'for 3nd line Graphic window
          Global Graphic_msg5 As String * 120 'for 5th line Graphic window
          Global hdlg As Dword                   
          Global My_Filters$(), Bummers$()
          Global g_Exit_Flag, g_Dlg_Wd, g_Dlg_ht As Long
          Global hwin, hfont, hfont2, hfont3 As Dword
          Global hfont8, hfont9,hfont10,hfont11,hfont12,hfont14,hfont16,hfont18,hfont20,hfont22,hfont24,hfont36 As Dword
             Global Title, msg1, msg, msg2 As String
          '
          %BUFFER_LEN = 1024          '
          %Hesitate = 1000 'Hesitate between msgs to give time to see
          'Ids = even numbers, associated Label = Id + 1
          %Id_Pop3Host = 1000 
          %Id_User_Name = 1002
          %Id_Password = 1004
          %Id_Save_And_Continue_Btn = 1006
          %Id_No_Set_Ini_So_Quit_Btn = 1008
          '
          ' *******************************************************
          '
          Macro Graphic_Variables_Setup
             Font New "Comic MS Sans", 36 To hfont36 '"Comic MS Sans" 
             Font New "Comic MS Sans", 24 To hfont24 '"Comic MS Sans"
             Font New "Comic MS Sans", 22 To hfont22 '"Comic MS Sans"
          End Macro
          '
          Macro Graphic_Window_Setup
              'Local hfont As Dword 'just needed for setup
              Local col, row, wdth, hght As Long
              Local Tit As String 
          '   
             Desktop Get Size To Wdth, hght&
              Col = 10 
              Row = hght - 400'    (Hght \ 2) - 8      
              g_Dlg_ht = 300       
              g_Dlg_wd = Wdth - 20
                  
              'reset title$
               Tit$ = Space$(Wdth \ 5) 'seems to work okay for 1024 w
              CSet Tit$ = " -  -  -  -  -  -  -  -  -  -  - " & g_Title$ & " -  -  -  -  -  -  -  -  - " 
              Graphic Window Tit$, Col, Row, g_Dlg_wd,  g_Dlg_ht To hWin
              Graphic Attach hWin, 0 
          End Macro
          '
          Macro Graphic_Display_Msg
              Graphic Set Font hfont36
              Graphic Set Pos (1, 10)
                If Left$(msg1$, 2) = "c " Then 'center
                  CSet Graphic_msg = Mid$(msg1$, 3)      
                 Else 
                  LSet Graphic_msg = msg1$      
                End If
              Graphic Print Graphic_msg
          End Macro
          '  
          Macro Graphic_Display_Msg2
              Graphic Set Font hfont22
              Graphic Set Pos (1, 75)
                If Left$(msg2$, 2) = "c " Then 'center
                  CSet Graphic_msg2 = Mid$(msg2$, 3)      
                 Else 
                  LSet Graphic_msg2 = msg2$      
                End If
              Graphic Print Graphic_msg2
          End Macro
          '  
          Macro Graphic_Display_Msg3
              Graphic Set Font hfont24
              Graphic Set Pos (1, 115)
                If Left$(msg2$, 2) = "c " Then 'center
                  CSet Graphic_msg2 = Mid$(msg2$, 3)      
                 Else 
                  LSet Graphic_msg2 = msg2$      
                End If
              Graphic Print Graphic_msg2
          End Macro
          '  
          Macro Graphic_Display_Msg4
              Graphic Set Font hfont24
              Graphic Set Pos (1, 160)
                If Left$(msg2$, 2) = "c " Then 'center
                  CSet Graphic_msg2 = Mid$(msg2$, 3)      
                 Else 
                  LSet Graphic_msg2 = msg2$      
                End If
              Graphic Print Graphic_msg2
          End Macro
          '
          Macro Graphic_Display_Msg5
              Graphic Set Font hfont22
              Graphic Set Pos (1, 200)
                If Left$(msg2$, 2) = "c " Then 'center
                  CSet Graphic_msg5 = Mid$(msg2$, 3)      
                 Else 
                  LSet Graphic_msg5 = msg2$      
                End If
              Graphic Print Graphic_msg5
          End Macro
          '
          ' *******************************************************
          '
          Macro ptf =  Print #hTracking,  'labor saver
          '
          ' *******************************************************
          '
          Macro Set_Up_Logging_File
            Local Track_File As String
              Track_File = CurDir$ & "\MYEMAIL.TXT"         
              Kill Track_File 'previous runs
             hTracking = FreeFile
               Open Track_File For Append As #hTracking
               ptf Time$, Date$   'new top line
          End Macro
          '
          ' *******************************************************
          '
          Sub Ini_New
           Local hdlg1, dlg_wd, dlg_ht, stile, Id, Wd, Hgt, Row, Col As Long
           Local l, l1, tit As String
           
           Tit$ = Space$(90)     
            dlg_Wd = 400
            dlg_ht = 200
            CSet tit$ = "Set up Initialization"
            Dialog New Pixels, hdlg, tit$, , , dlg_wd, dlg_ht To hdlg1
          '
           Font New "Comic MS Sans", 12 To hfont12 
           Wd = 100
           Hgt = 20
           Row = 10
           Col = 10
          '
           Id = %Id_Pop3Host:  l$ = "Server Name": l1$ = sPop3Host: GoSub IN_Tb
           Id = %Id_User_Name: l$ = "User Name":   l1$ = sUser    : GoSub IN_Tb
           Id = %Id_Password:  l$ = "Password":    l1$ = sPassword: GoSub IN_Tb
          ' 
           Wd = 180
           Id = %Id_Save_And_Continue_Btn:  l$ = "Soldier On": GoSub IN_Btn
           Id = %Id_No_Set_Ini_So_Quit_Btn: l$ = "Quit this mess": GoSub IN_Btn
          '       now resize Dialog to fit
           Dlg_ht = Row + (hgt * 3) 
            Dialog Set Size hDlg1, Dlg_wd&, Dlg_ht&
            Dialog Show Modal hDlg1   Call Ini_Dialog_Processor
           Exit Sub 
          '
          In_Btn:
            Reset stile
             stile = Stile And %BS_Center
            Control Add Button, hdlg1, Id, l$, col, row, wd, hgt, stile  
             Control Set Font  hdlg1, Id, hfont10
            Col = Col + wd + 10
          Return
          '
          IN_Tb:                            
            Reset stile
            Control Add TextBox, hdlg1, Id, l1$, Col + Wd + 5, Row, Wd + wd + 70, Hgt, stile
          '
            Reset stile 
            stile = Stile And %ss_Notify 'in case I want to use them
              stile = Stile And %ss_Right
            Control Add Label, hdlg1, Id + 1, l$ & " ", Col, Row, Wd, Hgt, stile
          '
             Control Set Font  hdlg1, Id, hfont10                     
             Control Set Font  hdlg1, Id + 1, hfont10 
           Row = Row + Hgt + 10 
          Return
          '
          End Sub
          '
          '
          CallBack Function Ini_Dialog_Processor
            Select Case CB.Msg     'This is TO determine the message TYPE 
               '       
               Case %WM_INITDIALOG'<- Initialiaton when the program loads 
               '
               Case %WM_SYSCOMMAND 'Traps Any Alt key but only F4 closes              
               '
               Case %WM_COMMAND  'This processes command messages
                 Select Case CB.Ctl
                   Case %Id_Save_And_Continue_Btn
                     Select Case CB.CtlMsg
                       Case %BN_CLICKED
                         Call Ini_Set(CB.Hndl)   
                         Dialog End CB.Hndl
                     End Select
                   Case %Id_No_Set_Ini_So_Quit_Btn 
                     Select Case CB.CtlMsg
                       Case %BN_CLICKED
                         g_Exit_Flag = 1
                         Dialog End CB.Hndl
                     End Select
                 End Select
            End Select
          End Function                    
          '
          'get textbox values and print to new .ini file
          Sub Ini_Set(Hndl As Dword)
           Local f As String
           Local fnum, Id As Long
             fnum = FreeFile
             f$ = "checkmail.ini"
             Open f$ For Output As #fnum  
          '
             Id = %Id_Pop3Host : Control Get Text Hndl, Id To f$: Print #fnum, f$ 
             Id = %Id_User_Name: Control Get Text Hndl, Id To f$: Print #fnum, f$ 
             Id = %Id_Password : Control Get Text Hndl, Id To f$: Print #fnum, f$ 
           Close #fnum
          End Sub
          '
          ' *******************************************************
          '
          Macro Initialization_Stuff
            Local fnum, hTCP, Result, NumberOfMessages, MsgSize As Long         '
            Local tmr As Dword
            
              fi$ = "checkmail.ini"                                       '
              te$ = Dir$(fi$)
                                                           '
              If te$ = "" Then 'no file yet so:
          '      WinBeep 500, 1000 
                sPop3Host = "Mail.PowerBasic.com"
                sUser = "Lance_Borje_Hanlin"
                sPassword = "Its_a_Secret"
                Call Ini_New
                ptf "error",, "No .Ini file"
                 If g_Exit_Flag = 1 Then Exit Function                       '
              End If                                  
                                                                          '
           '   fi$ = "checkmail.ini" 'while testing
              fnum = FreeFile
              Open fi$ For Input As #fnum                                    '
              Line Input #fnum,te$                                           ' e-Mail host
              sPop3Host = Remove$(te$," ")                                '
                                                                          '
              Line Input #fnum,te$                                           ' Your user name
              sUser = Remove$(te$," ")                                    '
                                                                          '
              Line Input #fnum,te$                                           ' Password
              sPassWord = Remove$(te$," ")                                '
                                                                          '
              Close #fnum 
          '
              s$ = fi$ & $CrLf & "          ISP: " & sPop3Host & $CrLf  & _                           ' parameters.
                   "      User ID: " & sUser & $CrLf      & _                          '
              "     Password: " & sPassWord & $CrLf
              ptf s$
          '
            Call Retrieve_Filter_Array
          '  
          '   ptf Time$ & " Starting email check"
          End Macro                                                                
          '
          ' *******************************************************
          ' file of lines used to delete unwanted emails
          Sub Retrieve_Filter_Array
            ptf Time$ & " Getting Filter$()"
          '
            Local flen, ctr, fnum As Long
            Local fle  As String
          '
             fnum = FreeFile
              Open "Email_Filters.txt"  For Binary As fnum
               flen = Lof(fnum)   
             Fle$ = Space$(flen)'create a space to put the file
             Get fnum,,fle$  'put the file in the space
             Close fnum 
          '
             ctr = ParseCount(fle$, $CrLf) 
                Dim My_Filters$(1 To ctr)
              Parse Fle$, My_Filters$(), $CrLf 
          End Sub
          '
          ' *******************************************************
          '
          Macro Message_Size
             'Msg size   +OK 4903 octets
               s$ = Mid$(buffer$, 5)
                 i = InStr(s$, " octets")
                 Octet$ = Oct$(Val(Left$(s$, i - 1)))
                 Msg_Size = Val(Octet$) \ 4
                 ptf Using$("Msg Size = #, bytes", Msg_Size)
          End Macro
          '
          ' *******************************************************
          '
          Sub Retrieve_Messages(hTcp As Long, Num_Msgs As Long)
           Local Msg_Size, Msg_Number, ctr, ctr2, i, i1, tmr, t As Long
           Local n As Single
           Local msg, s, s1, subj, buffer, Frm, octet As String
            ptf Using$("#, Messages", Num_Msgs) & "********** Starting ************" & $CrLf 
             msg1$ = Using$("c #, Messages", Num_Msgs): Graphic_Display_Msg
             Call   Retrieve_Filter_Array 'get array  of bummers
             tmr = Timer
          '   
           Do Until Msg_Number = Num_Msgs 'sent from Stat
              Incr Msg_Number                 
                Reset frm$, subj$
                If Msg_Number > Num_Msgs Then GoTo Close_Retrieve 'done
          '    
              Tcp Print hTCP, "RETR" + Str$(Msg_Number)
              Tcp Line hTCP, Buffer$ 'get the answer
             ptf Using$("#, ", Msg_Number) & "   &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&"
             ptf buffer$
          '
          '
                 Message_Size
                 msg1$ = Using$("c Retrieving ## of ###  #,###kb", Msg_Number, Num_Msgs, Msg_Size \ 1000): Graphic_Display_Msg
          '       msg2$ = Using$("Removed #", ctr): Graphic_Display_Msg2
                t = Timer - tmr
                 Msg2$ = Using$("c # seconds elapsed   Removed # ##%", T, ctr, ctr / Num_Msgs * 100): Graphic_Display_Msg3               
          '       Graphic waitkey$
          '       If Msg_Number > 3 Then GoTo Close_Retrieve 'testing
          '
                'something not right here
                If Left$(Buffer$, 3) <> "+OK" Then 
                  ptf Using$("Buffer error at # ", Msg_Number) & Buffer$
                  GoTo Close_Retrieve
                End If         
          '
                'now get rest of msg
               Reset Msg$, ctr2                                                             
               msg$ = Space$(Msg_Size + %BUFFER_LEN) 'big enough to hold message
               Local Place_in_Buffer As Long
               Place_in_Buffer = 1
               Do            
          '        Graphic Inkey$ To s1$
          '            If s1$ = "q" Or s1$ = "Q" Then GoTo Close_Retrieve
                  Tcp Line hTCP, Buffer
                  If Buffer = "." Then 'end of email
                    'ptf "**************** exit internal DO by period - ."
                      Exit Do
                  End If
          '
                  If Left$(Buffer, 2) = ".." Then 'dunno why
                      Buffer = "." + Mid$(Buffer, 3)
                  End If
          '
                 ' Msg$ = msg$ & Buffer$ & $CrLf     
                  Mid$(Msg$, Place_in_Buffer) = Buffer$ 'no concatenation
                   Place_in_Buffer = Place_in_Buffer + Len(Buffer$) + Len($CrLf)
          '
                  If Frm$ = "" Then 'find From:
                     i = InStr(msg$, "From:")
                      If i Then
                        i1 = InStr(i + 1, msg$, $CrLf)
                        frm$ = Mid$(msg$, i, i1 - 1 - 1)
                        msg2$ = "c " & frm$: Graphic_Display_Msg4                 
                      End If
                  End If
          '
                  If Subj$ = "" Then 'find From:
                     i = InStr(msg$, "Subject:")
                      If i Then
                        i1 = InStr(i + 1, msg$, $CrLf)
                        Subj$ = Mid$(msg$, i, i1 - 1 - 1)
                        msg2$ = "c " & Subj$: Graphic_Display_Msg5                 
                      End If
                  End If
          '                
                  Incr ctr2
                  If ctr2 / 25 = ctr2 \ 25 Then 'really big msg probably embedded/attached graphics or movie or ...  
                        n = (Place_in_Buffer / Msg_Size) * 100
                        'ptf Str$(), Str$(), Str$(Len(buffer$) / Msg_Size) 
                        msg2$ = Using$("c ##,###,### bytes ##.##% done", Place_in_Buffer, n)
                           Graphic_Display_Msg2
                  End If                                                                
               Loop
               Reset ctr2
          '       
                 'just save headers
              i = InStr(msg$, "X-UIDL:")
               i1 = InStr(i + 1, Msg$, $CrLf)
                ptf Left$(Msg$, i1) & $CrLf & $CrLf  & $CrLf  
          '
                'now do filter magic
                If Filter_Magic(msg$) > 0 Then 'bummer found
                   Tcp Print hTCP,"DELE" + Str$(Msg_Number)
                   Tcp Line hTCP, Buffer                          
                   ptf Buffer & "  XXXXXXXXXXXXXXXXXXXX Deleted XXXXXXXXXXXXXXXXXXXXXXXX"
                   Incr ctr
                End If
           Loop  'get next msg
          Close_Retrieve:
            Pop3Quit(hTcp)
            ptf $CrLf & "************ Closed ************"
            ptf Using$("Found #, bummers", ctr)
             If ctr Then 'print bummers
               Array Sort Bummers$()
               Local ctr4 As Long               
               ctr4 = 1
               For i = LBound(Bummers$()) To UBound(Bummers$()) 
                   'don't print dupes
                   If i < UBound(Bummers$()) Then 'not to end yet
                      If Left$(Bummers$(i), 20)  = Left$(Bummers$(i + 1), 20) Then 'matched
                        Incr ctr4
                        Iterate For'matches so skip
                      End If 
                   End If
                  ptf Using$("### --- ", ctr4) & Bummers$(i)
                  ctr4 = 1 
               Next i
             End If
          End Sub 
          '
          ' *******************************************************
          '
          Function Filter_Magic(m As String) As Long
            Local flag, ctr, i, i1, ub As Long  
            Local f As String
               'check email against filter array
            For ctr = 1 To UBound(My_Filters$())
               If InStr(m$, My_Filters$(ctr)) Then 'got a bummer
                  Incr Flag 
                  ReDim Preserve Bummers$(UBound(Bummers$()) + 1)'<<< Works
                  ub = UBound(Bummers$()) 'ub easier
                  Bummers$(ub) =  My_Filters$(ctr) & $CrLf 'filter line
          '        
                  i = InStr(m$, "From: ")
                    i1 = InStr(i + 4, m$, $CrLf)  'find end of from line
          '
                  Bummers$(ub) = Bummers$(ub) & Mid$(m$, i, i1 - i) & $CrLf  'Add to array  
                  i = InStr(m$, "Subject:")
                    i1 = InStr(i + 4, m$, $CrLf)  'find end of line
          ' 
                  Bummers$(ub) = Bummers$(ub) & Mid$(m$, i, i1 - i) & $CrLf  
               End If    
            Next ctr
          ' 
             'now check for specifics using my page evals
            f$ = "AIT Web Server <[EMAIL="[email protected]"][email protected][/EMAIL]>"
            If InStr(m$, f$) Then                         
                m$ = LCase$(m$)
                If InStr(m$, "<a href=") Then Incr flag
               'now check for spam senders
          '     Incr Flag 
            End If
          '
            Function = flag 'got a match
          End Function  
          '
          ' *******************************************************
          '
          Macro Pop_Account_Reached
            If hTCP > -1 Then                                             '  |
              Result = Pop3GetStat (hTCP&, NumberOfMessages&, MsgSize&)   '  |
          '                                                                 '  |
              If Result = 0 Then                                          '  |
                LogIt  "Messages:" + Str$(NumberOfMessages&)              '  |
                LogIt  "Length:"   + Str$(MsgSize&)                       '  |
               Else                                                        '  |
                LogIt "Error getting POP3 STAT"                           '  |
              End If                                                      '  |
          '                                                                '  |
          '    Result = Pop3Quit (hTCP) 'don't close here                                   '  |
              If result = -1 Then                                         '<:|
                LogIt "Error occurred closing server"                     ' ||
              Else                                                        '<:|
                LogIt "Bye, no problems"                                  ' ||
              End If                                                      '<:|
            'error connecting to POP3                                     '  |
             Else                                                          '  |
              Select Case hTCP                                            '  |
                Case -151:LogIt "No OK on POP3 open"                      '  |
                Case -152:LogIt "Bad user name"                           '  |
                Case -153:LogIt "Bad password"                            '  |
                Case Else:LogIt "Error connecting to POP3 "+ Str$(hTCP)   '  |
              End Select                                                  '  |
            End If                                                        '  |
          End Macro
          '
          ' *******************************************************
          '
          Sub Messages_Waiting(nTcp As Long, NumberOfMessages As Long)
            Local tmr As Long
                 tmr = Timer
                 Call Retrieve_Messages(nTcp, NumberOfMessages)
                 gsResults = gsResults & $CrLf & _
                             Using$(" Took #, seconds", Timer - tmr)
                 ptf
                 ptf gsResults                                         
                 msg1$ = "c Revving up email client": Graphic_Display_Msg
                 msg2$ = Using$("c Took #, seconds gettin #, Messages", Timer - tmr, NumberOfMessages): Graphic_Display_Msg2
                 tmr = Timer
          Waiting:                                  
                Graphic inkey$ To GsResults
                If gsResults = "" And Timer - tmr < 3 Then GoTo Waiting
                 Bring_Up_Default_Email_Client
          End Sub
          '
          ' *******************************************************
          '
          Function PBMain          
            'If Logging file not wanted then Rem this and turn Debug Off at top of program        
            '         Or
            ' Leave Debug On and Rem this and Search & Replace "ptf " with "'ptf " 
            Set_Up_Logging_File 
          '
            Graphic_Variables_Setup
            Initialization_Stuff 'Locals, UserName, etc.
             If g_Exit_Flag = 1 Then Exit Function 'from new Ini stuff
          '
             g_Title$ = "Checking for Pesky Email":Graphic_Window_Setup
              msg1$ = "c Press a key" : Graphic_Display_Msg
              msg2$ = "c (S for Settings)": Graphic_Display_Msg2:' Sleeper(10000)'10 seconds
              Graphic waitkey$ To g_Inky$
                Select Case g_Inky$ 
                   Case "s", "S"
                     Call Ini_New   
                     If g_Exit_Flag = 1 Then Exit Function
                   Case "q", "Q"
                     Exit Function
                End Select
          '
             g_Title$ = "Establishing a Connection"
             msg1$ = "c Getting Connection": Graphic_Display_Msg
              msg2$ = " ": Graphic_Display_Msg2
              hTCP = Pop3Connect(sPop3Host, sUser, sPassword) 'connecting
          '
             g_Title$ = "Any Messages to read?"
             msg2$ = "c Getting Stats": Graphic_Display_Msg2
             Pop_Account_reached 'returns email stats from server
          '          
            If NumberOfMessages > 0 Then                
               g_Title$ = "Going to Work"
                msg1$ = "c Woe is me": Graphic_Display_Msg
                msg2$ = "c Gotta go to work": Graphic_Display_Msg2: Sleeper(%Hesitate)
               Call Messages_Waiting(hTcp, NumberOfMessages) 'Does filter thing and launches email program        
              Else
               msg1$ = "c No new Messages": Graphic_Display_Msg
               msg2$ = " ": Graphic_Display_Msg2
            End If                                                      '  |
            Sleeper(5000)
          End Function 'Applikation bafurschtunken
          '
          ' *******************************************************
          '
          ' From Kev Peel                                                 '
          ' [URL]http://www.powerbasic.com/support/pbforums/showthread.php?t=16318[/URL]
          '
          Function Bring_Up_Default_Email_Client As Long
              Local sName As String, zTmp As Asciiz * %BUFFER_LEN, zMailClient As Asciiz * %BUFFER_LEN
            ' Get mail name...
              sName = GetReg(%HKEY_LOCAL_MACHINE, "SOFTWARE\Clients\Mail", "", "")
           
            ' Get mail program name...
              zTmp = GetReg(%HKEY_LOCAL_MACHINE, "SOFTWARE\Clients\Mail\" + sName + "\shell\open\command", "", "")
           
            ' Must expand environment strings like %ProgramFiles% (if any)
              ExpandEnvironmentStrings zTmp, zMailClient, SizeOf(zMailClient)
           
            ' If in quotes, then get whats inside the quotes...
              If InStr(zMailClient, Chr$(34)) Then zMailClient = Parse$(zMailClient, Chr$(34), 2)
           
              If zMailClient = "" Then
               ' Can't find it...
                MessageBox 0, "Couldn't find the default mail client", "MainClientFinder", %MB_ICONHAND
                Function = -99
              Else
               ' Execute mail client
                 ShellExecute 0, "open", zMailClient, "", "", %SW_SHOW
                 Function = 99 'successful
              End If
          End Function
          '
          ' *******************************************************
          '
          Function Pop3Connect (Pop3Host As String, User As String, _     '
                                password As String) As Long               '
              Local nTCP   As Long  'for server access                                      '
              Local Buffer As String                                      '
              'added this                                                 '
              Local LstErr As String                                      '
                                                                          '
              On Error GoTo Pop3Error                                     '
              LstErr = "Error opening POP3 server"                        '
              nTCP = FreeFile                                             '
             msg1$ = "c Tcp Open pop3": Graphic_Display_Msg': Sleeper(%Hesitate)
              Tcp Open "pop3" At Pop3Host As nTCP                         '
              Tcp Line nTCP, Buffer                                       '
              If Left$(Buffer, 3) <> "+OK" Then                           '
                  LstErr = "No OK on POP3 open"                           '
                  Error 151                                               '
              End If                                                      '
             msg2$ = "c Tcp User": Graphic_Display_Msg': Sleeper(%Hesitate)
              Tcp Print nTCP, "USER " + User                              '
              Tcp Line nTCP, Buffer                                       '
              If Left$(Buffer, 3) <> "+OK" Then                           '
                  LstErr = "Bad mail user name"                           '
                  Error 152                                               '
              End If                                                      '
             msg1$ = "c Tcp Pass": Graphic_Display_Msg': Sleeper(%Hesitate)
              Tcp Print nTCP, "PASS " + password                          '
              Tcp Line nTCP, Buffer                                       '
              If Left$(Buffer, 3) <> "+OK" Then                           '
                  LstErr = "Bad mail password"                            '
                  Error 153                                               '
              End If                                                      '
              LstErr = ""                                                 '
              Function = nTCP                                             '
              Pop3ConnErr:                                                '
              Exit Function                                               '
          Pop3Error:                                                      '
          '    Close nTCP                                                  '
              Function = -(ErrClear)                                      '
              Resume Pop3ConnErr                                          '
          End Function                                                    '
                                                                          '
          '---------------------------------------------------------------'
          ' Disconnect from POP3 mail server                              '
          '                                                               '
          Function Pop3Quit (ByVal nTCP As Long) As Long                  '
              Local Buffer As String                                      '
              Tcp Print nTCP, "QUIT"                                      '
              Tcp Line nTCP, Buffer                                       '
              If Left$(Buffer, 3) <> "+OK" Then                           '
                  Function = -1  'error                                   '
                  ? "Error",, FuncName$                                           '
              End If                                                      '
              Close nTCP                                                  '
          End Function                                                    '
                                                                          '
          '---------------------------------------------------------------'
          ' Get the status of the POP3 account                            '
          '                                                               '
          Function Pop3GetStat (ByVal nTCP As Long, _                     '
                                  Messages As Long, _                     '
                                  MsgSize As Long) As Long                '
              Local Buffer As String                                      '
              'add this                                                   '
              Local LstErr As String                                      '
              Tcp Print nTCP, "STAT"                                      '
              Tcp Line nTCP, Buffer                                       '
              If Left$(Buffer, 3) <> "+OK" Then                           '
                  Function = -154  'error                                 '
                  LstErr = "Error getting POP3 STAT"                      '
                  Exit Function                                           '
              End If                                                      '
              Messages = Val(Parse$(Buffer, " ", 2))                      '
              MsgSize  = Val(Parse$(Buffer, " ", 3))                      '
              ptf FuncName$
              ptf Buffer  & $CrLf 
              Function = 0                                                '
          End Function                                                    '
                                                                          '
          ' From Kev Peel                                                 '
          ' [URL]http://www.powerbasic.com/support/pbforums/showthread.php?t=16318[/URL]
          '                                                                '
          Function GetReg(ByVal iLocation As Long, _
                           ByVal sSubKeys As String, _
                          ByVal sValueName As String, _
                          ByVal sDefault As String) As String
             Local hKey As Dword, zRegVal As Asciiz * %BUFFER_LEN
              If iLocation = 0 Then iLocation = %HKEY_CURRENT_USER
              '
              If RegOpenKeyEx(iLocation, Trim$(sSubKeys, "\"), 0, %KEY_READ, hKey) = %ERROR_SUCCESS Then
                If RegQueryValueEx(hKey, ByCopy sValueName, 0, %REG_SZ, zRegVal, %BUFFER_LEN) _
                             <> %ERROR_SUCCESS Then GoTo RegStringDefault:
              Else
                RegStringDefault:
                zRegVal = sDefault
              End If
              '
              If hKey Then RegCloseKey hKey
              '
              Function = zRegVal
          End Function'
          ' *******************************************************
          '                                                                '
          Sub LogIt(s As String)                                          '
              s = s + $CrLf    
              ptf Time$ & "   " & s$                                           '
              gsResults = gsResults + s                                   '
          End Sub                                                     '
          '
          '
          ' *******************************************************
          '
           'http://www.powerbasic.com/support/pbforums/showthread.php?t=40472
           'Mik Doty
          Function Sleeper(milliseconds As Dword) As Long
             Local hThread As Dword
             If Len(Command$) Then                'override passed value
               milliseconds = Abs(Val(Command$))  'use value in COMMAND$
             End If
            Thread Create TimedMessageBoxThread(milliseconds) To hThread
             Sleep 50
            WaitForSingleObject hThread, milliseconds
            Thread Close hThread To hThread
          End Function
          '
          Thread Function TimedMessageBoxThread(ByVal milliseconds As Dword) As Long
           #If %Def(%Pb_Cc32)
            ? "Press ENTER to continue or WAIT" + Using$(".# Seconds", milliseconds / 1000) 
            WAITKEY$
           #Else             
          '    Local hWin2 As Dword
          '    Local col, row, wdth, hght As Long
          '    Local Tit  As String 
          ''    
          '   Desktop Get Size To Wdth, hght&
          '    Col = 10 
          '    Row = hght - 300'get above other graphic window
          '    'reset title$
          '     Tit$ = Space$(Wdth \ 5) 'seems to work okay for 1024 width
          '     
          '    CSet Tit$ = g_Title$ '& Using$(" - - Press a key or wait .# Seconds - -", MilliSeconds / 1000) 
          '    Graphic Window Tit$, Col, Row, wdth - 20, 15 To hWin2
          '    Graphic Attach hWin2, 0 
          '    Graphic WAITKEY$ To G_Inky
          '    Graphic Window End  
          ''  ? "Click OK to continue or WAIT" + Str$(milliseconds) + " milliseconds"', %MB_SYSTEMMODAL, "Waiting on you"
           #EndIf
          End Function    
          '
          ' *******************************************************
          '
          '
          ============================================
          "In any contest between power and patience,
          bet on patience."
          W.B. Prescott
          ============================================
          Last edited by Gösta H. Lovgren-2; 6 Jul 2009, 09:54 PM.
          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/

          Comment


          • #25
            Username/password in clear text?
            Code:
             Function Pop3Connect (Pop3Host As String, User As String, password As String) As Long

            Comment


            • #26
              ??? 10 years and just noticing that a non-secure protocol does not encrypt user name and password???

              Use a newer protocol.
              Dale

              Comment


              • #27
                What makes you believe POP3 isn't secure if it uses TLS?
                I am questioning the security of the connection in this thread, not POP3.

                There are other email checkers on this site using non-secure connections.
                Hoping everyone knows they are transmitting there user name and password in clear text.

                Comment


                • #28
                  Because POP3 is not secure PERIOD.

                  TLS is another protocol to go THROUGH to secure the entire transaction.

                  You said username and password are sent in clear text then showed code to call a POP3 connection. In the clear is the only way for POP3. If security is added it must be transparent to the client and server.

                  Select a secured server for your e-mail and non-secure clients simply will not connect.

                  IMO this should have been left in the grave.
                  Dale

                  Comment

                  Working...
                  X