Announcement

Collapse
No announcement yet.

Email checker in Source Code forum

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

  • Dale Yarker
    replied
    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.

    Leave a comment:


  • Mike Doty
    replied
    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.

    Leave a comment:


  • Dale Yarker
    replied
    ??? 10 years and just noticing that a non-secure protocol does not encrypt user name and password???

    Use a newer protocol.

    Leave a comment:


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

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    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.

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    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
    ==============================

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    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}

    Leave a comment:


  • Mel Bishop
    replied
    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.

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    Been playing around a little more and added a "Loud" Message Box and an Inkey routine. Cleaned up the code a little. The .exe link above has been updated (for my secret admirer).

    Sorry, Mel, the but euro_siren bit the dust.

    '
    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 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 * 50 'for Graphic window
    Global hdlg As Dword                   
    Global My_Filters$(), Bummers$()
    '
    %BUFFER_LEN = 1024          '
    '
    ' *******************************************************
    '
    Macro Graphic_Inkey
    NOYN10:
       Graphic Inkey$ To Msg$
         If msg$ ="" Then  GoTo NOYN10 'keep waiting for answer
    End Macro
    '     
    Macro Graphic_Window_Setup
        Local hfont As Dword 'just needed for setup
        Local col, row, wdth, hght As Long
     
       Desktop Get Size To Wdth, hght&
        Col = 10 '(Wdth \ 4)
        Row = hght - 200'    (Hght \ 2) - 8           
        'reset title$
        Title$ = " -  -  -  -  -  -  -  -  -  -  - " & Title$ & " -  -  -  -  -  -  -  -  - " 
        Graphic Window Title$, 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 (10, 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
    '
    ' *******************************************************
    '
    Macro Get_Initialization_Stuff
      Local fnum, hTCP, Result, NumberOfMessages, MsgSize As Long         '
      Local tmr As Dword
      
        fi$ = "checkmail.ini"                                       '
        te$ = Dir$(fi$)
                                                     '
        If te$ = "" Then 
          WinBeep 500, 1000 
          ?"error",, "No .Ini file"
          ptf "error",, "No .Ini file"
           Exit Function                       '
        End If                                  
                                                                    '
        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(Num_Msgs As Long)
     Local Msg_Number, ctr, i As Long
     Local msg, s, buffer As String
     Local hTcp  As Long
       hTCP = Pop3Connect(sPop3Host, sUser, sPassword) ''Establish connection to server
     
      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
    '    
        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, 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"
             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)                                    '  |
        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(NumberOfMessages As Long)
      Local tmr As Long
           tmr = Timer
           Call Retrieve_Messages(NumberOfMessages)
           gsResults = gsResults & $CrLf & _
                       Using$(" Took #, seconds", Timer - tmr)
           ptf
           ptf gsResults  
           msg1$ = "Revving up email client": Graphic_Display_Msg
           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 
    '
       Title$ = "Checking for Pesky Email": Graphic_Window_Setup
       msg1$ = "Starting Now": Graphic_Display_Msg
    '
      Get_Initialization_Stuff 'UserName, etc.
    '
      hTCP = Pop3Connect(sPop3Host, sUser, sPassword) 'connecting
    '
       Pop_Account_reached 'returns email stats from server
    '          
      If NumberOfMessages > 0 Then                
         Call Messages_Waiting(NumberOfMessages) 'Does filter thing and launches email program        
        Else
         msg1$ = "No new Messages": Graphic_Display_Msg
         Graphic_Inkey
      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                                             '
        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                                                      '
        Tcp Print nTCP, "USER " + User                              '
        Tcp Line nTCP, Buffer                                       '
        If Left$(Buffer, 3) <> "+OK" Then                           '
            LstErr = "Bad mail user name"                           '
            Error 152                                               '
        End If                                                      '
        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                                                     '
    '
    '
    ===========================================================
    "The mistakes are all waiting to be made."
    chessmaster Savielly Grigorievitch Tartakower (1887-1956)
    on the game's opening position
    ===========================================================

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    Someone using PBWin 7 asked for the exe, so here it is attached.

    Opps a problem uploading so see here:

    http://www.SwedesDock.com/powerbasic...il_Checker.exe (shows truncated)

    (SwedesDock.com/powerbasic/z_Email_Checker.exe)


    =============================================
    "You can only find truth with logic
    if you have already found truth without it."
    Gilbert Keith Chesterton (1874-1936)
    =============================================
    Last edited by Gösta H. Lovgren-2; 3 May 2009, 08:39 AM.

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    Originally posted by Mel Bishop View Post
    Not a problem, Gosta. Looking forward to seeing your results.
    Here tis Mel:
    '
    Code:
    ' Program checks to see if there are Messages waiting and if so
    ' 1) it checks the messages against a Filter list of of unwanteds and deletes same
    ' 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:
    ' Example file: (don't include remarks or spaces)       
    '     mail.Exit109.com 'mail server
    '     REAL_Man         'User 
    '     YoullNeverGuess  'Password
    '     yes              'Use audio alert
    '     1                'Minutes to wait between checking      
    ' Note the last two items are artifacts and not really used now
    ' 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)
    '
    ' *******************************************************
    
    
    '
    ' Program doesn't do a lot of error checking so that's on you {sad but true}
    '
    ' *******************************************************
    '
    '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"
    '
    Global gsResults, s, te, fi, sPop3Host, sUser, sPassword As String   'just easier to make global for now                '
    '
    %BUFFER_LEN = 1024          '
    '
    Global hTracking As Long 'for tracking file 
    '
    Macro ptf =  Print #hTracking,  'labor saver
    '
    Global Euro As String 'for alert                                        '
    Global tLoop As Single 'used in retrieval                                       '
    Global hdlg As Dword                   
    Global My_Filters$()
    '                                                    '
    Sub EuroSiren(Number As Long)
        Local x As Long
        For x = 1 To number
          winbeep  500,300
          winbeep 1000,300
        Next x
    End Sub
    '
    ' 
    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
    '
    Macro Get_Initialization_Stuff
      Local fnum, hTCP, Result, NumberOfMessages, MsgSize As Long         '
      Local tmr As Dword
     
        fi$ = "checkmail.ini"                                       '
        te$ = Dir$(fi$)
                                                     '
        If te$ = "" Then 
          WinBeep 500, 1000 
          ?"error",, "No .Ini file"
          ptf "error",, "No .Ini file"
           Exit Function                       '
        End If                                  
                                                                    '
        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$," ")                                '
                                                                    '
        Line Input #fnum,te$                                           '
        Euro = Remove$(te$," ")                                     ' EuroSiren notification
        Euro = UCase$(euro)                                         ' How many times to cycle
                                                                    ' thru the hi/lo tones.
        Line Input #fnum,te$                                           '
        tLoop = Val(te$) * 60                                       ' Convert minutes to seconds
                                                                    '
        Close #fnum                                                    ' On or Off. Toggle with F-2
      EuroSiren(1) 'alert
        s$ = fi$ & $CrLf & "          ISP: " & sPop3Host & $CrLf  & _                           ' parameters.
             "      User ID: " & sUser & $CrLf      & _                          '
        "     Password: " & sPassWord & $CrLf  & _                          '
        "         Euro: " & Euro & $CrLf      & _                            '
        "Loop Interval: " & te$ & " minutes."                     '
        ptf s$
    '
      Call Retrieve_Filter_Array
    '  
       ptf Time$ & " Starting email check"
    End Macro                                                                ' function key.
    '  
    '
    ' *******************************************************
    ' 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(Num_Msgs As Long)
     Local Msg_Number, ctr, i As Long
     Local msg, s, buffer As String
     Local hTcp  As Long
       hTCP = Pop3Connect(sPop3Host, sUser, sPassword) ''Establish connection to server
      ptf Using$("#, Messages", Num_Msgs) & "********** Starting ************" & $CrLf 
       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
    '    
        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
    '
          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"
             Incr ctr
          End If
     Loop  'get next msg
    Close_Retrieve:
      Pop3Quit(hTcp)
      ptf $CrLf & "************ Closed ************"
      ptf Using$("Found #, bummers", ctr)
    End Sub 
    '
    ' *******************************************************
    '
    Function Filter_Magic(m As String) As Long
      Local flag, ctr As Long  
      Local f As String
         'check "globally"
      For ctr = 1 To UBound(My_Filters$())
        Flag = Flag + InStr(m$, My_Filters$(ctr))
      Next ctr
       'now check for specifics
      f$ = "AIT Web Server <[EMAIL="[email protected]"][email protected][/EMAIL]>"
      If InStr(m$, f$) Then
         'now check for spam senders
      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)                                    '  |
        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(NumberOfMessages As Long)
      Local tmr As Long
           tmr = Timer
           Call Retrieve_Messages(NumberOfMessages)
           gsResults = gsResults & $CrLf & _
                       Using$(" Took #, seconds", Timer - tmr)
           ptf
           ptf gsResults  
           Bring_Up_Default_Email_Client
    End Sub
    '
    ' *******************************************************
    '
    Function PBMain          
      'If Log 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 
    '
      Get_Initialization_Stuff 'UserName, etc.
    '
      hTCP = Pop3Connect(sPop3Host, sUser, sPassword) 'connecting
    '
       Pop_Account_reached 'returns
    '          
      If NumberOfMessages > 0 Then 
         Call Messages_Waiting(NumberOfMessages)         
         Else
          ? "No new Messages",, Exe.Full$
      End If                                                      '  |
    End Function 'Applikation beenden                     
    '
    ' *******************************************************
    '
    ' 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                                             '
        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                                                      '
        Tcp Print nTCP, "USER " + User                              '
        Tcp Line nTCP, Buffer                                       '
        If Left$(Buffer, 3) <> "+OK" Then                           '
            LstErr = "Bad mail user name"                           '
            Error 152                                               '
        End If                                                      '
        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                                                     '
    '
    '
    Looks choppy (at least 3 or 4 different coding styles) but works fine (thoroughly tested {yeah right} by a real man {grin})

    ================================================
    "A single, seemingly powerless person who dares
    to cry out the word of truth
    and to stand behind it
    with all of his person and all of his life,
    ready to pay a high price, has, surprisingly,
    greater power, though formally disenfranchised,
    than do thousands of anonymous voters."
    Vaclav Havel
    ================================================
    Last edited by Gösta H. Lovgren-2; 3 May 2009, 08:25 AM.

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    Thanks John. Works a treat now. Here's what I'm doing. (Note "ptf" prints to a tracking file which makes the whole world go around easier.)

    Note also this gets the entire message (headers & body) which suits my purposes.
    Code:
    '
    Sub Filter_Setup
      Local ctr As Long
      Local f As String
      f$ = "Is this cad here?": GoSub Add_to_Array
      f$ = "Is this bounder here?": GoSub Add_to_Array
      f$ = "Is this bad guy here?": GoSub Add_to_Array
     Exit Sub
     
    Add_To_Array:
      Incr ctr
       ReDim Preserve My_Filters$(1 To ctr)
        My_Filters$(ctr) = f$
     Return   
    End Sub
    '
    '
    Sub Retrieve_Messages(Num_Msgs As Long, Msg_Pile As Long)
     Local Msg_Number, ctr, i As Long
     Local msg, s, buffer As String
     Local hTcp  As Long
       hTCP = Pop3Connect(sPop3Host, sUser, sPassword) ''Establish connection to server
      ptf "********** Starting ************" & $CrLf 
       Call  Filter_Setup '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
    '    
        Tcp Print hTCP, "RETR" + Str$(Msg_Number)
        Tcp Line hTCP, Buffer$
       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
          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 "XXXXXXXXXXXXXXXXXXXX Deleted XXXXXXXXXXXXXXXXXXXXXXXX"
             Incr ctr
          End If
     Loop
    Close_Retrieve:
      Pop3Quit(hTcp)
      ptf $CrLf & "************ Closed ************"
      ptf Using$("Found #, bummers", ctr)
      EuroSiren(4)
    End Sub 
    '
    Function Filter_Magic(m As String) As Long
      Local flag, ctr As Long
     
      For ctr = 1 To UBound(My_Filters$())
        Flag = Flag + InStr(m$, My_Filters$(ctr))
      Next ctr
      Function = flag 'got a match
    End Function  
    '
    When I get things cleaned up, I'll post the complete PBWin code for any who are interested.

    ============================================
    "The optimist proclaims that
    we live in the best of all possible worlds.
    The pessimist fears this is true."
    James Branch Cabell
    ============================================
    Last edited by Gösta H. Lovgren-2; 2 May 2009, 01:48 PM.

    Leave a comment:


  • John Petty
    replied
    Gosta
    Here is the bulk of the code of a DLL I use. I have just removed the sections that relate to the clients app, it will give you the order of actions.
    Code:
    #COMPILE DLL
    #DIM ALL
    
    GLOBAL MDet() AS MailDetails
    GLOBAL LstErr AS STRING
    
    
    '------------------------------------------------------------------------------
    ' Connect to POP3 mail server.
    '
    FUNCTION Pop3Connect (Pop3Host AS STRING, USER AS STRING, _
                          password AS STRING) AS LONG
    
        LOCAL nTCP   AS LONG
        LOCAL Buffer AS STRING
    
        ON ERROR GOTO Pop3Error
        LstErr = "Error opening POP3 server"
        nTCP = FREEFILE
    
        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
    
        TCP PRINT nTCP, "USER " + USER
        TCP LINE nTCP, Buffer
        IF LEFT$(Buffer, 3) <> "+OK" THEN
            LstErr = "Bad mail user name"
            ERROR 152
        END IF
    
        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
        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
    
        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
    
    
    '-----------------------------------------------------------------------------
    ' Retrieve a message from a POP3 server
    '
    FUNCTION Pop3RetrMessage (BYVAL nTCP AS LONG, BYVAL MsgNumber AS LONG, _
                             Msg() AS STRING) AS LONG
    
        LOCAL x      AS LONG
        LOCAL Buffer AS STRING
        LstErr = "Error retrieving Message"
        ON ERROR GOTO Pop3RetrErr
    
        REDIM Msg(1 TO 100) AS STRING
    
        TCP PRINT nTCP, "RETR" + STR$(MsgNumber)
        TCP LINE nTCP, Buffer
    
        IF LEFT$(Buffer, 3) <> "+OK" THEN
            ERROR 155
        END IF
    
        DO
            TCP LINE nTCP, Buffer
            IF Buffer = "." THEN
                EXIT DO
            END IF
            INCR x
            IF LEFT$(Buffer, 2) = ".." THEN
                Buffer = "." + MID$(Buffer, 3)
            END IF
            IF x > UBOUND(Msg(1)) THEN
                REDIM PRESERVE Msg(1 TO x + 50) AS STRING
            END IF
            Msg(x) = Buffer
        LOOP
        LstErr = ""
    Pop3RetrDone:
        IF x = 0 THEN
            ERASE Msg()
        ELSE
            REDIM PRESERVE Msg(1 TO x) AS STRING
            FUNCTION = x
        END IF
        EXIT FUNCTION
    Pop3RetrErr:
        FUNCTION = -(ERRCLEAR)
    END FUNCTION
    
    FUNCTION GetMail(Pop3Serv AS STRING, MailAcc AS STRING, MailPass AS STRING) EXPORT AS LONG
        LOCAL hTCP AS LONG
        LOCAL ret AS LONG
        LOCAL mcnt AS LONG
        LOCAL msze AS LONG
        LOCAL fo AS LONG
        LOCAL fs AS LONG
        LOCAL a AS LONG
        LOCAL x AS LONG
        LOCAL y AS LONG
        LOCAL z AS LONG
        LOCAL nlnes AS LONG
        LOCAL nfrom AS STRING
        LOCAL nsubject AS STRING
        REDIM msg(0) AS STRING
        LOCAL buffer AS STRING
        REDIM MDet(0)
        hTCP = Pop3Connect (Pop3Serv, MailAcc, MailPass)   'returns tcp handle or negative if error
        IF hTCP < 0 THEN
            FUNCTION = hTCP
            EXIT FUNCTION
        END IF
        ret = Pop3GetStat (hTCP, mcnt, msze)
        IF ret < 0 THEN
            CLOSE hTCP
            FUNCTION = ret
            EXIT FUNCTION
        END IF
        FOR x = 1 TO mcnt
            nlnes = Pop3RetrMessage (hTCP, x, Msg())    ' get the emails on at a time
            IF nlnes < 0 THEN
                LstErr = LstErr + STR$(x)
                EXIT FOR
            END IF
            nfrom = ""
            nsubject = ""
            FOR y = 1 TO nlnes  'get basic header info
                IF TRIM$(msg(y)) = "" THEN EXIT FOR     'blank line indicates the end of the header
                IF LEFT$(msg(y), 5) = "From:" THEN nfrom = TRIM$(RIGHT$(msg(y), LEN(msg(y)) - 5))
                IF LEFT$(msg(y), 8) = "Subject:" THEN
                    nsubject = TRIM$(RIGHT$(msg(y), LEN(msg(y)) - 8))
                END IF
            NEXT
            'do whatever you want to do with the email which is in the array Msg
        NEXT
        IF nlnes < 0 THEN
            CLOSE hTCP
            EXIT FUNCTION
        END IF
        FOR x = 1 TO mcnt   'finished with the email so delete them from the server
            TCP PRINT hTCP,"DELE" + STR$(x)
            TCP LINE hTCP, Buffer
        NEXT
        ret = Pop3Quit (hTCP)
        IF ret < 0 THEN
            FUNCTION = -156
            LstErr = "Error quiting POP3 server"
            EXIT FUNCTION
        ELSE
            FUNCTION = goodmcnt
        END IF
    
    END FUNCTION
    
    FUNCTION GetLstErr() EXPORT AS STRING
        FUNCTION = LstErr
    END FUNCTION
    If you only want to determine if it as email you want to keep then usually replacing the "RETR" command with the "TOP" command so just getting the headers is enough and then only "DELE" the ones you don't want. If you use Outlook then to see more details of typical headers the after opening the email go "View", "Options" and it will show you the headers of the email.
    If you want to display the email, as long as you only display in plain text it is not difficult as even if the sender sent HTML or RTF then it will be repeated in plain text. Nor is it difficult to recover attachments.
    John

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    Thanks the reply, John. Essentially what I have to do then is:
    Code:
    'pseudo
    'Establish connection to server
    ' STAT to get NumMsgs Then
    For ctr = 1 To NumMsgs
        Tcp Print hTcp, "RETR " & Format$(ctr) 'Grab msg
        Num_Bytes_to_Get = 1024 'to start - most to get at one time
     
     'Now Keep adding 1024 until we have the whole msg 
     ' (maybe use Octets to determine msg len and/or num bytes to get)
       Reset Msg$          
      'Bytes_Needed = Octets_Received 'ie from "+OK 1533 octets"  
       Bytes_Needed = Val("&O1533")
     
    Msg_Not_Done:
        Tcp Recv hTcp, Num_Bytes_to_Get, sTmp
        Msg$ = msg$ & stmp
        If Len(msg$) = Bytes_Needed Then 'or instr check for "+OK" or something
           'do filter magic here
           Iterate For  'work on next msg
          Else 
           Num_Bytes_to_Get = Bytes_Needed - Len(Msg$)
           If Num_Bytes_to_Get > 1024 Then 
              Num_Bytes_to_Get = 1024 'most to get at one time
           End If
           GoTo Msg_Not_Done   
        End If
     
    Next ctr                             
        Tcp Print hTcp, "Quit"
        Close Tcp
    Aside from coding technique, those are the steps I have to take, right? Or not? Have zero experience with TCPing. I dont mind chasing my tail just so long as it's in the "right" direction. {obscure pun}


    ==========================
    "Don't be so humble
    you are not that great."
    Golda Meir (1898-1978)
    to a visiting diplomat
    ==========================
    Last edited by Gösta H. Lovgren-2; 1 May 2009, 09:27 PM.

    Leave a comment:


  • Michael Mattias
    replied
    Now experienced real men will read that with no trouble, and automatically understand (assume) as sensible. However simple minds won't when they see a " " (literally quoted string) being accepted in a place where the docs call for a long pointer (LPCTSTR lpText,) but an assigned string is not accepted. This simple mind, at least, finds that confusing.
    BASIC compilers and interpreters have always supported a free interspersing of variables, literals and expressions in both intrinsic functions and external calls.

    Versus, say, COBOL, where you could never reference a table ("array") element with an expression like..
    Code:
     
        MOVE   Z(A +2)  TO X     ' BASIC =   X = Z(A+2)
    Instead, the programmer must reduce the expression "A+2" to elementary statements...
    Code:
       ADD 2 TO A                  <<< numeric literal here OK
       MOVE Z(A)  TO X          <<< expression here not OK
    (Don't even get into string handling. BASIC is far superior to COBOL when it comes to strings)

    The PB compilers see "AS ASCIIZ" or "AS LONG" in the DECLARE statement for an external call, and just convert the literal or expression to that data type for you.

    Then again, when you start using the WinAPI functions in lieu of the provided intrinsics, you are pretty much on your own as far as the compilers are concerned... the compilers' only responsbilities in this case are to ensure the DECLARE and CALL (express or implied) intrinsics "work as advertised." The conversion of literals and expressions in these cases is pretty much a freebee.

    MCM

    Leave a comment:


  • John Petty
    replied
    Gosta
    Yes there are depending on what level of checking you are doing to determine if the email is wanted. When the server returns the number of emails it has then each of those emails can be addressed by their individual count number.
    So if the server says you have 5 emails the you can send a TOP command for each of those numbers ie
    TCP PRINT nTCP, "TOP" + STR$(MsgNumber)
    This will return all the header up to and including the blank line seperating the body and the number of lines in the body (whilst this is an optionally accepted command by POP3 servers in modern practice all accept it).
    You can then do the bulk of normal spam processing such as comparing to black and white list lookups, subject comparison, reverse address lookups etc.
    If your program decides not to accept the email the it deletes it by its number ie
    TCP PRINT hTCP,"DELE" + STR$(MsgNumber)
    of course if you later try to download the email number you will get an ERR response.
    John
    Added Version 3 of RFC 1939 is now a standard and you can find it here http://www.rfc-editor.org/std/std53.txt its quite simple.
    Last edited by John Petty; 1 May 2009, 10:46 AM.

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    Originally posted by Mel Bishop View Post
    Not a problem, Gosta. Looking forward to seeing your results.

    Idle curosity: Have you replaced my "notify" routine?
    Not really gotten to the gui yet, Mel, though I am using PBWin. Results, so far

    Am stuck on retrieving the email. I can get the whole pile from the server okay but it *seems* I'd have to parse out each individual email. Is that right? (using the 'Octets' returned)

    I mean I can do it okay but it seems there should be an easier method. Just thought I would ask before delving into it.

    What I was hoping to be able to use a simple loop, ie
    Code:
    'psuedo
    for ctr = 1 to Num_Msgs
      Get ctr from server
      Check if good email
       If not Good then tell server to delete ctr
    Next ctr
    Here's where I am actually at:

    Code:
    'Note ptf prints to a tracking file
    Sub Retrieve_Messages(Num_Msgs As Long, Msg_Pile As Long)
     Local Msg_length, ctr As Long
     Local msg, buffer, stmp As String
     Local hTcp As Long
       hTCP = Pop3Connect(sPop3Host, sUser, sPassword) 'open it up
      ' Retrieve the page...
      ptf "Starting"
      Do                        
       Incr ctr
    '>>>>>>>>no good    If ctr > Num_Msgs Then Exit Loop 'got 'em all?
        '+OK 1527 octets 'use this value to parse individual emails?
        Tcp Print hTcp, "RETR " & Format$(ctr) 'Grab it all one msg at a time
        Tcp Recv htcp, 4096, stmp$
        ptf Using$("#, ", ctr) & "***got*** " & stmp$ & $CrLf   
        buffer =  Buffer$ & stmp$
         'end of line          
        If InStr(stmp$, "-ERR Message") Then Exit Loop 'exit After adding
        If Len(buffer$) => Msg_Pile Then Exit Loop 'test
     
        Sleep 1
      Loop While IsTrue Len(Buffer$) And IsFalse Err
      '
      ptf buffer$
      ptf "done"           
      euroSiren(4)
     Exit Sub
    '***************************
    'tried this code first from another thread (John P?) but no luck
    For ctr = 1 To Num_Msgs
        ptf  $CrLf  & String$(50, "*") &  $CrLf  'msg separator
        ptf , "Retrieving Message #" & Format$(ctr)
     
     
    '2)  The shotgun method, grab it all
        Tcp Print hTcp, "RETR " & Format$(ctr) 'Grab it all one msg at a time
        Tcp Recv hTcp, 1024,sTmp
        ptf "******* got *********" & $CrLf  & stmp
        If UCase$(Left$(sTmp,4)) = "-ERR" Then
           ptf "******** Error *******" & sTmp
           GoTo DONE
        End If
     
    '3) Delete email from server when done
    '>>>    Tcp Print hTcp, "DELE " & Format$(lLoop) 'Optional, remember if QUIT is not sent they are NOT deleted.
    '>>>    Tcp Recv hTcp, 1024,sTmp
    '  ptf sTmp  'For Debug, fills screen however  
    '   Check for error, if not append sTmp to Buffer for either method of mail retrieval.
        If UCase$(Left$(sTmp,4)) = "-ERR" Then ptf sTmp 'Likely to say -ERR message 2 already deleted
        buffer = buffer & sTmp
        If UCase$(Left$(sTmp,4)) = "-ERR" Then GoTo DONE
    Next ctr     
     
      ptf buffer$ 'everything retrieved
      ptf "****************** All is well *****************"
    Done:
      Tcp Close #hTcp
    End Sub
    I have searched the forums for examples (using "email retrieval", and other terms) but not having much luck. No doubt lots of examples but get too much 'flotsam' to look through and soon either get sidetracked or frustrated/aggravated. If someone could point to one I'd be grateful.

    ========================================
    Admiration is the daughter of ignorance.
    Ben Franklin
    ========================================
    Last edited by Gösta H. Lovgren-2; 30 Apr 2009, 10:43 PM.

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    Originally posted by Michael Mattias View Post

    It's not flaw, but it's not conditioned. If the procedure being called wants an ASCIIZ parameter in that position - as in this particular example
    What the procedure wants (according to WinApi Help) is
    The MessageBox function creates, displays, and operates a message box. The message box contains an application-defined message and title, plus any combination of predefined icons and push buttons.
    int MessageBox(
    HWND hWnd, // handle of owner window
    LPCTSTR lpText, // address of text in message box
    LPCTSTR lpCaption, // address of title of message box
    UINT uType // style of message box
    );

    Parameters
    hWnd
    Identifies the owner window of the message box to be created. If this parameter is NULL, the message box has no owner window.
    lpText
    Points to a null-terminated string containing the message to be displayed.
    lpCaption
    Points to a null-terminated string used for the dialog box title. If this parameter is NULL, the default title Error is used.
    uType
    Specifies a set of bit flags that determine the contents and behavior of the dialog box. This parameter can be a combination of flags from the following groups of flags.
    Specify one of the following flags to indicate the buttons contained in the message box:
    Now experienced real men will read that with no trouble, and automatically understand (assume) as sensible. However simple minds won't when they see a " " (literally quoted string) being accepted in a place where the docs call for a long pointer (LPCTSTR lpText,) but an assigned string is not accepted. This simple mind, at least, finds that confusing.

    ===============================================
    "The concept is interesting and well-formed,
    but in order to earn better than a 'C',
    the idea must be feasible."
    A Yale University management professor
    in response to student Fred Smith's paper
    proposing reliable overnight delivery service
    (Smith went on to found Federal Express Corp.)
    ===============================================

    Leave a comment:


  • Michael Mattias
    replied
    I was more concerned with the passing of string literals than variables, but for variables you are right that BYCOPY is expained in the help file... but that help does not talk at all about passing literals as parameters.

    Just as I now interpret "ByCopy S$" to be the equivalent of a StrPtr variable. (And, of couirse, I now expect you to point out the fatal flaw in that logic.)
    It's not flaw, but it's not conditioned. If the procedure being called wants an ASCIIZ parameter in that position - as in this particular example - the STRPTR analogy is correct... since ASCIIZ strings as passed as the address of the data.

    However, if the called procedure wants a STRING parameter in that position, what will be passed is the VARPTR of a temporary string - a copy of the original if it's "BYCOPY stringvar," or a freshly-created temporary string if it's " quoted_literal"

    Same way the compiler handles numeric literals or expressions: If you call a procedure which expects a numeric parameter...
    Code:
    FUNCTION FOo (X AS LONG|SINGLE|DOUBLE|EXT|CUR|QUAD) ...
    ... you can call it with a numeric literal....
    Code:
       Z = Foo(2)
    .. and the compiler will handle setting up the value "two" in whatever format required for the procedure Foo's parameter.

    MCM

    Leave a comment:


  • Peter Jinks
    replied
    Is my help file unique?

    Using BYCOPY (or parens) at the point of call is almost like using a literal in that the compiler will convert the value of that variable to the proper datatype for the called procedure.

    MCM
    PS: no, that is NOT in the help file, either Windows or PB
    Err... yes it is. In the help for "CALL statement" (as I mentioned earlier in the thread).

    BYCOPY
    ...
    In both cases, a copy of the data is stored in a temporary memory location, and the parameter consists of a 4-byte address of this temporary location. Another way to force BYCOPY is to enclose a variable name in parentheses, so it will appear to the compiler as an expression, rather than just a single variable.
    I really do recommend reading the topic. The quote is from the PBWin 9 help file. I haven't checked previous versions. It can also be viewed online here.

    Regards,

    Pete.

    Leave a comment:

Working...
X