Announcement

Collapse
No announcement yet.

Email checker in Source Code forum

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

  • Email checker in Source Code forum

    I have been playing around with the Email Checker code Mel posted:
    PowerBASIC and related source code. Please do not post questions or discussions, just source code.

    and have run up against a puzzler:

    Code:
         ' Ask to execute mail client
         Local disp$, i&, sptr As Asciiz Ptr
         disp$ = Using$("#, Messages in your in-box: ", Num_Msgs)
          i = InStr(-1, zMailClient, "\") 'strip location
           disp$ = disp$ & Mid$(zMailClient, i + 1) 'add to display$
           disp$ = disp$ & $CrLf & $CrLf & "Run the default mail client now?" 
           disp$ = disp$ & Chr$(0) ' expects zstring
            sptr =  StrPtr(Disp$) 'tried pointer but no good either
     
    '      If MessageBox(0, disp$, _ '[COLOR=red][B]<<< Yields 480 "Parameter Mismatch Error"[/B][/COLOR]
    '                      "MainClientFinder", %MB_ICONQUESTION Or %MB_YESNO) = %IDYES Then
     
          If MessageBox(0, "test", _ [B][COLOR=red]'<<< Works[/COLOR][/B]
                          "MainClientFinder", %MB_ICONQUESTION Or %MB_YESNO) = %IDYES Then
     
      '[B][COLOR=red]```````````` Also works (original code)[/COLOR][/B]
    '    If MessageBox(0, "Messages in your in-box: " + zMailClient + $CrLf + $CrLf + "Run the default mail client now?", _
    '                     "MainClientFinder", %MB_ICONQUESTION Or %MB_YESNO) = %IDYES Then
    '
    Why does the second MessageBox work but not the first? Do I have another Dell XPS "anomaly"? Or am I doing something really really stupid (remote but not outside the realm of possibility in this modern world of Real Men {grin}).

    =========================================
    "He who loses money, loses much;
    He, who loses a friend, loses much more;
    He, who loses faith, loses all."
    Eleanor Roosevelt
    =========================================
    Last edited by Gösta H. Lovgren-2; 28 Apr 2009, 09:16 PM.
    It's a pretty day. I hope you enjoy it.

    Gösta

    JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
    LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

  • #2
    Have you tried converting "disp$" to a regular string instead of an ASCIIZ?

    I mean if "test" string works and disp$ doesn't....
    There are no atheists in a fox hole or the morning of a math test.
    If my flag offends you, I'll help you pack.

    Comment


    • #3
      Hi Gösta,

      Try
      Code:
      If MessageBox(0, [B][COLOR="Red"]BYCOPY[/COLOR][/B] disp$, _ 
                            "MainClientFinder", %MB_ICONQUESTION Or %MB_YESNO) = %IDYES Then

      Added:
      Actually, this works too:
      Code:
      If MessageBox(0,  (disp$), _ 
                            "MainClientFinder", %MB_ICONQUESTION Or %MB_YESNO) = %IDYES Then
      See the help file under "CALL statement" to see why.

      Regards,

      Pete.
      Last edited by Peter Jinks; 28 Apr 2009, 11:05 PM.

      Comment


      • #4
        Mel, I tried both ways (Disp$ & chr$(0) -Asciiz or not) and it made no difference. The WinApi said it was looking for a pointer to a string, so I even tried that but no dice. (Probably sintax (spelling intended) on my end) (later - it was, see below)

        Peter thanks the advice to look in PB Help for Call but it really wasn't clear to me what was wrong with my code, even after reading the Help (which I must conferss hadn't occurred to me before, just naturally presuming it was obviously my error).

        Here's also what works or not:
        Code:
              If MessageBox(0, disp$, _ '<<< [COLOR=red]Yields 480 "Parameter Mismatch Error[/COLOR]"
        '
        '
              If MessageBox(0, " " & disp$, _ '<<< [COLOR=red]Works with Quotes in front[/COLOR]
        '
        '
              If MessageBox(0, @sptr , _ '<<< [COLOR=red]Works with pointer variable[/COLOR]
        So my conclusion is that when Windows sees a " (quote mark) it converts it to a pointer internally if it is expecting a pointer. I didn't see that (or it didn't "register" with me) in either the PB Help or the WinApi Help.

        Thanks guys. Now on to conquering more of the Email Retrieval world. Thanks the "stimulus", Mel.

        =======================================
        “Time is very slow for those who wait,
        very fast for those who are scared,
        very long for those who lament,
        very short for those who celebrate.
        But, for those who love,
        time is eternity"
        William Shakespeare
        =======================================
        It's a pretty day. I hope you enjoy it.

        Gösta

        JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
        LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

        Comment


        • #5
          Originally posted by Gösta H. Lovgren-2 View Post
          Thanks the "stimulus", Mel.
          Not a problem, Gosta. Looking forward to seeing your results.

          Idle curosity: Have you replaced my "notify" routine?
          There are no atheists in a fox hole or the morning of a math test.
          If my flag offends you, I'll help you pack.

          Comment


          • #6
            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?
            Am "planning" on keeping the Euro siren (if that's what you mean). What I'd like to do eventually (why "planning" is in quotes, Best laid plans of mice and Real men and all that) and converting it to a PBWin (DDT) gui. What I'd like to do is be able is read the mail on the server and have the prog delete/filter certain stuff from the server before my email client even reads it based on some "rules" I set up.

            I get a slug of unwanted email every day that doesn't get filtered by my junk filters for one reason or another (not important why here) and if I could delete it beforehand it would be nice, neat, cool, ...

            Nothing earthshaking, just an exercise to fend off a bored (boring?) old man's ennui.

            =============================
            "Vote early and vote often."
            Al Capone (1899-1947)
            =============================
            Last edited by Gösta H. Lovgren-2; 29 Apr 2009, 01:17 PM. Reason: accuracy in reporting
            It's a pretty day. I hope you enjoy it.

            Gösta

            JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
            LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

            Comment


            • #7
              So my conclusion is that when Windows sees a " (quote mark) it converts it to a pointer internally if it is expecting a pointer. I didn't see that (or it didn't "register" with me) in either the PB Help or the WinApi Help.
              Windows never sees a quote mark.

              PowerBASIC does that.

              When you pass a string literal as a parameter, the compiler will convert the literal to the correct type... either ASCIIZ or OLE (dynamic) string depending on what the called procedure wants.

              When you pass a dynamic string variable ("disp$") to a function (Messagebox) which wants an ASCIIZ parameter in that position... it is, yes, a '480 parameter type mismatch' error.

              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
              Michael Mattias
              Tal Systems (retired)
              Port Washington WI USA
              [email protected]
              http://www.talsystems.com

              Comment


              • #8
                Originally posted by Michael Mattias View Post
                Windows never sees a quote mark.

                PowerBASIC does that.

                When you pass a string literal as a parameter, the compiler will convert the literal to the correct type... either ASCIIZ or OLE (dynamic) string depending on what the called procedure wants.

                When you pass a dynamic string variable ("disp$") to a function (Messagebox) which wants an ASCIIZ parameter in that position... it is, yes, a '480 parameter type mismatch' error.

                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
                Thank you for the clarification, M. However in my simple mind, I will still consaider a starting " as a harken to Windows (or PB or whoever) to "convert" it to a pointer to the rest of the string in question. (a pointer is called for in that position according the WinApi help/docs). It may not be literally correct but serves my purposes for understanding (at least better than your explanation.) Simple answers for simple minds and all that.

                Not questioning your interpretation (Who would dare that, really?), only that there is more than one way of understanding the world we live in. 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 is time I stepped aside
                for a less experienced and less able man."
                Professor Scott Elledge on his retirement from Cornell
                ========================================================
                It's a pretty day. I hope you enjoy it.

                Gösta

                JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                Comment


                • #9
                  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.

                  Comment


                  • #10
                    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
                    Michael Mattias
                    Tal Systems (retired)
                    Port Washington WI USA
                    [email protected]
                    http://www.talsystems.com

                    Comment


                    • #11
                      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.)
                      ===============================================
                      It's a pretty day. I hope you enjoy it.

                      Gösta

                      JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                      LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                      Comment


                      • #12
                        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.
                        It's a pretty day. I hope you enjoy it.

                        Gösta

                        JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                        LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                        Comment


                        • #13
                          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.

                          Comment


                          • #14
                            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
                            Michael Mattias
                            Tal Systems (retired)
                            Port Washington WI USA
                            [email protected]
                            http://www.talsystems.com

                            Comment


                            • #15
                              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.
                              It's a pretty day. I hope you enjoy it.

                              Gösta

                              JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                              LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                              Comment


                              • #16
                                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

                                Comment


                                • #17
                                  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.
                                  It's a pretty day. I hope you enjoy it.

                                  Gösta

                                  JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                                  LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                                  Comment


                                  • #18
                                    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.
                                    It's a pretty day. I hope you enjoy it.

                                    Gösta

                                    JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                                    LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                                    Comment


                                    • #19
                                      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.
                                      It's a pretty day. I hope you enjoy it.

                                      Gösta

                                      JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                                      LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                                      Comment


                                      • #20
                                        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
                                        ===========================================================
                                        It's a pretty day. I hope you enjoy it.

                                        Gösta

                                        JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                                        LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                                        Comment

                                        Working...
                                        X