home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
xbase
/
library
/
fox
/
workgrp
/
attach.prg
< prev
next >
Wrap
Text File
|
1993-08-27
|
8KB
|
303 lines
* Attach.prg
*
* The attach program brings up a dialog of developers
* working on a similar project. It allows them to
* simultaneously update and receive files used in projects
* by the users working on them. This example shows the use
* the "IPC" type message. By flagging a message with this
* type, MS MAIL will ignore it. The popup of developer names
* is only meant to simulate the person sending the message. In
* real application, you could gather this information
* programmatically without having to use a popup.
#DEFINE nonmailtype 'IPC.MSFOXPRO.UPDATER'
#DEFINE mb_purge 'Do you want to permanently delete these files from mail server?'
PRIVATE devpick,btn,oldtalk,retval
IF SET("TALK") = "ON"
SET TALK OFF
m.oldtalk= "ON"
ELSE
m.oldtalk= "OFF"
ENDIF
devpick=1
btn=3
retval=.T.
* arrays for lists in dialog
DIMENSION fromnames[1]
DIMENSION tonames[1]
* array used for names popup
SELECT name FROM coders;
INTO ARRAY devnames
* gets files associated with developer
DO devnamesval
* run screen
DO attach.spr
IF m.btn=3 &&exit button
SET TALK &oldtalk
RETURN
ENDIF
* logon to MS Mail if not already done so
islogon=.F.
DO CASE
CASE TYPE('mailsession')#'N'
PUBLIC mailsession
mailsession = 0
mailsession=mapilib('LOGON')
CASE m.mailsession=0
mailsession=mapilib('LOGON')
OTHERWISE
islogon=.T.
ENDCASE
IF m.mailsession=0 &&failed to logon
SET TALK &oldtalk
RETURN
ENDIF
* handle button selected
DO CASE
CASE m.btn=1 && send files
IF EMPTY(tonames)
SET TALK &oldtalk
RETURN
ENDIF
DO sendfiles
CASE m.btn=2 && poll for received files
DO getfiles
ENDCASE
* Now log off and cleanup stuff
IF !islogon
=mapilib('LOGOFF',m.mailsession)
mailsession = 0
ENDIF
IF USED('mapiMesg')
USE IN mapimesg
ENDIF
IF USED('mapiFile')
USE IN mapifile
ENDIF
IF USED('mapiRecip')
USE IN mapirecip
ENDIF
IF USED('mapiOrig')
USE IN mapiorig
ENDIF
USE IN FILES
USE IN coders
SET TALK &oldtalk
*!*********************************************************************
*!
*! FUNCTION: devnamesval
*!
*!*********************************************************************
* This routine is called from the popup VALID statement and
* changes the contents of the lists with files associated with
* selected developer.
PROCEDURE devnamesval
PRIVATE getname
getname=LOOKUP(coders.address,ALLTRIM(devnames[devpick]),coders.name)
SELECT filename FROM FILES;
WHERE address=getname;
INTO ARRAY fromnames
frompick=1
DIMENSION tonames[1]
tonames[1]=''
topick=1
SHOW GETS
RETURN
*!*********************************************************************
*!
*! FUNCTION: movebtnval
*!
*!*********************************************************************
* VALID routine to handle move button.
PROCEDURE movebtnval
IF frompick=0 OR EMPTY(fromnames[frompick])
RETURN
ENDIF
IF EMPTY(tonames[1])
tonames[1]=fromnames[frompick]
ELSE
DIMENSION tonames[ALEN(tonames)+1]
tonames[ALEN(tonames)]=fromnames[frompick]
ENDIF
IF ALEN(fromnames)=1
fromnames[1]=''
ELSE
=ADEL(fromnames,frompick)
DIMENSION fromnames[ALEN(fromnames)-1]
ENDIF
frompick=1
SHOW GETS
RETURN
*!*********************************************************************
*!
*! FUNCTION: sendfiles
*!
*!*********************************************************************
* This procedure handles the send files button on the dialog.
* The names in the database are first validated thru MPResolve.
* Then they are loaded into a mapiRecip cursor called filelist.
* Finally, a single mail message is sent out to the developers
* in the filelist cursor. This message is tagged as "IPC" so that
* only apps such as FoxPro which are specifically looking for these
* types of messages will pick them up. The message does not contain
* text. Only the files selected are included.
PROCEDURE sendfiles
=mapilib('newcursor','mapiMesg')
=mapilib('newcursor','mapiFile')
=mapilib('newcursor','mapiRecip','filelist')
* Now check database for names and validate
* in MPResolve(checkid routine). Avoid sending
* yourself devnames[devpick] files.
SELECT coders
SCAN FOR name#ALLTRIM(devnames[devpick])
WAIT WINDOW 'Verifying valid MS MAIL address ... '+;
ALLT(coders.name) NOWAIT
IF checkid()
SELECT mapirecip
SCATTER MEMVAR MEMO
INSERT INTO filelist FROM MEMVAR
ELSE
LOOP
ENDIF
SELECT coders
ENDSCAN
WAIT CLEAR
* Create contents of message. Notice how we have to add a
* space in the Notetext field of mapiMesg for each file. This
* is important, else the call will fail.
INSERT INTO mapimesg VALUES(0,'Project Files',SPACE(ALEN(tonames)),nonmailtype,;
mapilib('getdate'),'',0,RECCOUNT('filelist'),ALEN(tonames))
* Now create the mapiFile cursor which will contain a record
* for each file being sent
FOR i=1 TO ALEN(tonames)
INSERT INTO mapifile VALUES(0,0,i-1,tonames[i],tonames[i],"")
ENDFOR
* Call the MPSendMail function without bringing up dialog.
retval=mapilib("sendmail",mailsession,"mapiMesg","filelist","mapiFile",0)
* Note: you can use the following line instead to test
* the receiving files function if you are working off-line.
*=MAPILIB("savenote",mailsession,"mapiMesg","filelist","mapiFile")
IF m.retval
=mapilib('MPINFO',ALLTRIM(devnames[devpick])+"'s file(s) were sent successfully." )
ENDIF
USE IN filelist
RETURN
*!*********************************************************************
*!
*! FUNCTION: getfiles
*!
*!*********************************************************************
* The getfiles routine polls for messages of type "IPC" and
* subject topic equal to 'Project Files' which are messages
* created in the sendfiles routine above. Note: this routine
* only shows files that were found (they are deleted once you
* exit the routine). If you actually want to update existing files
* you need to modify this routine a little. At the end, the user is
* offered the choice to purge the files from the Mail server.
PROCEDURE getfiles
PRIVATE oldmessid,messageid,oldsafe
oldmessid=''
messageid=''
oldsafe=SET('safe')
SET SAFETY OFF
*Create cursor to store files
=mapilib('newcursor','mapiFile','newfiles')
*Create cursor to store messages
CREATE CURSOR newmesgs (messageid C(100))
WAIT WINDOW 'Searching for new files...' NOWAIT
* Need to poll all messages using MPFindNext and MPReadMail
* to locate messages which meet criteria.
DO WHILE .T.
messageid = mapilib('getnextnote',m.mailsession,oldmessid,nonmailtype)
INSERT INTO newmesgs VALUES(m.messageid)
IF EMPTY(m.messageid)
EXIT
ENDIF
IF mapimesg.filecount>0
SELECT mapifile
SCAN
SCATTER MEMVAR MEMO
INSERT INTO newfiles FROM MEMVAR
ENDSCAN
ENDIF
oldmessid = m.messageid
ENDDO
WAIT CLEAR
SELECT newfiles
IF RECCOUNT('newfiles')#0
BROWSE FIELDS filename FONT 'ms sans serif',10;
TITLE 'The following new files were found:'
* Always delete temporary files. These will be recreated
* again if user does not purge ones stored in mail server.
SCAN
DELETE FILE (pathname)
ENDSCAN
IF mapilib('mpalert',mb_purge)
SELECT newmesgs
SCAN
=mapilib('deletenote',m.mailsession,ALLT(messageid))
ENDSCAN
ENDIF
ELSE
=mapilib('MPINFO','No files found')
ENDIF
USE IN newfiles
USE IN newmesgs
SET SAFETY &oldsafe
RETURN
*!*********************************************************************
*!
*! FUNCTION: checkid
*!
*!*********************************************************************
* This routine validates the Mail name/alias in the MPResolve
* function. If it is correctly validated, TRUE is returned. If
* not, a dialog is presented to select a name. An alert follows
* asking whether they want to use this new name or try again.
FUNCTION checkid
validid=.T.
DO WHILE .T.
IF !mapilib('resolve',mailsession,ALLT(coders.address))
validid=.F.
EXIT
ENDIF
IF ALLT(coders.name) $ mapirecip.name
EXIT
ELSE
IF mapilib('mpalert','The name selected ('+ALLT(mapirecip.name)+;
') does not match the one in the database ('+ALLT(coders.name)+;
'). Use this name (Yes) or try again (No)?')
EXIT
ENDIF
ENDIF
ENDDO
RETURN validid