|
|
|||||||
| Source Code PowerBASIC and related source code. Please do not post questions or discussions, just source code. |
 |
|
|
Thread Tools | Display Modes |
|
#1
Apr 24th, 2009, 12:26 PM
|
|||
|
|||
|
E-Mail Checker
Code:
' This program checks your e-mail every x minutes (user definable)
' and if there's something there, offers to bring up your default
' mail program.
'
' Couple of routines I pirated from PB's board:
'
' From: Mike Doty '
' At: http://www.powerbasic.com/support/pbforums/showthread.php?t=40406
'
' From Kev Peel '
' http://www.powerbasic.com/support/pbforums/showthread.php?t=16318
'
' Much obligated.
'
' All you have to do is create a plain text "checkmail.ini" file
' with the following format:
'
' Line #1, Your e-mail host
' Line #2, Your e-mail user name
' Line #3, Your e-mail password
' Line #4, Default notify with an audible alert (ON/OFF) that
' something is there. This can be toggled on/off with
' the F-2 function key.
' Line #5, Time inteval (in minutes) to wait between check loops
'
' This format is pretty ridgid since there's no error/format
' checking, yet.
'
' Works for me here. Hope it works for you there.
'
#COMPILE EXE '
#BREAK ON '
'#CONSOLE OFF ' No place to end it except in
#INCLUDE "win32api.inc" ' Task Manager
GLOBAL gsResults AS STRING '
%BUFFER_LEN = 1024 '
'
'
FUNCTION PBMAIN () AS LONG '
LOCAL sPop3Host, sUser, sPassword AS STRING '
LOCAL hTCP, Result, NumberOfMessages, MsgSize AS LONG '
GLOBAL Euro AS STRING '
GLOBAL tLoop AS SINGLE '
'
LOCAL sResults AS STRING 'optionally display results '
'
fi$ = "checkmail.ini" '
te$ = DIR$(fi$) '
IF te$ = "" THEN BEEP : EXIT FUNCTION '
'
OPEN fi$ FOR INPUT AS #1 '
LINE INPUT #1,te$ ' e-Mail host
sPop3Host = REMOVE$(te$," ") '
'
LINE INPUT #1,te$ ' Your user name
sUser = REMOVE$(te$," ") '
'
LINE INPUT #1,te$ ' Password
sPassWord = REMOVE$(te$," ") '
'
LINE INPUT #1,te$ '
Euro = REMOVE$(te$," ") ' EuroSiren notification
Euro = UCASE$(euro) ' How many times to cycle
' thru the hi/lo tones.
LINE INPUT #1,te$ '
tLoop = VAL(te$) * 60 ' Convert minutes to seconds
'
CLOSE #1 ' On or Off. Toggle with F-2
' function key.
'
CLS ' Briefly display your
PRINT;" ISP: ";sPop3Host ' parameters.
PRINT;" User ID: ";sUser '
PRINT;" Password: ";sPassWord '
PRINT;" Euro: ";Euro '
PRINT;"Loop Interval: ";te$;" minutes." '
delay 3 '
CLS '
'
DO '<-: Master loop.
' |
hTCP = Pop3Connect ( sPop3Host, sUser, sPassword) ' |
IF hTCP > -1 THEN ' |
REM Pop account reached ' |
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 -152: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 ' |
' |
' PRINT;"Results in one string" ' |
' PRINT;gsResults ' |
' PRINT;"Number of messages: " + STR$(NumberOfMessages) ' |
' PRINT" Message size: " + STR$(MsgSize&) ' |
' |
IF NumberOfMessages > 0 THEN ' |
IF Euro = "ON" THEN EuroSiren(2) ' |
BringUpDefault ' |
END IF ' |
' |
delay (tLoop) ' | 5-minute delay between loops
LOOP '<-:
'
WAITKEY$ '
END FUNCTION '
'
SUB LogIt(s AS STRING) '
s = s + $CRLF '
gsResults = gsResults + s '
END SUB '
'
'-------------------------------------------------------------'
' 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 '
'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 '
PRINT;"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 '
'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 '
' http://www.powerbasic.com/support/pbforums/showthread.php?t=16318
' '
'
FUNCTION BringUpDefault 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
ELSE
' Ask to execute mail client
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
ShellExecute 0, "open", zMailClient, "", "", %SW_SHOW
END IF
END IF
END FUNCTION
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 Delay(DelayTime AS SINGLE) '
LOCAL StartTime AS DOUBLE '
LOCAL EndTime AS DOUBLE ' Time to finish
'
StartTime = TIMER '
EndTime = StartTime + DelayTime ' Add the delay.
'
IF EndTime > 86400 THEN '<: Wrap-Around
EndTime = EndTime - 86400 ' | at midnight.
END IF '<:
'
DO UNTIL StartTime => EndTime ' Keep looping until.....
StartTime = TIMER '
an$ = INKEY$ '
IF an$ = CHR$(27) THEN EXIT LOOP '
'
IF an$ = CHR$(0,60) THEN '<-: F2 key to toggle Euro
IF Euro = "ON" THEN '<:|
Euro = "OFF" ' ||
ELSE '<:|
Euro = "ON" ' ||
END IF '<:|
CLS ' |
PRINT;"Euro: ";Euro ' |
END IF '<-:
SLEEP 0 '
LOOP '
END SUB '
'
SUB EuroSiren(Number AS LONG)
LOCAL x AS LONG
FOR x = 1 TO number
winbeep 500,300
winbeep 1000,300
NEXT x
END SUB
__________________
I'm a conservative ditto-head and d*mn proud of it on both counts! 
|
|
#2
Apr 24th, 2009, 05:04 PM
|
|||
|
|||
 Mel, I like your code very much. This is a slightly modified version and is meant only as suggestions. Perhaps another author should not post source code in the same thread? Mel has done some excellent work here. There is no link to a discussion so I just posted code. If this is bad form then I apologize. The delay loop uses about 25% CPU so modified to just use a SLEEP. Used milliseconds instead of seconds. I like the way you looped and will change my gui version. Added a call to PLAY a system wave file. Doesn't launch default email program. Code:
' Create "checkmail.ini"
' Line #1, Your e-mail host
' Line #2, Your e-mail user name
' Line #3, Your e-mail password
' Line #4, Default notify with an audible alert (ON/OFF) that
' something is there. This can be toggled on/off with
' the F-2 function key.
' Line #5, Time inteval (in milliseconds) to wait between check loops tLOOP
#COMPILE EXE
#BREAK ON
'#CONSOLE OFF
#INCLUDE "win32api.inc"
FUNCTION PBMAIN () AS LONG
LOCAL sPop3Host, sUser, sPassword AS STRING
LOCAL hTCP, Result, NumberOfMessages, MsgSize AS LONG, tLoop AS LONG
fi$ = "checkmail.ini"
te$ = DIR$(fi$)
IF te$ = "" THEN BEEP : EXIT FUNCTION
OPEN fi$ FOR INPUT AS #1
LINE INPUT #1,te$
sPop3Host = REMOVE$(te$," ")
LINE INPUT #1,te$
sUser = REMOVE$(te$," ")
LINE INPUT #1,te$
sPassWord = REMOVE$(te$," ")
LINE INPUT #1,te$
LINE INPUT #1,te$
tLoop = VAL(te$)
CLOSE #1 '
PRINT;" ISP: ";sPop3Host
PRINT;" User ID: ";sUser
PRINT;" Password: ";sPassWord
'PRINT;" Euro: ";Euro
PRINT;"Loop Interval: ";te$;" minutes."
DO
? "Checking email"
hTCP = Pop3Connect ( sPop3Host, sUser, sPassword)
IF hTCP > -1 THEN
REM Pop account reached
Result = Pop3GetStat (hTCP&, NumberOfMessages&, MsgSize&)
IF Result = 0 THEN
LogIt "Messages:" + STR$(NumberOfMessages&)
LogIt "Length:" + STR$(MsgSize&)
'modify to whatever sound file
PlaySound("\windows\media\tada.wav", %NULL ,%SND_SYNC)
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 -152: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
? "SLEEP";tLOOP
SLEEP tLOOP
LOOP
END FUNCTION
SUB LogIt(s AS STRING)
's = s + $CRLF
'gsResults = gsResults + s
? s
END SUB '
' 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 '
'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 '
PRINT;"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 '
'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]
Last edited by Mike Doty; Apr 25th, 2009 at 05:47 AM. Reason: Apologize if suggestion code by another author is not good form.
|
|
#3
Apr 24th, 2009, 10:40 PM
|
|||
|
|||
|
You don't like my notify routine???? Yarrrggggg!!! Dagger through the heart!!!!
 You gotta admit tho', it DO get'cher attention.
__________________
I'm a conservative ditto-head and d*mn proud of it on both counts!
|
|
#4
Apr 25th, 2009, 08:30 AM
|
|||
|
|||
|
Not to use the Source Code Forum for discussion but...
> Perhaps another author should not post source code in the same thread? Perhaps this is exactly where "version 2" of someone's work should go.... as a 'reply' to the original. A. It puts all like versions together so others can find B. It shows how applications can grow when Real Users get their hands on "version 1.0"
|
|
#5
Apr 25th, 2009, 09:10 AM
|
|||
|
|||
|
Mike PM'd me with an apology if his response was inappropriate. Apparently, he misunderstood the meaning and intent of my reply.
I PM'd back that I was only jerking his chain and to go ahead and post any improvements in the same thread. That's what this board is about anyway. However, let's move any further DISCUSSION to the CC or Cafe forum, what say.
__________________
I'm a conservative ditto-head and d*mn proud of it on both counts! Last edited by Mel Bishop; Apr 25th, 2009 at 09:17 AM.
|
|
#6
Dec 12th, 2009, 02:15 PM
|
|||
|
|||
|
Update to the mail checker
For a LONG time, I was not really that happy with my 'notify' routine.
Well....Replace EuroSiren with this: Code:
SUB EuroSiren(Number AS LONG) '
LOCAL x AS LONG '
text2speech
'
' FOR x = 1 TO number '
' winbeep 500,300 '
' winbeep 1000,300 '
' NEXT x '
'
END SUB '
REM *********************************************************************
REM * Stolen from Jose Roca's example at: *
REM * http://www.powerbasic.com/support/pbforums/showthread.php?t=21931 *
REM * Post #5 *
REM *********************************************************************
SUB text2speech
LOCAL oSp AS DISPATCH
SET oSp = NEW DISPATCH IN "SAPI.SpVoice"
IF ISFALSE ISOBJECT(oSp) THEN EXIT SUB
LOCAL vRes AS VARIANT
LOCAL vTxt AS VARIANT
LOCAL vTime AS VARIANT
vTxt = "You have mail in your in-box."
OBJECT CALL oSp.Speak(vTxt) TO vRes
vTime = -1 AS LONG
OBJECT CALL oSp.WaitUntilDone(vTime) TO vRes
END SUB
This works great in w7 without adding any windows festures. Would greatly appreciate other O/S's feed-back in the CC or programming forum.
__________________
I'm a conservative ditto-head and d*mn proud of it on both counts! Last edited by Mel Bishop; Dec 12th, 2009 at 02:17 PM.
|
|
#7
Dec 12th, 2009, 03:18 PM
|
|||
|
|||
|
Code:
REM Great code!
CALL text2speech(CB.HNDL)
SUB text2speech(hdlg AS DWORD)
LOCAL hThread AS DWORD
THREAD CREATE TalkThread(0) TO hThread
SLEEP 50
THREAD CLOSE hThread TO hThread
END SUB
THREAD FUNCTION TalkThread(BYVAL dummy AS DWORD) AS DWORD
LOCAL oSp AS DISPATCH
SET oSp = NEW DISPATCH IN "SAPI.SpVoice"
IF ISFALSE ISOBJECT(oSp) THEN EXIT FUNCTION
LOCAL vRes AS VARIANT
LOCAL vTxt AS VARIANT
LOCAL vTime AS VARIANT
vTxt = "welcome,end of file, thanks, thank you, havvve a good 1
OBJECT CALL oSp.Speak(vTxt) TO vRes
vTime = -1 AS LONG
OBJECT CALL oSp.WaitUntilDone(vTime) TO vRes
END FUNCTION
Last edited by Mike Doty; Dec 12th, 2009 at 09:22 PM.
|
|
#8
Dec 13th, 2009, 03:05 AM
|
|||
|
|||
|
Pass text to thread without global variable
'
Code:
'Syntax: Text2Speech(sText AS STRING)
'
'Each passed value is spoken in a new thread
'
'Credits:
'Jose Roca SAPI
'http://www.powerbasic.com/support/pbforums/showthread.php?t=21931
'
'Mel Bishop talking email checker
'http://www.powerbasic.com/support/pbforums/showthread.php?t=40417
FUNCTION PBMAIN& 'Text2Speech.Bas
LOCAL s AS STRING,counter AS LONG
counter = 0
DO
INCR counter
s = "Number " + STR$(counter) 'extra space for negative sign
s = INPUTBOX$("Thread count" + STR$(THREADCOUNT),"Text2Speech",s)
IF LEN(s) = 0 THEN EXIT DO
's = "You typed " + s + " at " + Time$ + " active threads" + STR$(ThreadCount)
text2speech s
s = ""
LOOP
IF THREADCOUNT > 1 THEN
text2speech STR$(THREADCOUNT) + " threads are still running at" + TIME$ '+ ", thank you Jose Roca and Mel Bishop, Mike Doty"
END IF
DO UNTIL THREADCOUNT =1:SLEEP 500:LOOP
text2speech "Threads ended, so program will now end, thank you"
SLEEP 5000
END FUNCTION
'-----------------------------------------------------------------
SUB text2speech(s AS STRING)
'Talk in background without any globals
IF LEN(s) = 0 THEN EXIT SUB
LOCAL hThread AS DWORD
LOCAL StringAddress AS DWORD
StringAddress = VARPTR(s)
THREAD CREATE TalkThread(StringAddress) TO hThread
IF hThread = 0 THEN ? "Error creating thread"
SLEEP 150
THREAD CLOSE hThread TO hThread
END SUB
'-----------------------------------------------------------------
THREAD FUNCTION TalkThread(BYVAL StringAddress AS DWORD) AS DWORD
LOCAL p AS STRING POINTER
p = StringAddress
LOCAL oSp AS DISPATCH
SET oSp = NEW DISPATCH IN "SAPI.SpVoice"
IF ISFALSE ISOBJECT(oSp) THEN EXIT FUNCTION
LOCAL vRes AS VARIANT
LOCAL vTxt AS VARIANT
LOCAL vTime AS VARIANT
vTxt = @p
OBJECT CALL oSp.Speak(vTxt) TO vRes
vTime = -1 AS LONG
OBJECT CALL oSp.WaitUntilDone(vTime) TO vRes
END FUNCTION
'
Last edited by Mike Doty; Dec 13th, 2009 at 03:09 AM. Reason: Added SLEEP 5000 so final message is spoken before thread finishes.
|
|
| Thread Tools | |
| Display Modes | |
|
|
Linear Mode
