
Thanks to Borjes code snippets and tips I have been able to put some code
together that is able to send long mails in Eudora, Outlook Express (!) and
Netscape Messenger.
I have not been able to test with MS Outlook because I don't have it.
Could someone of you who does have MS Outlook please test this program to see if it
works??
This program should open your default mail client, create a new mail and put
some (long) text in the body of the mail...
I would appreciate it if someone could test it with MS Outlook.
Kind regards
Eddy
Code:
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' Demo of SendMyMail function that handles long body text in mail, ' since ShellExecute can fail if text is too long (like > 1.4 KB..) ' Ttested with Eudora 5.0, Outloop Express and Netscape Messenger. ' Based on code of Borje Hagsten, Sept 2001 '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ #COMPILE EXE #INCLUDE "WIN32API.INC" '%DEBUGMODE = 1 'Thanks to Gregery d Engle for his debugger '#INCLUDE "DEBUGDLL.INC GLOBAL gsSubject AS STRING GLOBAL IDString AS STRING GLOBAL MailDone AS LONG DECLARE CALLBACK FUNCTION DlgProc() AS LONG DECLARE FUNCTION EnumWindowsProc(BYVAL hWnd AS LONG, BYVAL lParam AS LONG) AS LONG DECLARE FUNCTION ClipboardPutText (BYVAL txt AS STRING) AS LONG DECLARE FUNCTION SendMyMail(BYVAL hDlg AS LONG, _ BYVAL mailTo AS STRING, _ BYVAL subject AS STRING, _ BYVAL bodyText AS STRING) AS LONG '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' Main entrance '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ FUNCTION PBMAIN () AS LONG LOCAL hDlg AS LONG IDString = "Eddy" DIALOG NEW 0, "Long mail test..",,, 130, 30, %WS_CAPTION OR %WS_SYSMENU, 0 TO hDlg CONTROL ADD BUTTON, hDlg, %IDOK, "&SEND MAIL", 4, 4, 60, 14 CONTROL ADD BUTTON, hDlg, %IDCANCEL, "&CANCEL", 64, 4, 60, 14 DIALOG SHOW MODAL hDlg CALL DlgProc END FUNCTION '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' Main dialog's callback procedure '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ CALLBACK FUNCTION DlgProc() AS LONG DIM i AS LONG IF CBMSG = %WM_COMMAND THEN IF CBCTL = %IDOK THEN LOCAL sTxt AS STRING sTxt = "" 'Fabricate some long text FOR i = 1 TO 1000 sTxt = sTxt + "Greetings! " + STR$(i) NEXT i 'Try to create a new mail in your default mail client CALL SendMyMail(CBHNDL, "[email protected]", "Some subject..", sTxt) ELSEIF CBCTL = %IDCANCEL THEN DIALOG END CBHNDL END IF END IF END FUNCTION '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' SendMyMail starts default mail program, passes on address and then ' enumerates all windows and looks for proper text field to paste the ' body text into. Reason for this - long text fails with ShellExecute. '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ FUNCTION SendMyMail(BYVAL hDlg AS LONG, _ BYVAL mailTo AS STRING, _ BYVAL subject AS STRING, _ BYVAL bodyText AS STRING) AS LONG LOCAL cnt AS LONG, mText AS ASCIIZ * 1000 ClipboardPutText bodyText 'Put this text on the clipboard to paste it later.. mText = "mailto:" & mailTo & _ "?Subject=" & subject & _ "&Body=" & IDString 'This is not necessary anymore 'call the infamous 'mailto:' command... IF ShellExecute(hDlg, "open", mText, "", "", %SW_SHOWNORMAL) > 32 THEN ' >32 SLEEP 2000 'Wait for your mail client to open. Time could be shorter but it is dangerous... longer is safer gsSubject = LCASE$(subject) MailDone = %False DO 'look for the mail program.. EnumWindows CODEPTR(EnumWindowsProc), 0 'enumerate all open windows IF MailDone THEN EXIT DO 'and exit this loop 'Mailprogram not found... try again.. INCR cnt SLEEP 500 LOOP UNTIL cnt > 25 'try 25 times, then bail out END IF END FUNCTION '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' enumerate running app's - look for caption '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ FUNCTION EnumWindowsProc(BYVAL hWnd AS LONG, BYVAL lParam AS LONG) AS LONG LOCAL zTxt AS ASCIIZ * 260 GetWindowText hWnd, zTxt, 260 'Get windows caption 'For Eudora, it is ok to check for the program name in the main windows caption. For OE and Netscape we have to look for 'a window that has the mails subject in its caption. Reason is that these programs open a seperate window for a new mail zTxt = LCASE$(zTxt) IF zTxt<>"" AND INSTR(zTxt, "eudora")>0 OR _ 'For Eudora INSTR(zTxt, gsSubject)>0 THEN 'For Outlook Express and Netscape Messenger: look for the subject in window's caption SLEEP 2000 'Wait for 'new mail' window to open SetForegroundWindow hWnd 'SetFocus hWnd GOSUB PasteText FUNCTION = 0 : EXIT FUNCTION 'return zero to break enumeration and exit ELSE FUNCTION = 1 : EXIT FUNCTION END IF EXIT FUNCTION PasteText: 'Do a 'CTRL V' to the current window to paste clipboard text 'Simulate Key Presses Keybd_Event 9, 0, 0, 0 'send TABs to skip 'to','cc' and 'subject' fields Keybd_Event 9, 0, 0, 0 Keybd_Event 9, 0, 0, 0 'Send CTRL V to paste clipboard text Keybd_Event %VK_CONTROL, 0, 0, 0 Keybd_Event 86, 0, 0, 0 'V = ASC 86 'Simulate Key Release Keybd_Event 86, 0, %KEYEVENTF_KEYUP, 0 Keybd_Event %VK_CONTROL, 0, %KEYEVENTF_KEYUP, 0 MailDone = %True RETURN END FUNCTION '--------------------------------------- ' ..and to copy the text to the clipboard: '--------------------------------------- FUNCTION ClipboardPutText (BYVAL txt AS STRING) AS LONG LOCAL cbPtr AS LONG, hData AS LONG, Bytes AS LONG txt = txt + CHR$(0) ' make it an ASCIIz string Bytes = LEN(txt) ' get # of bytes to load IF Bytes < 2 THEN EXIT FUNCTION ' if no bytes to load hData = GlobalAlloc(&H2002, Bytes) ' get memory address of clipboard cbPtr = GlobalLock(hData) ' lock and get pointer to data POKE$ cbPtr, txt ' paste the text into memory GlobalUnlock hData ' unlock memory IF ISFALSE OpenClipboard(0) THEN ' if clipboard isn't available GlobalFree hData ' free up memory EXIT FUNCTION ' Return false END IF EmptyClipboard ' empty whatever's in there now SetClipboardData %CF_TEXT, BYVAL hData ' point the clipboard at it as text CloseClipboard ' release clipboard FUNCTION = %TRUE ' return true END FUNCTION
[email protected]
[This message has been edited by Eddy Van Esch (edited October 02, 2001).]
Leave a comment: