diff --git a/ACP.e b/ACP.e index ca2f7f3..8bb8b4b 100644 --- a/ACP.e +++ b/ACP.e @@ -1045,6 +1045,8 @@ PROC createCustomMenus(nodes) maddItem( NM_SUB,' Stephan Schiemann ',0,0,0,0) maddItem( NM_SUB,' Eddie Oniel ',0,0,0,0) + maddItem( NM_ITEM, 'Quit',0,0,0,0) + maddItem( NM_TITLE, 'Master Control',0,0,0,0) maddItem( NM_ITEM, 'Sysop Login',0, 0, 0, 0) maddNodes(nodes) @@ -3955,6 +3957,9 @@ PROC main() HANDLE CASE GADGETUP handleEditGadget(im,0) CASE MENUPICK + ->quit menu item + IF(menunum(im.code)=0) AND (itemnum(im.code)=6) THEN attemptShutdown() + IF(menunum(im.code)=1) i:=button button:=0 diff --git a/axcommon.e b/axcommon.e index 0c50015..d436570 100644 --- a/axcommon.e +++ b/axcommon.e @@ -17,7 +17,7 @@ EXPORT ENUM ACS_ACCOUNT_EDITING,ACS_READ_BULLETINS,ACS_COMMENT_TO_SYSOP,ACS_DOWN ACS_CUSTOMCOMMANDS,ACS_JOIN_SUB_CONFERENCE,ACS_ZOOM_MAIL,ACS_MCI_MSG,ACS_EDIT_DIRS,ACS_EDIT_FILES,ACS_BREAK_CHAT,ACS_QUIET_NODE,ACS_SYSOP_COMMANDS,ACS_WHO_IS_ONLINE, ACS_RELOGON,ACS_ULSTATS,ACS_XPR_RECEIVE,ACS_XPR_SEND,ACS_WILDCARDS,ACS_CONFERENCE_ACCOUNTING,ACS_PRI_MSGFILES,ACS_PUB_MSGFILES,ACS_FULL_EDIT,ACS_CONFFLAGS, ACS_OLM,ACS_HIDE_FILES,ACS_SHOW_PAYMENTS,ACS_CREDIT_ACCESS,ACS_VOTE,ACS_MODIFY_VOTE,ACS_FILE_EXPANSION,ACS_EDIT_REAL_NAME,ACS_EDIT_USER_NAME,ACS_CENSORED, - ACS_ACCOUNT_VIEW,ACS_TRANSLATION,ACS_UNKNOWN,ACS_CREATE_CONFERENCE,ACS_LOCAL_DOWNLOADS,ACS_MAX_PAGES,ACS_OVERRIDE_DEFAULTS,ACS_HOLD_ACCESS + ACS_ACCOUNT_VIEW,ACS_TRANSLATION,ACS_UNKNOWN,ACS_CREATE_CONFERENCE,ACS_LOCAL_DOWNLOADS,ACS_MAX_PAGES,ACS_OVERRIDE_DEFAULTS,ACS_HOLD_ACCESS,ACS_EDIT_EMAIL EXPORT ENUM ENV_IDLE=0,ENV_DOWNLOADING=1,ENV_UPLOADING=2,ENV_DOORS=3,ENV_MAIL=4,ENV_STATS=5,ENV_ACCOUNT=6,ENV_ZOOM=7,ENV_FILES=8,ENV_BULLETINS=9, ENV_VIEWING=10,ENV_ACCOUNTSEQ=11,ENV_LOGOFF=12,ENV_SYSOP=13,ENV_SHELL=14,ENV_EMACS=15,ENV_JOIN=16,ENV_CHAT=17,ENV_NOTACTIVE=18, diff --git a/axobjects.e b/axobjects.e index d628199..41b2f9a 100644 --- a/axobjects.e +++ b/axobjects.e @@ -60,8 +60,7 @@ EXPORT OBJECT user creditTotalDate: LONG -> credit total to date date creditTracking: CHAR -> track uploads/downloads flags in credit account translatorID: CHAR - ansiQuickSettings:CHAR - unused2: CHAR + msgBaseRJoin:INT confYM9: LONG beginLogCall : LONG protocol: CHAR @@ -88,9 +87,11 @@ EXPORT OBJECT userMisc realName[26]:ARRAY OF CHAR downloadBytesBCD[8]:ARRAY OF CHAR uploadBytesBCD[8]:ARRAY OF CHAR - unknown[28]:ARRAY OF CHAR - nodeFlags[32]:ARRAY OF LONG - confFlags2[10]:ARRAY OF LONG + eMail[50]:ARRAY OF CHAR + unused[146]:ARRAY OF CHAR + ->unknown[28]:ARRAY OF CHAR + ->nodeFlags[32]:ARRAY OF LONG + ->confFlags2[10]:ARRAY OF LONG ENDOBJECT EXPORT OBJECT tempAccess diff --git a/express.e b/express.e index 47cc0ea..f87cc45 100644 --- a/express.e +++ b/express.e @@ -3218,6 +3218,7 @@ PROC runDoor(cmd,type,command,params,resident,doorTrap,privcmd,pri=0,stacksize=2 DEF i,f DEF nodes = 0,msgcmd DEF tempstring[255]:STRING + DEF tempstring2[255]:STRING DEF runOnExit[255]:STRING DEF runOnExit2[255]:STRING DEF cb:PTR TO confBase @@ -4020,9 +4021,11 @@ PROC runDoor(cmd,type,command,params,resident,doorTrap,privcmd,pri=0,stacksize=2 ENDIF msg.data:=chooseAName(msg.string,tuserdata,tuserkeys,tusermisc,msg.data) CASE CHECK_REALNAME - IF checkToolTypeExists(TOOLTYPE_CONF,currentConf,'USERNAME') + StringF(tempstring,'USERNAME.\d',currentMsgBase) + StringF(tempstring2,'REALNAME.\d',currentMsgBase) + IF checkToolTypeExists(TOOLTYPE_CONF,currentConf,'USERNAME') OR checkToolTypeExists(TOOLTYPE_MSGBASE,currentConf,tempstring) msg.data:=2 - ELSEIF checkToolTypeExists(TOOLTYPE_CONF,currentConf,'REALNAME') + ELSEIF checkToolTypeExists(TOOLTYPE_CONF,currentConf,'REALNAME') OR checkToolTypeExists(TOOLTYPE_MSGBASE,currentConf,tempstring2) msg.data:=1 ELSE msg.data:=0 @@ -4708,11 +4711,15 @@ ENDPROC PROC joinConf(conf, msgBaseNum,confScan, auto, forceMailScan=FORCE_MAILSCAN_NOFORCE) DEF string[255]:STRING,tempstr[255]:STRING + DEF namestr1[255]:STRING + DEF namestr2[255]:STRING DEF mystat, temp IF (checkConfAccess(conf)=FALSE) THEN conf:=1 IF((conf<1) OR (conf>cmds.numConf)) THEN conf:=1 + IF (msgBaseNum<1 ) OR (msgBaseNum>getConfMsgBaseCount(conf)) THEN msgBaseNum:=1 + IF confScan=FALSE currentConf:=conf currentMsgBase:=msgBaseNum @@ -4732,9 +4739,11 @@ PROC joinConf(conf, msgBaseNum,confScan, auto, forceMailScan=FORCE_MAILSCAN_NOFO StringF(uploadLocation,'\sUpload/',currentConfDir) confNameType:=NAME_TYPE_USERNAME - IF checkToolTypeExists(TOOLTYPE_CONF,conf,'REALNAME') + StringF(namestr1,'REALNAME.\d',msgBaseNum) + StringF(namestr2,'INTERNETNAME.\d',msgBaseNum) + IF checkToolTypeExists(TOOLTYPE_CONF,conf,'REALNAME') OR checkToolTypeExists(TOOLTYPE_MSGBASE,conf,namestr1) confNameType:=NAME_TYPE_REALNAME - ELSEIF checkToolTypeExists(TOOLTYPE_CONF,conf,'INTERNETNAME') + ELSEIF checkToolTypeExists(TOOLTYPE_CONF,conf,'INTERNETNAME') OR checkToolTypeExists(TOOLTYPE_MSGBASE,conf,namestr2) confNameType:=NAME_TYPE_INTERNETNAME ENDIF @@ -4838,8 +4847,11 @@ PROC joinConf(conf, msgBaseNum,confScan, auto, forceMailScan=FORCE_MAILSCAN_NOFO ENDIF ENDIF - IF (auto=FALSE) AND (confScan=FALSE) THEN loggedOnUser.confRJoin:=conf - + IF (auto=FALSE) AND (confScan=FALSE) + loggedOnUser.confRJoin:=conf + loggedOnUser.msgBaseRJoin:=msgBaseNum + captureRealAndInternetNames(conf,msgBaseNum) + ENDIF ENDPROC mystat PROC doPause() @@ -6445,7 +6457,7 @@ PROC displayScreen(screenType) ENDSELECT ENDPROC res -PROC displayFile(filename, allowMCI=TRUE, resetNonStop=TRUE) +PROC displayFile(filename, allowMCI=TRUE, resetNonStop=TRUE, resetLineCount=TRUE) DEF fh DEF firstline=TRUE DEF linedata[999]:STRING @@ -6454,7 +6466,7 @@ PROC displayFile(filename, allowMCI=TRUE, resetNonStop=TRUE) DEF extension[4]:STRING DEF fname[255]:STRING - lineCount:=0 + IF resetLineCount THEN lineCount:=0 IF (mciViewSafe=FALSE) AND ((checkSecurity(ACS_MCI_MSG)=FALSE) OR (sopt.toggles[TOGGLES_NOMCIMSGS]=TRUE)) THEN allowMCI:=FALSE IF mcioff=TRUE THEN allowMCI:=FALSE @@ -6750,20 +6762,46 @@ PROC closeAEStats() ENDPROC PROC toggleStatusDisplay() - DEF dp,bp,tags + DEF dp,bp,sz,tags + DEF pub=FALSE + DEF pubScreen[255]:STRING + DEF pubLock=0:PTR TO screen + + + IF bitPlanes=0 + pub:=TRUE + ENDIF + + IF readToolType(TOOLTYPE_WINDOW,node,'WINDOW.PUBSCREEN',pubScreen) + pub:=TRUE + ENDIF + + IF checkToolTypeExists(TOOLTYPE_NODE,node,'SHOW_CACHE_STATS') + sz:=37 + ELSE + sz:=27 + ENDIF + + IF pub + IF StrLen(pubScreen)>0 + pubLock:=LockPubScreen(pubScreen) + ELSE + pubLock:=LockPubScreen(NIL) + ENDIF + IF pubLock=FALSE + pub:=FALSE + ELSE + sz:=sz+pubLock.wbortop+pubLock.font.ysize+pubLock.wborbottom + ENDIF + ENDIF - IF screen=NIL THEN RETURN + IF (screen=NIL) AND (pub=FALSE) THEN RETURN IF(dStatBar) dStatBar:=0 closeAEStats() - IF(bitPlanes) - MoveWindow(window,0,-37) - SizeWindow(window,0,37) - ELSE - MoveWindow(window,0,-38) - SizeWindow(window,0,38) - ENDIF + MoveWindow(window,0,-sz) + SizeWindow(window,0,sz) IF (loggedOnUser<>NIL) AND (StrLen(loggedOnUser.name)>0) THEN statPrintUser(loggedOnUser,loggedOnUserKeys,loggedOnUserMisc) ELSE @@ -6775,33 +6813,44 @@ PROC toggleStatusDisplay() bp:=4 ENDIF - tags:=NEW [WA_CUSTOMSCREEN,screen, - WA_LEFT,0, - WA_TOP,10, - WA_WIDTH,640, - WA_HEIGHT,39, - WA_DETAILPEN,dp, - WA_BLOCKPEN,bp, - WA_FLAGS, - WFLG_SIMPLE_REFRESH,NIL] + IF pub + tags:=NEW [WA_PUBSCREEN,pubLock, + WA_DEPTHGADGET,1, + WA_DRAGBAR,1, + WA_LEFT,window.leftedge, + WA_TOP,window.topedge, + WA_WIDTH,sopt.width, + WA_HEIGHT,sz, + WA_DETAILPEN,dp, + WA_BLOCKPEN,bp, + WA_FLAGS, + WFLG_SIMPLE_REFRESH,NIL] + ELSE + tags:=NEW [WA_CUSTOMSCREEN,screen, + WA_LEFT,0, + WA_TOP,screen.wbortop+screen.font.ysize-1, + WA_WIDTH,640, + WA_HEIGHT,sz, + WA_DETAILPEN,dp, + WA_BLOCKPEN,bp, + WA_FLAGS, + WFLG_SIMPLE_REFRESH,NIL] + ENDIF IF(( windowStat:=OpenWindowTagList(NIL,tags))<>NIL) dStatBar:=1 - IF(bitPlanes) - SizeWindow(window,0,-37) - MoveWindow(window,0,37) - ELSE - SizeWindow(window,0,-38) - MoveWindow(window,0,38) - ENDIF - + SizeWindow(window,0,-sz) + MoveWindow(window,0,sz) + initStatCon() clearStatusPane() + SetWindowTitles(windowStat,titlebar,titlebar) SetWindowTitles(window,titlebar,titlebar) IF (loggedOnUser<>NIL) AND (StrLen(loggedOnUser.name)>0) THEN statPrintUser(loggedOnUser,loggedOnUserKeys,loggedOnUserMisc) statChatFlag() ENDIF END tags + IF pubLock THEN UnlockPubScreen(NIL,pubLock) ENDIF ENDPROC @@ -7126,8 +7175,10 @@ PROC processInputMessage(timeout, extsig = 0,rawMode=FALSE, allowSer=TRUE) IF (ch=0) AND allowSer AND (signals AND (serialsig OR telnetsig)) IF rawMode - lch:=readMayGetChar(serialReadMP,TRUE,{serbuff}) - IF lch<>-1 THEN ch:=lch + IF (ioFlags[IOFLAG_SER_IN]) + lch:=readMayGetChar(serialReadMP,TRUE,{serbuff}) + IF lch<>-1 THEN ch:=lch + ENDIF ELSEIF -1<>(lch:=readMayGetChar(serialReadMP,TRUE,{serbuff})) IF (ioFlags[IOFLAG_SER_IN]) ch:=lch @@ -7169,8 +7220,10 @@ PROC processInputMessage(timeout, extsig = 0,rawMode=FALSE, allowSer=TRUE) -> If a console signal was received, get the character IF rawMode - lch:=readMayGetChar(consoleReadMP, FALSE,{ibuf}) - IF lch<>-1 THEN ch:=lch + IF (ioFlags[IOFLAG_KBD_IN]) + lch:=readMayGetChar(consoleReadMP, FALSE,{ibuf}) + IF lch<>-1 THEN ch:=lch + ENDIF ELSEIF -1<>(lch:=readMayGetChar(consoleReadMP, FALSE, {ibuf})) IF (ioFlags[IOFLAG_KBD_IN]) ch:=lch @@ -7238,7 +7291,10 @@ PROC processInputMessage(timeout, extsig = 0,rawMode=FALSE, allowSer=TRUE) statClearTime() StrCopy(connectString,'SYSOP_LOCAL') IF (scropen) THEN expressToFront() ELSE openExpressScreen() + ioFlags[IOFLAG_SER_IN]:=0 + ioFlags[IOFLAG_SER_OUT]:=0 ioFlags[IOFLAG_SCR_OUT]:=-1 + ioFlags[IOFLAG_KBD_IN]:=-1 onlineBaud:=cmds.openingBaud onlineBaudR:=cmds.openingBaud intDoReset(sopt.offHook) @@ -7252,7 +7308,10 @@ PROC processInputMessage(timeout, extsig = 0,rawMode=FALSE, allowSer=TRUE) statClearTime() StrCopy(connectString,'F2_LOCAL') IF (scropen) THEN expressToFront() ELSE openExpressScreen() + ioFlags[IOFLAG_SER_IN]:=0 + ioFlags[IOFLAG_SER_OUT]:=0 ioFlags[IOFLAG_SCR_OUT]:=-1 + ioFlags[IOFLAG_KBD_IN]:=-1 onlineBaud:=cmds.openingBaud onlineBaudR:=cmds.openingBaud logonType:=LOGON_TYPE_LOCAL @@ -7863,7 +7922,7 @@ PROC processLoggingOff() IF (checkToolTypeExists(TOOLTYPE_BBSCONFIG,0,'MAIL_ON_LOGOFF')) AND (StrLen(mailOptions.sysopEmail)>0) StringF(tempstr,'\s: Ami-Express logoff notification',cmds.bbsName) StringF(tempstr2,'This is a notification that \s from \s has logged off\n\n',loggedOnUser.name,loggedOnUser.location) - sendMail(tempstr,tempstr2,TRUE, msgBuf,lines,mailOptions.sysopEmail) + sendMail(tempstr,tempstr2,FALSE, NIL,0,mailOptions.sysopEmail) ENDIF StrCopy(reservedName,'') @@ -8380,11 +8439,13 @@ PROC commentToSYSOP() DEF stat DEF str[255]:STRING - stat:=chooseAName(cmds.sysopName,tempUser,tempUserKeys,tempUserMisc,1) + stat:=captureRealAndInternetNames(currentConf,currentMsgBase) + IF stat<0 THEN RETURN stat + + stat:=loadAccount(1,tempUser,tempUserKeys,tempUserMisc) IF(stat<0) RETURN stat ENDIF - stat:=loadAccount(tempUser.slotNumber,tempUser,tempUserKeys,tempUserMisc) SELECT confNameType CASE NAME_TYPE_USERNAME @@ -8411,6 +8472,7 @@ PROC commentToSYSOP() mailHeader.status:="R" comment:=1 stat:=callMsgFuncs(MAIL_CREATE,0,0) + comment:=0 IF(stat<0) THEN RETURN stat ENDPROC RESULT_SUCCESS @@ -8572,6 +8634,7 @@ PROC displayMessage(gfh) aePuts(str) StringF(str,'Subject: \s\b\n\b\n',mailHeader.subject) aePuts(str) + lineCount:=lineCount+5 alreadyRecvd:=mailHeader.recv @@ -8589,11 +8652,11 @@ PROC displayMessage(gfh) IF(nonStopMail) nonStopDisplayFlag:=TRUE mcioff:=TRUE - displayFile(tempStr,TRUE,FALSE) + displayFile(tempStr,TRUE,FALSE,FALSE) IF(stat=RESULT_FAILURE) THEN nonStopMail:=FALSE ELSE mcioff:=TRUE - displayFile(tempStr,TRUE) + displayFile(tempStr,TRUE,TRUE,FALSE) ENDIF mcioff:=FALSE stat:=checkAttachedFile(mailHeader.msgNumb,1) @@ -10209,7 +10272,7 @@ PROC saveNewMSG(gfh,mh:PTR TO mailHeader) strCpy(mh.fromName,confMailName,31) IF(msgbaselock:=lockMsgBase()) StringF(tempStr,'EXTSEND.\d',currentMsgBase) - IF checkToolTypeExists(TOOLTYPE_MSGBASE,currentConf,tempStr) + IF checkToolTypeExists(TOOLTYPE_MSGBASE,currentConf,tempStr) AND (comment=0) getMsgBaseLocation(currentConf,currentMsgBase,tempStr) StrAdd(tempStr,'EXT-OUT') IF (lock:=CreateDir(tempStr)) THEN UnLock(lock) @@ -10317,14 +10380,11 @@ PROC enterMSG(gfh) DEF exit,i,i2,i3,stat DEF extSend DEF t - + aFlag:=0 StrCopy(attachedFile,'',ALL) - IF(comment=1) - comment:=0 - JUMP skipAll - ENDIF + IF(comment=1) THEN JUMP skipAll IF(replyFlag=1) JUMP skipBegin @@ -10753,8 +10813,11 @@ contloop: IF(((str[0]="r") OR (str[0]="R"))) IF((privateFlag=0) OR ((stringCompare(mailHeader.toName,confMailName)=RESULT_SUCCESS)) OR (StrCmp(mailHeader.toName,'EALL',4))) - stat:=replyToMSG(gfh) - RETURN RESULT_SUCCESS + stat:=captureRealAndInternetNames(currentConf,currentMsgBase) + IF stat=RESULT_SUCCESS + stat:=replyToMSG(gfh) + RETURN RESULT_SUCCESS + ENDIF ELSE aePuts('Not your message.\b\n') JUMP contloop @@ -11227,7 +11290,8 @@ PROC searchNewMail(gfh, cn, msgBaseNum) stat:=loadMessageHeader(gfh) IF(mailHeader.status="D") THEN JUMP getNextMSG - cb:=confBases.item(getConfIndex(currentConf,currentMsgBase)-1) + cb:=confBases.item(getConfIndex(cn,msgBaseNum)-1) + IF(((stringCompare(mailHeader.toName,confMailName)=RESULT_SUCCESS) OR (stringCompare(mailHeader.toName,'eall')=RESULT_SUCCESS) OR ((stringCompare(mailHeader.toName,'all')=RESULT_SUCCESS) AND (cb.handle[0] AND MAILSCAN_ALL)))) AND (mailHeader.recv=0) IF(currentConf=0) @@ -11599,8 +11663,11 @@ PROC readMSG(gfh) noDirF:=1 JUMP nextMenu CASE "r" - stat:=replyToMSG(gfh) - IF(stat<0) THEN RETURN stat + stat:=captureRealAndInternetNames(currentConf,currentMsgBase) + IF stat=RESULT_SUCCESS + stat:=replyToMSG(gfh) + IF(stat<0) THEN RETURN stat + ENDIF noDirF:=1 JUMP goNextMsg ENDSELECT @@ -11898,6 +11965,9 @@ PROC callMsgFuncs(msgfunc, conf, msgBaseNum) currentSeekPos:=0 stat:=RESULT_FAILURE mciViewSafe:=FALSE + + stat:=captureRealAndInternetNames(currentConf,currentMsgBase) + IF stat<0 THEN RETURN stat SELECT confNameType CASE NAME_TYPE_USERNAME @@ -12402,7 +12472,7 @@ ENDPROC PROC statPrint(s: PTR TO CHAR) - DEF str[25]:STRING + DEF str[255]:STRING IF(dStatBar AND (statWriteIO<>NIL)) IF(bitPlanes<3) @@ -13035,6 +13105,7 @@ PROC updateTitle(hoozer: PTR TO user) IF hoozer=NIL IF window<>NIL THEN SetWindowTitles(window,titlebar,titlebar) + IF windowStat<>NIL THEN SetWindowTitles(windowStat,titlebar,titlebar) RETURN ENDIF @@ -13042,9 +13113,10 @@ PROC updateTitle(hoozer: PTR TO user) StringF(ititlebar,' \c\s, \s, (\d \l\s[10] [\d]) \d mins, \d \c',pflag,hoozer.name,hoozer.phoneNumber,hoozer.secStatus,hoozer.conferenceAccess,currentConf,Div(timeLimit,60),onlineBaud,aflag) ->//(RTS) was Online_BaudR IF(dStatBar=NIL) SetWindowTitles(window,ititlebar,ititlebar) - + IF windowStat<>NIL THEN SetWindowTitles(windowStat,ititlebar,ititlebar) ELSE SetWindowTitles(window,titlebar,titlebar) + IF windowStat<>NIL THEN SetWindowTitles(windowStat,titlebar,titlebar) ENDIF ENDIF ENDPROC @@ -13076,6 +13148,7 @@ PROC statPrintUser(hoozer: PTR TO user,hoozer2: PTR TO userKeys,hoozer3: PTR TO IF hoozer=NIL SetWindowTitles(window,titlebar,titlebar) + IF windowStat<>NIL THEN SetWindowTitles(windowStat,titlebar,titlebar) RETURN ENDIF @@ -13181,13 +13254,15 @@ PROC statPrintUser(hoozer: PTR TO user,hoozer2: PTR TO userKeys,hoozer3: PTR TO StringF(string,' \r\s[15]',hostIP) statMessage(19,3,string) - IF (cacheTests>0) - RealF(bcdStr,!(cacheHits!*100.0)/(cacheTests!),2) - ELSE - StrCopy(bcdStr,'0') + IF checkToolTypeExists(TOOLTYPE_NODE,node,'SHOW_CACHE_STATS') + IF (cacheTests>0) + RealF(bcdStr,!(cacheHits!*100.0)/(cacheTests!),2) + ELSE + StrCopy(bcdStr,'0') + ENDIF + StringF(string,'Tooltype cache: Used \d/\d Hit rate: \d/\d (\s%) ',diskObjectCache.count(),diskObjectCache.maxSize(),cacheHits,cacheTests,bcdStr) + statMessage(1,4,string) ENDIF - StringF(string,'Tooltype cache: Used \d/\d Hit rate: \d/\d (\s%) ',diskObjectCache.count(),diskObjectCache.maxSize(),cacheHits,cacheTests,bcdStr) - statMessage(1,4,string) ENDPROC PROC pGoodbye() @@ -16951,7 +17026,7 @@ PROC uploadaFile(uLFType,cmd,params) -> JOE IF (checkToolTypeExists(TOOLTYPE_BBSCONFIG,0,'MAIL_ON_UPLOAD')) AND (StrLen(mailOptions.sysopEmail)>0) StringF(str,'\s: Ami-Express logoff notification',cmds.bbsName) StringF(string,'This is a notification that \s from \s has logged off\n\n',loggedOnUser.name,loggedOnUser.location) - sendMail(str,string,TRUE, msgBuf,lines,mailOptions.sysopEmail) + sendMail(str,string,FALSE, NIL,0,mailOptions.sysopEmail) ENDIF ELSE callersLog('\tUpload Failed..') @@ -19064,6 +19139,7 @@ PROC editInfo(which:LONG, hoozer:PTR TO user, hoozer2:PTR TO userKeys, hoozer3: hoozer.newUser:=0 hoozer.confRJoin:=readToolTypeInt(TOOLTYPE_PRESET,preset,'PRESET.CONFRJOIN') + hoozer.msgBaseRJoin:=readToolTypeInt(TOOLTYPE_PRESET,preset,'PRESET.MSGBASERJOIN') hoozer.secStatus:=readToolTypeInt(TOOLTYPE_PRESET,preset,'PRESET.ACCESS') hoozer.secLibrary:=readToolTypeInt(TOOLTYPE_PRESET,preset,'PRESET.RATIO') hoozer.timeLimit:=readToolTypeInt(TOOLTYPE_PRESET,preset,'PRESET.TIME_LIMIT') @@ -21438,6 +21514,7 @@ PROC applyBulkPresetChanges(preset:LONG,allConf:LONG,areaName:PTR TO CHAR,secLev tempUser.newUser:=0 tempUser.confRJoin:=readToolTypeInt(TOOLTYPE_PRESET,preset,'PRESET.CONFRJOIN') + tempUser.msgBaseRJoin:=readToolTypeInt(TOOLTYPE_PRESET,preset,'PRESET.MSGBASERJOIN') tempUser.secStatus:=readToolTypeInt(TOOLTYPE_PRESET,preset,'PRESET.ACCESS') tempUser.secLibrary:=readToolTypeInt(TOOLTYPE_PRESET,preset,'PRESET.RATIO') tempUser.timeLimit:=readToolTypeInt(TOOLTYPE_PRESET,preset,'PRESET.TIME_LIMIT') @@ -21586,7 +21663,7 @@ PROC sysopPaged() IF(checkToolTypeExists(TOOLTYPE_BBSCONFIG,0,'MAIL_ON_SYSOP_PAGE')) AND (StrLen(mailOptions.sysopEmail)>0) StringF(tempstring,'\s: Ami-Express page notification',cmds.bbsName) StringF(tempstring2,'This is a notification that you were paged by \s.',loggedOnUser.name) - sendMail(tempstring,tempstring2,FALSE,msgBuf,lines,mailOptions.sysopEmail) + sendMail(tempstring,tempstring2,FALSE,NIL,0,mailOptions.sysopEmail) ENDIF ENDPROC @@ -23037,9 +23114,16 @@ PROC internalCommandW() aePuts('\b\n') IF((checkSecurity(ACS_EDIT_USER_NAME))=FALSE) + aePuts('[ 0] [DISABLED]\b\n') + ELSE + StringF(str,'[ 0] LOGIN NAME.............. \s\b\n',loggedOnUser.name) + aePuts(str) + ENDIF + + IF((checkSecurity(ACS_EDIT_EMAIL))=FALSE) aePuts('[ 1] [DISABLED]\b\n') ELSE - StringF(str,'[ 1] LOGIN NAME.............. \s\b\n',loggedOnUser.name) + StringF(str,'[ 1] EMAIL ADDRESS........... \s\b\n',loggedOnUserMisc.eMail) aePuts(str) ENDIF @@ -23195,7 +23279,7 @@ PROC internalCommandW() option:=Val(str) SELECT option - CASE 1 + CASE 0 ->EDIT USER NAME IF (checkSecurity(ACS_EDIT_USER_NAME)=FALSE) THEN JUMP cant loop1: @@ -23222,9 +23306,19 @@ PROC internalCommandW() UpperStr(str) strCpy(loggedOnUserKeys.userName,str,31) saveAccount(loggedOnUser,loggedOnUserKeys,loggedOnUserMisc,0,0) + CASE 1 + ->EDIT EMAIL ADDRESS + IF (checkSecurity(ACS_EDIT_EMAIL)=FALSE) THEN JUMP cant + aePuts('Email Address: ') + StrCopy(str,loggedOnUserMisc.eMail,50) + stat:=lineInput('',str,100,INPUT_TIMEOUT,str) + IF(stat<0) THEN RETURN stat + IF(StrLen(str)=0) THEN JUMP cant + strCpy(loggedOnUserMisc.eMail,str,50) CASE 2 ->EDIT REAL NAME IF (checkSecurity(ACS_EDIT_REAL_NAME)=FALSE) THEN JUMP cant + loop2: aePuts('Real Name: (Alpha Numeric) ') StrCopy(str,loggedOnUserMisc.realName,26) stat:=lineInput('',str,25,INPUT_TIMEOUT,str) @@ -23234,18 +23328,19 @@ PROC internalCommandW() stat:=checkForAst(str) IF(stat) aePuts('No wildcards allowed in a name.\b\n\b\n') - JUMP loop1 + JUMP loop2 ENDIF stat:=findUserFromName(1,NAME_TYPE_REALNAME,str,tempUser,tempUserKeys,tempUserMisc) IF(stat<>0) aePuts('Already in use!, try another.\b\n\b\n') - JUMP loop1 + JUMP loop2 ENDIF aePuts('Ok!\b\n') strCpy(loggedOnUserMisc.realName,str,26) CASE 3 ->EDIT INTERNET NAME IF (checkSecurity(ACS_EDIT_INTERNET_NAME)=FALSE) THEN JUMP cant + loop3: aePuts('Internet Name: (Alpha Numeric No Spaces) ') StrCopy(str,loggedOnUserMisc.internetName,10) stat:=lineInput('',str,9,INPUT_TIMEOUT,str) @@ -23255,12 +23350,12 @@ PROC internalCommandW() stat:=checkForAst(str) IF(stat) aePuts('No wildcards allowed in a name.\b\n\b\n') - JUMP loop1 + JUMP loop3 ENDIF stat:=findUserFromName(1,NAME_TYPE_INTERNETNAME,str,tempUser,tempUserKeys,tempUserMisc) IF(stat<>0) aePuts('Already in use!, try another.\b\n\b\n') - JUMP loop1 + JUMP loop3 ENDIF aePuts('Ok!\b\n') strCpy(loggedOnUserMisc.internetName,str,10) @@ -23766,8 +23861,10 @@ customAsciiDone: ENDPROC count PROC asciiZoom() - DEF conf,cnt + DEF conf,cnt,msgbase DEF mystat,zoomConfNameType + DEF tempStr1[255]:STRING + DEF tempStr2[255]:STRING DEF zoomName[255]:STRING StringF(zoomName,'\sNode\d/PlayPen/MESSAGES.DAT',cmds.bbsLoc,node) @@ -23777,15 +23874,19 @@ PROC asciiZoom() cnt:=0 FOR conf:=1 TO cmds.numConf IF (checkConfAccess(conf)) - zoomConfNameType:=NAME_TYPE_USERNAME - IF checkToolTypeExists(TOOLTYPE_CONF,conf,'REALNAME') - zoomConfNameType:=NAME_TYPE_REALNAME - ELSEIF checkToolTypeExists(TOOLTYPE_CONF,conf,'INTERNETNAME') - zoomConfNameType:=NAME_TYPE_INTERNETNAME - ENDIF - - mystat:=asciiZoomConf(conf,1,zoomConfNameType) - IF mystat<>RESULT_ABORT THEN cnt++ + FOR msgbase:=1 TO getConfMsgBaseCount(conf) + zoomConfNameType:=NAME_TYPE_USERNAME + StringF(tempStr1,'REALNAME.\d',msgbase) + StringF(tempStr2,'INTERNETNAME.\d',msgbase) + IF checkToolTypeExists(TOOLTYPE_CONF,conf,'REALNAME') OR checkToolTypeExists(TOOLTYPE_MSGBASE,conf,tempStr1) + zoomConfNameType:=NAME_TYPE_REALNAME + ELSEIF checkToolTypeExists(TOOLTYPE_CONF,conf,'INTERNETNAME') OR checkToolTypeExists(TOOLTYPE_MSGBASE,conf,tempStr2) + zoomConfNameType:=NAME_TYPE_INTERNETNAME + ENDIF + + mystat:=asciiZoomConf(conf,msgbase,zoomConfNameType) + IF mystat<>RESULT_ABORT THEN cnt++ + ENDFOR ENDIF EXIT mystat=RESULT_FAILURE IF (mystat=RESULT_TIMEOUT) OR (mystat=RESULT_NO_CARRIER) @@ -23987,11 +24088,13 @@ customQwkDone: ENDPROC count,recNum PROC qwkZoom() - DEF conf,cnt - DEF mystat + DEF conf,cnt,msgbase + DEF mystat,n DEF zoomName[255]:STRING DEF fo,count DEF tempstr[255]:STRING + DEF namestr1[255]:STRING + DEF namestr2[255]:STRING DEF zoomConfNameType StringF(zoomName,'\sNode\d/PlayPen/MESSAGES.DAT',cmds.bbsLoc,node) @@ -24032,18 +24135,22 @@ PROC qwkZoom() count:=0 FOR conf:=1 TO cmds.numConf - IF (checkConfAccess(conf)) THEN count++ + IF (checkConfAccess(conf)) THEN count:=count+getConfMsgBaseCount(conf) ENDFOR StringF(tempstr,'\d\b\n',count-1) fileWrite(fo,tempstr) + n:=1 FOR conf:=1 TO cmds.numConf IF (checkConfAccess(conf)) - StringF(tempstr,'\d\b\n',relConf(conf)) - fileWrite(fo,tempstr) - StringF(tempstr,'\s',getConfName(conf)) - IF StrLen(tempstr)>10 THEN SetStr(tempstr,10) - StrAdd(tempstr,'\b\n') - fileWrite(fo,tempstr) + FOR msgbase:=1 TO getConfMsgBaseCount(conf) + StringF(tempstr,'\d\b\n',n) + fileWrite(fo,tempstr) + getMsgBaseName(conf,msgbase,tempstr) + IF StrLen(tempstr)>10 THEN SetStr(tempstr,10) + StrAdd(tempstr,'\b\n') + fileWrite(fo,tempstr) + n++ + ENDFOR ENDIF ENDFOR fileWrite(fo,'HELLO\b\n') @@ -24069,14 +24176,18 @@ PROC qwkZoom() saveMsgPointers(currentConf,currentMsgBase) FOR conf:=1 TO cmds.numConf IF (checkConfAccess(conf)) - zoomConfNameType:=NAME_TYPE_USERNAME - IF checkToolTypeExists(TOOLTYPE_CONF,conf,'REALNAME') - zoomConfNameType:=NAME_TYPE_REALNAME - ELSEIF checkToolTypeExists(TOOLTYPE_CONF,conf,'INTERNETNAME') - zoomConfNameType:=NAME_TYPE_INTERNETNAME - ENDIF - mystat,floatMsgRecNum:=qwkZoomConf(conf,1,floatMsgRecNum,zoomConfNameType) - IF mystat<>RESULT_ABORT THEN cnt++ + FOR msgbase:=1 TO getConfMsgBaseCount(conf) + zoomConfNameType:=NAME_TYPE_USERNAME + StringF(namestr1,'REALNAME.\d',msgbase) + StringF(namestr2,'INTERNETNAME.\d',msgbase) + IF checkToolTypeExists(TOOLTYPE_CONF,conf,'REALNAME') OR checkToolTypeExists(TOOLTYPE_MSGBASE,conf,namestr1) + zoomConfNameType:=NAME_TYPE_REALNAME + ELSEIF checkToolTypeExists(TOOLTYPE_CONF,conf,'INTERNETNAME') OR checkToolTypeExists(TOOLTYPE_MSGBASE,conf,namestr2) + zoomConfNameType:=NAME_TYPE_INTERNETNAME + ENDIF + mystat,floatMsgRecNum:=qwkZoomConf(conf,msgbase,floatMsgRecNum,zoomConfNameType) + IF mystat<>RESULT_ABORT THEN cnt++ + ENDFOR ENDIF EXIT mystat=RESULT_FAILURE IF (mystat=RESULT_TIMEOUT) OR (mystat=RESULT_NO_CARRIER) @@ -25339,29 +25450,31 @@ PROC confScan() ENDIF ENDPROC RESULT_SUCCESS -PROC captureRealAndInternetNames() - DEF i,stat,valid +PROC captureRealAndInternetNames(conf,msgbase) + DEF i,m,stat,valid DEF realNamesUsed=FALSE,internetNamesUsed=FALSE DEF tempstr[30]:STRING + DEF namestr[255]:STRING - FOR i:=1 TO cmds.numConf - IF checkConfAccess(i) - IF checkToolTypeExists(TOOLTYPE_CONF,i,'REALNAME') THEN realNamesUsed:=TRUE - IF checkToolTypeExists(TOOLTYPE_CONF,i,'INTERNETNAME') THEN internetNamesUsed:=TRUE - ENDIF - ENDFOR + IF checkToolTypeExists(TOOLTYPE_CONF,conf,'REALNAME') THEN realNamesUsed:=TRUE + IF checkToolTypeExists(TOOLTYPE_CONF,conf,'INTERNETNAME') THEN internetNamesUsed:=TRUE + StringF(namestr,'REALNAME.\d',msgbase) + IF checkToolTypeExists(TOOLTYPE_MSGBASE,conf,namestr) THEN realNamesUsed:=TRUE + StringF(namestr,'INTERNETNAME.\d',msgbase) + IF checkToolTypeExists(TOOLTYPE_MSGBASE,conf,namestr) THEN internetNamesUsed:=TRUE IF ((realNamesUsed=TRUE) AND (StrLen(loggedOnUserMisc.realName)=0)) valid:=FALSE aePuts('\b\n') IF displayScreen(SCREEN_REALNAMES)=FALSE - aePuts('Real Names are required in some conferences\b\non this system\b\n') + aePuts('Real Names are required for messages in this conference/msgbase \b\n') ENDIF aePuts('\b\n') REPEAT aePuts('Real Name (Alpha Numeric): ') stat:=lineInput('','',25,INPUT_TIMEOUT,tempstr) IF stat<0 THEN RETURN stat + IF StrLen(tempstr)=0 THEN RETURN RESULT_FAILURE IF (StrLen(tempstr)<>1) AND (strCmpi(tempstr,loggedOnUserMisc.realName,ALL)=FALSE) aePuts('\b\nChecking for duplicate name...') @@ -25384,7 +25497,7 @@ PROC captureRealAndInternetNames() aePuts('\b\n') IF displayScreen(SCREEN_INTERNETNAMES)=FALSE - aePuts('Internet Names are required in some conferences\b\non this system\b\n') + aePuts('Internet Names are required for messages in this conference/msgbase\b\n') ENDIF aePuts('\b\n') @@ -25393,6 +25506,8 @@ PROC captureRealAndInternetNames() stat:=lineInput('','',9,INPUT_TIMEOUT,tempstr) IF stat<0 THEN RETURN stat + IF StrLen(tempstr)=0 THEN RETURN RESULT_FAILURE + IF (StrLen(tempstr)<>1) AND (strCmpi(tempstr,loggedOnUserMisc.internetName,ALL)=FALSE) aePuts('\b\nChecking for duplicate name...') stat:=checkForAst(tempstr) @@ -25666,9 +25781,6 @@ PROC processLoggedOnUser() ENDIF IF (stat) AND (reqState=REQ_STATE_NONE) stat:=confScan() - IF stat=RESULT_SUCCESS - stat:=captureRealAndInternetNames() - ENDIF IF stat=RESULT_SUCCESS subState.subState:=SUBSTATE_DISPLAY_CONF_BULL ELSE @@ -25678,7 +25790,7 @@ PROC processLoggedOnUser() reqState:=REQ_STATE_LOGOFF ENDIF ELSEIF subState.subState=SUBSTATE_DISPLAY_CONF_BULL - joinConf(loggedOnUser.confRJoin,1,FALSE,FORCE_MAILSCAN_SKIP) + joinConf(loggedOnUser.confRJoin,loggedOnUser.msgBaseRJoin,FALSE,FORCE_MAILSCAN_SKIP) loadFlagged() IF StrLen(historyFolder)>0 THEN loadHistory() blockOLM:=FALSE @@ -25846,22 +25958,70 @@ ENDPROC 0 PROC checkPassword() - DEF tries=0,stat,lfh + DEF tries=0,stat,lfh,i,r DEF tempStr[255]:STRING DEF tempStr2[255]:STRING + DEF resetCode[25]:STRING + DEF resetChars[62]:STRING WHILE TRUE displayUserToCallersLog(0) REPEAT + StrCopy(resetCode,'') IF(tries>2) aePuts('\b\nExcessive Password Failure\b\n') - runSysCommand('PWFAIL','') - JUMP logoffErr + + IF checkToolTypeExists(TOOLTYPE_BBSCONFIG,'','MAIL_ON_PWD_FAIL') AND (StrLen(mailOptions.smtpHost)>0) AND (StrLen(loggedOnUserMisc.eMail)>0) + + aePuts('\b\nDo you want to send a reset code to your email address ') + stat:=yesNo(1) + IF(stat<0) THEN RETURN RESULT_SLEEP_LOGOFF + IF stat + FOR i:=1 TO 10 + StrCopy(resetChars,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789') + r:=Rnd(StrLen(resetChars)) + StrAdd(resetCode,resetChars+r,1) + ENDFOR + + StringF(tempStr,'\s: Ami-Express password failure notification',cmds.bbsName) + StrCopy(tempStr2,'You have forgotten your password and requested a reset code. If you did not request the reset code then please ignore this email\b\n\b\n') + StrAdd(tempStr2,'The reset code is : ') + StrAdd(tempStr2,resetCode) + StrAdd(tempStr2,'\b\n\b\nYou can use this code to reset your password and gain access to the system\b\n') + sendMail(tempStr,tempStr2,FALSE,NIL,0,loggedOnUserMisc.eMail) + + aePuts('\b\nA reset code has been sent to yuour email address. Please enter it exactly below\b\n\b\n') + stat:=lineInput('Reset code: ','',20,INPUT_TIMEOUT,tempStr) + IF(stat<0) THEN RETURN RESULT_SLEEP_LOGOFF + + IF StrCmp(tempStr,resetCode)=FALSE + aePuts('\b\nThe reset code was not correct.\b\n') + StrCopy(resetCode,'') + ELSE + aePuts('\b\nThe reset code was correct, please now update your password.\b\n\b\n') + aePuts('Password: ') + stat:=lineInput('','',50,INPUT_TIMEOUT,tempStr) + IF(stat<0) THEN RETURN RESULT_NO_CARRIER + IF(StrLen(tempStr)>0) + UpperStr(tempStr) + loggedOnUser.pwdHash:=calcPasswordHash(tempStr) + ENDIF + ENDIF + ENDIF + ENDIF + IF StrLen(resetCode)=0 + runSysCommand('PWFAIL','') + JUMP logoffErr + ENDIF ENDIF - stat:=getPass2(passwordPrompt,0,loggedOnUser.pwdHash,50,tempStr) - IF(stat<0) - IF stat=RESULT_NO_CARRIER THEN RETURN RESULT_NO_CARRIER ELSE RETURN RESULT_SLEEP_LOGOFF + IF StrLen(resetCode)=0 + stat:=getPass2(passwordPrompt,0,loggedOnUser.pwdHash,50,tempStr) + IF(stat<0) + IF stat=RESULT_NO_CARRIER THEN RETURN RESULT_NO_CARRIER ELSE RETURN RESULT_SLEEP_LOGOFF + ENDIF + ELSE + stat:=RESULT_SUCCESS ENDIF IF(stat<>RESULT_SUCCESS) StringF(tempStr2,'\tPassword Failure (\s)',tempStr) @@ -25869,6 +26029,7 @@ PROC checkPassword() aePuts('Invalid PassWord\b\n') tries++ ENDIF + UNTIL stat=RESULT_SUCCESS IF(checkToolTypeExists(TOOLTYPE_NODE,node,'PHONECHECK')) @@ -26293,7 +26454,7 @@ logonLoop: IF (checkToolTypeExists(TOOLTYPE_BBSCONFIG,0,'MAIL_ON_LOGON')) AND (StrLen(mailOptions.sysopEmail)>0) StringF(tempStr,'\s: Ami-Express logon notification',cmds.bbsName) StringF(tempStr2,'This is a notification that \s from \s has logged on\n\n',loggedOnUser.name,loggedOnUser.location) - sendMail(tempStr,tempStr2,TRUE, msgBuf,lines,mailOptions.sysopEmail) + sendMail(tempStr,tempStr2,FALSE, NIL,0,mailOptions.sysopEmail) ENDIF ENDIF @@ -26413,7 +26574,7 @@ PROC processAwait() ReleaseSemaphore(masterNode) ENDIF - IF (checkSer()) OR (sopt.trapDoor) OR (instantLogon) OR (checkTelnetConnection()) + IF (checkSer()) OR (sopt.trapDoor) OR (instantLogon) OR (checkTelnetConnection()) AND (reqState=REQ_STATE_NONE) IF checkIncomingCall()=RESULT_CONNECT debugLog(LOG_DEBUG,'REMOTE LOGON') ioFlags[IOFLAG_SCR_OUT]:=-1 @@ -26637,12 +26798,23 @@ jLoop3: JUMP jLoop2 ENDIF +jLoop4: + aePuts('E-Mail Address: ') + stat:=lineInput('','',50,INPUT_TIMEOUT,string) + IF(stat<0) THEN RETURN stat + strCpy(loggedOnUserMisc.eMail,string,50) + + IF(StrLen(loggedOnUserMisc.eMail)=0) + aePuts('\b\n') + JUMP jLoop3 + ENDIF + aePuts('Enter a PassWord: ') stat:=lineInput('','',50,INPUT_TIMEOUT,string) IF(stat<0) THEN RETURN stat IF(StrLen(string)=0) aePuts('\b\n') - JUMP jLoop3 + JUMP jLoop4 ENDIF UpperStr(string) loggedOnUser.pwdHash:=calcPasswordHash(string) @@ -26676,6 +26848,8 @@ jLoop3: aePuts(string) StringF(string,'Phone Num: \s\b\n',loggedOnUser.phoneNumber) aePuts(string) + StringF(string,'E-Mail : \s\b\n',loggedOnUserMisc.eMail) + aePuts(string) StringF(string,'Num Lines: \d\b\n',loggedOnUser.lineLength) aePuts(string) StringF(string,'PassWord : \s\b\n','ENCRYPTED') @@ -26812,6 +26986,7 @@ PROC initNewUser(userData:PTR TO user,userKeys: PTR TO userKeys,userMisc: PTR TO userData.secLibrary:=readToolTypeInt(TOOLTYPE_NODE_PRESET,1,'PRESET.RATIO') userData.timeLimit:=readToolTypeInt(TOOLTYPE_NODE_PRESET,1,'PRESET.TIME_LIMIT') userData.confRJoin:=readToolTypeInt(TOOLTYPE_NODE_PRESET,1,'PRESET.CONFRJOIN') + userData.msgBaseRJoin:=readToolTypeInt(TOOLTYPE_NODE_PRESET,1,'PRESET.MSGBASERJOIN') userData.dailyBytesLimit:=readToolTypeInt(TOOLTYPE_NODE_PRESET,1,'PRESET.DAILY_BYTE_LIMIT') readToolType(TOOLTYPE_NODE_PRESET,1,'PRESET.AREA',ttdata) ELSE @@ -26820,6 +26995,7 @@ PROC initNewUser(userData:PTR TO user,userKeys: PTR TO userKeys,userMisc: PTR TO userData.secLibrary:=readToolTypeInt(TOOLTYPE_PRESET,1,'PRESET.RATIO') userData.timeLimit:=readToolTypeInt(TOOLTYPE_PRESET,1,'PRESET.TIME_LIMIT') userData.confRJoin:=readToolTypeInt(TOOLTYPE_PRESET,1,'PRESET.CONFRJOIN') + userData.msgBaseRJoin:=readToolTypeInt(TOOLTYPE_PRESET,1,'PRESET.MSGBASERJOIN') userData.dailyBytesLimit:=readToolTypeInt(TOOLTYPE_PRESET,1,'PRESET.DAILY_BYTE_LIMIT') readToolType(TOOLTYPE_PRESET,1,'PRESET.AREA',ttdata) ENDIF @@ -26830,6 +27006,7 @@ PROC initNewUser(userData:PTR TO user,userKeys: PTR TO userKeys,userMisc: PTR TO userData.uploads:=0 userData.downloads:=0 IF(userData.confRJoin=NIL) THEN userData.confRJoin:=1 + IF(userData.msgBaseRJoin=NIL) THEN userData.msgBaseRJoin:=1 userData.timeLastOn:=0 userData.timeUsed:=0 userData.timeTotal:=userData.timeLimit @@ -26967,6 +27144,9 @@ ENDPROC PROC openZmodemStat() DEF tags,tags2,vi DEF tempstr[255]:STRING + DEF pubScreen[255]:STRING + DEF pubLock=0 + DEF pub=FALSE IF netMailTransfer IF zModemInfo.currentOperation=ZMODEM_DOWNLOAD @@ -26986,22 +27166,57 @@ PROC openZmodemStat() ENDIF ENDIF - tags:=NEW [WA_CLOSEGADGET,1, - WA_CUSTOMSCREEN,screen, - WA_SIZEGADGET,1, - WA_DRAGBAR,1, - WA_LEFT,170, - WA_TOP,45, - WA_WIDTH,350, - WA_HEIGHT,150, - WA_DETAILPEN,0, - WA_BLOCKPEN,7, - WA_TITLE, - zModemInfo.titleBar, - WA_IDCMP,IDCMP_CLOSEWINDOW, - WA_FLAGS,WFLG_ACTIVATE,NIL] - IF (windowZmodem=NIL) AND (screen<>NIL) + IF bitPlanes=0 + pub:=TRUE + ENDIF + + IF readToolType(TOOLTYPE_WINDOW,node,'WINDOW.PUBSCREEN',pubScreen) + pub:=TRUE + ENDIF + + IF pub + IF StrLen(pubScreen)>0 + pubLock:=LockPubScreen(pubScreen) + ELSE + pubLock:=LockPubScreen(NIL) + ENDIF + IF pubLock=FALSE THEN pub:=FALSE + ENDIF + + IF pub + tags:=NEW [WA_CLOSEGADGET,1, + WA_PUBSCREEN,pubLock, + WA_SIZEGADGET,1, + WA_DRAGBAR,1, + WA_LEFT,(window.width-350/2)+window.leftedge, + WA_TOP,(window.height-150/2)+window.topedge, + WA_WIDTH,350, + WA_HEIGHT,150, + WA_DETAILPEN,0, + WA_BLOCKPEN,7, + WA_TITLE, + zModemInfo.titleBar, + WA_IDCMP,IDCMP_CLOSEWINDOW, + WA_FLAGS,WFLG_ACTIVATE,NIL] + ELSE + tags:=NEW [WA_CLOSEGADGET,1, + WA_CUSTOMSCREEN,screen, + WA_SIZEGADGET,1, + WA_DRAGBAR,1, + WA_LEFT,(screen.width-350)/2, + WA_TOP,(screen.height-150)/2, + WA_WIDTH,350, + WA_HEIGHT,150, + WA_DETAILPEN,0, + WA_BLOCKPEN,7, + WA_TITLE, + zModemInfo.titleBar, + WA_IDCMP,IDCMP_CLOSEWINDOW, + WA_FLAGS,WFLG_ACTIVATE,NIL] + ENDIF + IF (windowZmodem=NIL) AND (scropen) windowZmodem:=OpenWindowTagList(NIL,tags) + IF pubLock THEN UnlockPubScreen(NIL,pubLock) initZmodemStatCon() IF (KickVersion(40) AND (bitPlanes>2)) THEN zmodemStatPrint('[ s') zmodemStatPrint('[0 p\n FileName:\n FileSize: 0\n ETA Time:\n Cur Time:\n Position: 0\n Complete: 0%\n LastTime:\n CPS: 0\n\n Z Status: Starting\n Errors: 0\n ErrorPos: 0') @@ -27033,6 +27248,17 @@ PROC openExpressScreen() IF scropen THEN RETURN + top:=sopt.topEdge + left:=sopt.leftEdge + width:=sopt.width + height:=sopt.height + bitPlanes:=sopt.bitPlanes + + IF bitPlanes=0 + StrCopy(pubScreen,'') + pub:=TRUE + ENDIF + IF readToolType(TOOLTYPE_WINDOW,node,'WINDOW.PUBSCREEN',pubScreen) pub:=TRUE ENDIF @@ -27051,37 +27277,6 @@ PROC openExpressScreen() dStatBar:=FALSE ->IF (checkToolTypeExists(TOOLTYPE_WINDOW,node,'WINDOW.STATBAR')) THEN toggleStatusDisplay() - /*width:=readToolTypeInt(TOOLTYPE_WINDOW,node,'WINDOW.WIDTH') - IF width=<1 THEN width:=640 - - height:=readToolTypeInt(TOOLTYPE_WINDOW,node,'WINDOW.HEIGHT') - IF height<1 THEN height:=256 - - top:=readToolTypeInt(TOOLTYPE_WINDOW,node,'WINDOW.TOPEDGE') - IF top<12 THEN top:=12 - - left:=readToolTypeInt(TOOLTYPE_WINDOW,node,'WINDOW.LEFTEDGE') - IF left<0 THEN left:=0 - - colourcount:=readToolTypeInt(TOOLTYPE_WINDOW,node,'WINDOW.NUM_COLORS') - SELECT colourcount - CASE 2 - bitPlanes:=1 - CASE 4 - bitPlanes:=2 - CASE 8 - bitPlanes:=3 - CASE 16 - bitPlanes:=4 - DEFAULT - bitPlanes:=3 - ENDSELECT*/ - top:=sopt.topEdge - left:=sopt.leftEdge - width:=sopt.width - height:=sopt.height - bitPlanes:=sopt.bitPlanes - IF fontHandle=NIL readToolType(TOOLTYPE_NODE,node,'EXPFONT',fontName) defaultfontattr.name:=fontName @@ -27140,7 +27335,7 @@ PROC openExpressScreen() WA_TOP,0, WA_LEFT,0, WA_WIDTH,18, - WA_HEIGHT,12, + WA_HEIGHT,screen.wbortop+screen.font.ysize+1, ->WA_DETAILPEN,0, ->WA_BLOCKPEN,blockpen, WA_IDCMP,IDCMP_CLOSEWINDOW,NIL] @@ -27175,10 +27370,10 @@ PROC openExpressScreen() IF (window) AND (fontHandle<>NIL) THEN SetFont(window.rport,fontHandle) ELSE opentags:=NEW [WA_BORDERLESS,1,WA_CUSTOMSCREEN,screen, - WA_TOP,top+12, + WA_TOP,top+screen.wbortop+screen.font.ysize+1, WA_LEFT,left, WA_WIDTH,width, - WA_HEIGHT,height-12, + WA_HEIGHT,height-(screen.wbortop+screen.font.ysize+1), ->WA_DETAILPEN,0, ->WA_BLOCKPEN,blockpen, WA_FLAGS,WFLG_ACTIVATE,NIL] @@ -27362,10 +27557,15 @@ PROC main() HANDLE DEF proc: PTR TO process StrCopy(expressVer,'v5.3.0-alpha',ALL) - StrCopy(expressDate,'28-Feb-2020',ALL) + StrCopy(expressDate,'12-Mar-2020',ALL) nodeStart:=getSystemTime() + ->initialise random seed from scanline position and node start time + p:=$dff006 + i:=Eor(Shl(p[0],8)+p[0],nodeStart) AND $FFFF + Rnd((Shl(i,16)+i) OR $80000000) + InitSemaphore(bgData) ->set windowptr to -1 to prevent any AmigaDOS insert volume dialogs @@ -27420,7 +27620,7 @@ PROC main() HANDLE 'ACS.CUSTOMCOMMANDS','ACS.JOIN_SUB_CONFERENCE','ACS.ZOOM_MAIL','ACS.MCI_MESSAGE','ACS.EDIT_DIRS','ACS.EDIT_FILES','ACS.BREAK_CHAT','ACS.QUIET_NODE','ACS.SYSOP_COMMANDS','ACS.WHO_IS_ONLINE', 'ACS.RELOGON','ACS.ULSTATS','ACS.XPR_RECEIVE','ACS.XPR_SEND','ACS.WILDCARDS','ACS.CONFERENCE_ACCOUNTING','ACS.PRI_MSGFILES','ACS.PUB_MSGFILES','ACS.FULL_EDIT','ACS.CONFFLAGS', 'ACS.OLM','ACS.HIDE_FILES','ACS.SHOW_PAYMENTS','ACS.CREDIT_ACCESS','ACS.VOTE','ACS.MODIFY_VOTE','ACS.FILE_EXPANSION','ACS.EDIT_REAL_NAME','ACS.EDIT_USER_NAME','ACS.CENSORED', - 'ACS.ACCOUNT_VIEW','ACS.TRANSLATION','ACS.UNKNOWN','ACS.CREATE_CONFERENCE','ACS.LOCAL_DOWNLOADS','ACS.MAX_PAGES','ACS.OVERRIDE_DEFAULTS','ACS.HOLD_ACCESS'] + 'ACS.ACCOUNT_VIEW','ACS.TRANSLATION','ACS.UNKNOWN','ACS.CREATE_CONFERENCE','ACS.LOCAL_DOWNLOADS','ACS.MAX_PAGES','ACS.OVERRIDE_DEFAULTS','ACS.HOLD_ACCESS','ACS.EDIT_EMAIL'] StringF(tempstr,'AmiExpress_Node.\d',node) @@ -28122,4 +28322,5 @@ threadtasksA4: regA4: LONG NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL - LONG NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL \ No newline at end of file + LONG NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL + \ No newline at end of file diff --git a/ftn.cfg b/ftn.cfg new file mode 100644 index 0000000..932b240 --- /dev/null +++ b/ftn.cfg @@ -0,0 +1,29 @@ +[MAIN] +MODE=BOTH +INBOUND=mail:inbound/ +INBOUNDINSEC=mail:inbound/ +OUTBOUND=mail:outbound/ +UNPACKCMD=lha x {filename} t:ftn/ +TEMPDIR=t:ftn/ + +[ORIGINNET] +ZONE= +NET= +NODE= + +[DESTNET] +ZONE= +NET= +NODE=0 + +[MISC] +PASSWORD= +TEAR=/X Tosser +ORIGIN=Phantasm BBS development system +COST=0 +ATTR=0 +TZOFFSET=0000 + +[CONFS] +TEST_AMY +bbs:Conf05/MsgBase.23/ diff --git a/ftn.e b/ftn.e new file mode 100644 index 0000000..f950b03 --- /dev/null +++ b/ftn.e @@ -0,0 +1,951 @@ + + MODULE 'dos/dos','dos/dostags','dos/datetime' + MODULE '*stringlist' + + DEF confNames=NIL:PTR TO stringlist + DEF msgBasePaths=NIL:PTR TO stringlist + + ENUM ERR_NOCFG,ERR_WRITE_MAILSTAT,ERR_READ_MESSAGES_DAT,ERR_READ_MAILSTAT,ERR_READ_HEADERFILE + + CONST RESULT_SUCCESS=-1,RESULT_FAILURE=0 + +OBJECT ftnHeader + msgdate[21]:ARRAY OF CHAR + to[37]:ARRAY OF CHAR + from[37]:ARRAY OF CHAR + subject[73]:ARRAY OF CHAR + confId[255]:ARRAY OF CHAR +ENDOBJECT + +OBJECT mailStat + lowestKey : LONG + highMsgNum : LONG + lowestNotDel : LONG + pad[6]:ARRAY OF CHAR +ENDOBJECT + +OBJECT mailHeader + status: CHAR + msgNumb: LONG + toName[31]: ARRAY OF CHAR + fromName[31]: ARRAY OF CHAR + subject[31]: ARRAY OF CHAR + msgDate: LONG + recv: LONG + pad: CHAR +ENDOBJECT + +PROC exec(fileName:PTR TO CHAR) + DEF tags,r + tags:=NEW [SYS_INPUT,0,SYS_OUTPUT,0,SYS_ASYNCH,FALSE,NIL]:LONG + r:=SystemTagList(fileName,tags) + IF r=-1 + WriteF('Error executing \s\n\n',fileName) + ENDIF + END tags +ENDPROC r + +PROC replacestr(sourcestring,searchtext,replacetext) + DEF newstring,tempstring,oldpos, pos,len + newstring:=String(255) + tempstring:=String(255) + len:=StrLen(searchtext) /* not estrlen since this is likely to be a hard coded constant */ + pos:=InStr(sourcestring,searchtext) + IF pos<>-1 + oldpos:=0 + WHILE pos<>-1 + IF pos<>oldpos + MidStr(tempstring,sourcestring,oldpos,pos-oldpos) + StrAdd(newstring,tempstring) + ENDIF + StrAdd(newstring,replacetext) + pos:=pos+len + oldpos:=pos + pos:=InStr(sourcestring,searchtext,oldpos) + ENDWHILE + pos:=EstrLen(sourcestring) + IF pos<>oldpos + MidStr(tempstring,sourcestring,oldpos,pos-oldpos) + StrAdd(newstring,tempstring) + ENDIF + StrCopy(sourcestring,newstring) + ENDIF + DisposeLink(newstring) + DisposeLink(tempstring) +ENDPROC + +PROC trimRight(src:PTR TO CHAR,dest:PTR TO CHAR) + DEF n,v=0 + StrCopy(dest,src) + n:=EstrLen(dest) + IF n>0 THEN v:=dest[n-1] + WHILE (n>0) AND (v=" ") + SetStr(dest,n-1) + n:=EstrLen(dest) + IF n>0 THEN v:=dest[n-1] + ENDWHILE +ENDPROC + +PROC fillStrCopy(src:PTR TO CHAR,dest:PTR TO CHAR,len) + DEF i + FOR i:=0 TO len-1 + dest[i]:=0 + ENDFOR + AstrCopy(dest,src,len) +ENDPROC + +PROC saveMh(fh,mailHeader) + DEF result + + result:=Write(fh,mailHeader,1) -> STATUS + result:=result+Write(fh,mailHeader+110,1) ->PAD + result:=result+Write(fh,mailHeader+2,4) ->MsgNum + result:=result+Write(fh,mailHeader+6,31) ->toName + result:=result+Write(fh,mailHeader+38,31) ->fromName + result:=result+Write(fh,mailHeader+70,31) ->subject + result:=result+Write(fh,mailHeader+110,1) ->PAD + result:=result+Write(fh,mailHeader+102,9) ->msgdate, recv & pad + result:=result+Write(fh,mailHeader+110,1) ->PAD +ENDPROC result + +PROC getMsgBasePath(confName,msgBasePath:PTR TO CHAR) + DEF i + FOR i:=0 TO confNames.count()-1 + IF StrCmp(confNames.item(i),confName) + StrCopy(msgBasePath,msgBasePaths.item(i),ALL) + ENDIF + ENDFOR +ENDPROC + +PROC createMessagePacket(originNode,destNode,originNet,destNet,originZone,destZone,originPoint,destPoint,attr,cost,packetPass:PTR TO CHAR,msgPktFilename:PTR TO CHAR, srcFilename:PTR TO CHAR,confId:PTR TO CHAR, tearLine:PTR TO CHAR, originLine:PTR TO CHAR,tzOffset:PTR TO CHAR) + DEF fh,fh2 + DEF tempStr[255]:STRING + DEF fromName[255]:STRING + DEF toName[255]:STRING + DEF subject[255]:STRING + DEF msgDateTime[255]:STRING + DEF msgbuf:PTR TO CHAR, msgsz + DEF mhdr[14]:ARRAY OF CHAR + DEF null[1]:ARRAY OF CHAR + DEF phdr[58]:ARRAY OF CHAR + DEF status,p,i + DEF year,month,day,hour,minute,second + DEF monthCodes[40]:STRING + + formatLongDateTime2(getSystemTime(),msgDateTime,",") + StrCopy(tempStr,msgDateTime,2) + month:=Val(tempStr) + StrCopy(tempStr,msgDateTime+3,2) + day:=Val(tempStr) + StrCopy(tempStr,msgDateTime+6,2) + year:=Val(tempStr) + IF year<38 THEN year:=year+2000 ELSE year:=year+1900 + StrCopy(tempStr,msgDateTime+9,2) + hour:=Val(tempStr) + StrCopy(tempStr,msgDateTime+12,2) + minute:=Val(tempStr) + StrCopy(tempStr,msgDateTime+15,2) + second:=Val(tempStr) + + fh:=Open(msgPktFilename,MODE_READWRITE) + + IF fh>0 + Seek(fh,0,OFFSET_END) + IF Seek(fh,0,OFFSET_CURRENT)=0 + + ->create packet header + phdr[0]:=originNode AND 255 + phdr[1]:=Shr(originNode,8) AND 255 + phdr[2]:=destNode AND 255 + phdr[3]:=Shr(destNode,8) AND 255 + phdr[4]:=year AND 255 + phdr[5]:=Shr(year,8) AND 255 + phdr[6]:=month AND 255 + phdr[7]:=Shr(month,8) AND 255 + phdr[8]:=day AND 255 + phdr[9]:=Shr(day,8) AND 255 + phdr[10]:=hour AND 255 + phdr[11]:=Shr(hour,8) AND 255 + phdr[12]:=minute AND 255 + phdr[13]:=Shr(minute,8) AND 255 + phdr[14]:=second AND 255 + phdr[15]:=Shr(second,8) AND 255 + phdr[16]:=0 ->baud low + phdr[17]:=0 ->baud hi + phdr[18]:=2 ->type + phdr[19]:=0 ->type + phdr[20]:=originNet AND 255 + phdr[21]:=Shr(originNet,8) AND 255 + phdr[22]:=destNet AND 255 + phdr[23]:=Shr(destNet,8) AND 255 + phdr[24]:=0 ->prodCode + phdr[25]:=1 ->prodVersionMajor + phdr[26]:=0;phdr[27]:=0;phdr[28]:=0;phdr[29]:=0; ->password + phdr[30]:=0;phdr[31]:=0;phdr[32]:=0;phdr[33]:=0; ->password + AstrCopy(phdr+26,packetPass,9) + phdr[34]:=originZone AND 255 + phdr[35]:=Shr(originZone,8) AND 255 + phdr[36]:=destZone AND 255 + phdr[37]:=Shr(destZone,8) AND 255 + phdr[38]:=0 ->reserved + phdr[39]:=0 ->reserved + phdr[40]:=0 ->capvalid + phdr[41]:=1 ->capvalid + phdr[42]:=1 ->prodcodehi + phdr[43]:=0 ->prodversionminor + phdr[44]:=1 ->capword + phdr[45]:=0 ->capword + phdr[46]:=originZone AND 255 + phdr[47]:=Shr(originZone,8) AND 255 + phdr[48]:=destZone AND 255 + phdr[49]:=Shr(destZone,8) AND 255 + phdr[50]:=originPoint AND 255 + phdr[51]:=Shr(originPoint,8) AND 255 + phdr[52]:=destPoint AND 255 + phdr[53]:=Shr(destPoint,8) AND 255 + phdr[54]:=0 + phdr[55]:=0 + phdr[56]:=0 + phdr[57]:=0 + + ->write packet header + Write(fh,phdr,58) + ENDIF + + fh2:=Open(srcFilename,MODE_OLDFILE) + IF fh2>0 + + ReadStr(fh2,fromName) + IF EstrLen(fromName)>35 THEN SetStr(fromName,35) + ReadStr(fh2,toName) + IF EstrLen(toName)>35 THEN SetStr(toName,35) + ReadStr(fh2,subject) + IF EstrLen(subject)>71 THEN SetStr(toName,71) + ReadStr(fh2,msgDateTime) + + p:=Seek(fh2,0,OFFSET_END) + msgsz:=Seek(fh2,p,OFFSET_BEGINNING)-p + + msgbuf:=New(msgsz) + Read(fh2,msgbuf,msgsz) + Close(fh2) + + status:=" " + + ->write message header + mhdr[0]:=2 + mhdr[1]:=0 + mhdr[2]:=originNode AND 255 + mhdr[3]:=Shr(originNode,8) AND 255 + mhdr[4]:=destNode AND 255 + mhdr[5]:=Shr(destNode,8) AND 255 + mhdr[6]:=originNet AND 255 + mhdr[7]:=Shr(originNet,8) AND 255 + mhdr[8]:=destNet AND 255 + mhdr[9]:=Shr(destNet,8) AND 255 + mhdr[10]:=attr AND 255 + mhdr[11]:=Shr(attr,8) AND 255 + mhdr[12]:=cost AND 255 + mhdr[13]:=Shr(cost,8) AND 255 + Write(fh,mhdr,14) + + null[0]:=0 + + StrCopy(monthCodes,'JanFebMarAprMayJunJulAugSepOctNovDec') + StrCopy(tempStr,msgDateTime,2) + month:=Val(tempStr)-1 + + StringF(tempStr,'\s[2] \s[3] \s[2] \s[2]:\s[2]:\s[2]',msgDateTime+3,monthCodes+(month*3),msgDateTime+6,msgDateTime+9,msgDateTime+12,msgDateTime+15) + Write(fh,tempStr,19) + Write(fh,null,1) + + Write(fh,toName,EstrLen(toName)) + Write(fh,null,1) + + Write(fh,fromName,EstrLen(fromName)) + Write(fh,null,1) + + Write(fh,subject,EstrLen(subject)) + Write(fh,null,1) + + + StringF(tempStr,'\cCHRS: LATIN-1 2\b',1) + Write(fh,tempStr,EstrLen(tempStr)) + + StringF(tempStr,'\cTZUTC: \s\b',1,IF StrLen(tzOffset)=0 THEN '0000' ELSE tzOffset) + Write(fh,tempStr,EstrLen(tempStr)) + + StringF(tempStr,'AREA:\s\b',confId) + Write(fh,tempStr,EstrLen(tempStr)) + + FOR i:=0 TO msgsz-1 + IF msgbuf[i]=10 THEN msgbuf[i]:=13 + ENDFOR + + ->write message body + Write(fh,msgbuf,msgsz) + + ->write tear line + StringF(tempStr,'--- \s\b',tearLine) + Write(fh,tempStr,EstrLen(tempStr)) + + ->write origin line + StringF(tempStr,' * Origin: \s\b',originLine) + Write(fh,tempStr,EstrLen(tempStr)) + + ->write seen by line + StringF(tempStr,'SEEN-BY: \d/\d \d/\d\b',originNet,originNode,destNet,destNode) + Write(fh,tempStr,EstrLen(tempStr)) + + ->nul terminate + StrCopy(tempStr,'') + Write(fh,tempStr,1) + + Dispose(msgbuf) + ENDIF + Close (fh) + ENDIF +ENDPROC + +PROC createMessagesBundle(originNode,destNode,originNet,destNet,originZone,destZone,originPoint,destPoint,attr,cost,packetPass,msgFilename:PTR TO CHAR,tearLine:PTR TO CHAR, originLine:PTR TO CHAR,tzOffset:PTR TO CHAR) + DEF i,fh + DEF msgOutPath[255]:STRING + DEF fBlock:PTR TO fileinfoblock + DEF fLock + DEF msgFile[255]:STRING + DEF null[2]:ARRAY OF CHAR + + IF(fBlock:=AllocDosObject(DOS_FIB,NIL)) + FOR i:=0 TO msgBasePaths.count()-1 + StringF(msgOutPath,'\sEXT-OUT',msgBasePaths.item(i)) + IF(fLock:=Lock(msgOutPath,ACCESS_READ)) + IF(Examine(fLock,fBlock)) + WHILE(ExNext(fLock,fBlock)) + StringF(msgFile,'\s/\s',msgOutPath,fBlock.filename) + createMessagePacket(originNode,destNode,originNet,destNet,originZone,destZone,originPoint,destPoint,attr,cost,packetPass,msgFilename,msgFile,confNames.item(i),tearLine,originLine,tzOffset) + SetProtection(msgFile,FIBF_OTR_DELETE) + DeleteFile(msgFile) + ENDWHILE + ENDIF + UnLock(fLock) + + ENDIF + ENDFOR + FreeDosObject(DOS_FIB,fBlock) + ENDIF + + IF FileLength(msgFilename)<>-1 + fh:=Open(msgFilename,MODE_READWRITE) + IF fh>0 + Seek(fh,0,OFFSET_END) + null[0]:=0 + null[1]:=0 + Write(fh,null,2) + Close(fh) + ENDIF + ENDIF + +ENDPROC + +PROC fileWriteLn(fh,str: PTR TO CHAR) + DEF stat + IF (stat:=fileWrite(fh,str))<>RESULT_SUCCESS THEN RETURN stat +ENDPROC fileWrite(fh,'\n') + +PROC fileWrite(fh,str: PTR TO CHAR) + DEF s + + s:=Write(fh,str,StrLen(str)) + IF s<>StrLen(str) THEN RETURN RESULT_FAILURE +ENDPROC RESULT_SUCCESS + +PROC formatLongDateTime2(cDateVal,outDateStr,seperatorChar) + DEF d : PTR TO datestamp + DEF dt : datetime + DEF datestr[10]:STRING + DEF timestr[10]:STRING + DEF r,dateVal + + dateVal:=cDateVal-21600 + + d:=dt.stamp + d.tick:=(dateVal-Mul(Div(dateVal,60),60)) + d.tick:=Mul(d.tick,50) + dateVal:=Div(dateVal,60) + d.days:=Div((dateVal),1440)-2922 ->-2922 days between 1/1/70 and 1/1/78 + d.minute:=dateVal-(Mul(d.days+2922,1440)) + + dt.format:=FORMAT_USA + dt.flags:=0 + dt.strday:=0 + dt.strdate:=datestr + dt.strtime:=timestr + + IF DateToStr(dt) + StringF(outDateStr,'\s\c\s',datestr,seperatorChar,timestr) + RETURN TRUE + ENDIF +ENDPROC FALSE + +->returns system time converted to c time format +PROC getSystemTime() + DEF currDate: datestamp + DEF startds:PTR TO datestamp + DEF s1,s2,s3,s4 + + startds:=DateStamp(currDate) + + s1:=startds.days+2922 + s1:=Mul(1440,s1) + s1:=Mul(60,s1) + s2:=Mul(60,startds.minute) + s3:=startds.tick/50 + s4:=Mul(Mul(startds.days+2922,1440),60)+(startds.minute*60)+(startds.tick/50) + + ->2922 days between 1/1/70 and 1/1/78 + +ENDPROC s4+21600 + +PROC getEncodedDate(dateStr:PTR TO CHAR) + DEF dt:datetime + DEF tempStr[30]:STRING + DEF strDate[20]:STRING + DEF strTime[20]:STRING + DEF dval + + + StrCopy(strDate,TrimStr(dateStr),9) + strDate[2]:="-" + strDate[6]:="-" + + StrCopy(tempStr,dateStr) + RightStr(strTime,tempStr,8) + + dt.format:=FORMAT_DOS + dt.flags:=0 + dt.strday:=0 + dt.strdate:=strDate + dt.strtime:=strTime + + IF StrToDate(dt)=0 THEN RETURN 0 + + dval:=Mul(Mul(dt.stamp.days+2922,1440),60)+(dt.stamp.minute*60)+(dt.stamp.tick/50) + + ->2922 days between 1/1/70 and 1/1/78 + +ENDPROC dval+21600 + +PROC readString(fileHandle,buffer,maxLength) + DEF char,cnt,i + + cnt:=0 + FOR i:=0 TO maxLength-1 DO buffer[i]:=0 + + REPEAT + char:=FgetC(fileHandle) + IF (char=-1) OR (char=0) THEN RETURN + buffer[cnt]:=char + cnt++ + UNTIL (cnt=maxLength) +ENDPROC + +PROC findBodyLength(fileHandle) + DEF cnt,char + cnt:=0 + REPEAT + char:=FgetC(fileHandle) + IF char<>-1 THEN cnt++ + UNTIL char<=0 + Seek(fileHandle,-cnt,OFFSET_CURRENT) +ENDPROC cnt + +PROC processPacketFile(filename:PTR TO CHAR) HANDLE + DEF ftnh: ftnHeader + DEF ms: mailStat + DEF mh: mailHeader + DEF buf=0:PTR TO CHAR + DEF buf2=0:PTR TO CHAR,bufsz + DEF mf=0,fh=0,fh2=0 + DEF n,c,i,i2 + DEF tempStr[255]:STRING + DEF newMsgNum + DEF fname[255]:STRING + DEF msgBase[255]:STRING + DEF ftnConfId[255]:STRING + DEF lastConfId[255]:STRING + DEF needToSave + + needToSave:=FALSE + StrCopy(lastConfId,'######') + + mf:=Open(filename,MODE_OLDFILE) + IF mf>0 + Seek(mf,58,OFFSET_BEGINNING) + buf:=New(35) + c:=0 + REPEAT + n:=Fread(mf,buf,2,1) + IF (buf[0]=2) AND (buf[1]=0) + n:=Fread(mf,buf+2,32,1) + buf[34]:=0 + IF n>0 + + AstrCopy(ftnh.msgdate,buf+14,21) + + readString(mf,ftnh.to,36) + readString(mf,ftnh.from,36) + readString(mf,ftnh.subject,72) + + bufsz:=findBodyLength(mf) + + buf2:=New(bufsz+1) + Fread(mf,buf2,bufsz,1) + + StrCopy(tempStr,'') + n:=0 + WHILE (n0) AND (buf2[n]<>10) AND (buf2[n]<>13) + StrAdd(tempStr,buf2+n,1) + n++ + ENDWHILE + WHILE (n0 + Close(fh) + fh:=0 + ENDIF + IF needToSave + ms.highMsgNum:=newMsgNum+1 + StringF(fname,'\sMailStats',msgBase) + fh:=Open(fname,MODE_NEWFILE) + IF fh>0 + Write(fh,ms,SIZEOF mailStat) + Close(fh) + fh:=0 + ELSE + WriteF('Error saving MailStats\n\n') + Raise(ERR_WRITE_MAILSTAT) + ENDIF + needToSave:=FALSE + ENDIF + + getMsgBasePath(ftnh.confId,msgBase) + IF StrLen(msgBase)=0 + WriteF('FTN conf \s not configured, skipping messages for this conf\n\n',ftnh.confId) + StrCopy(ftnConfId,'######') + ELSE + StrCopy(ftnConfId,ftnh.confId) + + StringF(fname,'\sMailStats',msgBase) + IF fh>0 THEN Close(fh) + fh:=Open(fname,MODE_READWRITE) + IF fh>0 + IF Read(fh,ms,SIZEOF mailStat)=0 + ms.lowestKey:=1 + ms.lowestNotDel:=1 + ms.highMsgNum:=1 + ms.pad[0]:=0;ms.pad[1]:=0;ms.pad[2]:=0;ms.pad[3]:=0;ms.pad[4]:=0;ms.pad[5]:=0 + Write(fh,ms,SIZEOF mailStat) + Close(fh) + fh:=0 + ELSE + Close(fh) + fh:=0 + ENDIF + ELSE + WriteF('Error opening MailStats (\s)\n\n',fname) + Raise(ERR_READ_MAILSTAT) + ENDIF + + newMsgNum:=ms.highMsgNum-1 + StringF(fname,'\sHeaderFile',msgBase) + fh:=Open(fname,MODE_READWRITE) + IF fh>0 + Seek(fh,0,OFFSET_END) + ELSE + WriteF('Error opening HeaderFile\n\n') + Raise(ERR_READ_HEADERFILE) + ENDIF + + ENDIF + + ENDIF + + StrCopy(lastConfId,ftnh.confId) + + IF StrCmp(ftnh.confId,ftnConfId) + newMsgNum++ + + mh.pad:=0 + mh.status:="P" + mh.msgNumb:=newMsgNum + + trimRight(ftnh.to,tempStr) + fillStrCopy(tempStr,mh.toName,31) + + trimRight(ftnh.from,tempStr) + fillStrCopy(tempStr,mh.fromName,31) + + trimRight(ftnh.subject,tempStr) + fillStrCopy(tempStr,mh.subject,31) + + mh.msgDate:=getEncodedDate(ftnh.msgdate) + mh.recv:=0 + + IF saveMh(fh,mh)<>110 + WriteF('Error saving mail header for message \d\n',newMsgNum) + ENDIF + + needToSave:=TRUE + + StringF(fname,'\s\d',msgBase,newMsgNum) + fh2:=Open(fname,MODE_NEWFILE) + IF fh2>0 + i:=n + n:=0 + WHILE i10 + buf2[n]:=buf2[i] + n++ + ENDIF + i++ + ENDWHILE + FOR i:=0 TO n-1 + IF buf2[i]=13 THEN buf2[i]:=10 + ENDFOR + + i:=0 + i2:=0 + StrCopy(tempStr,'') + WHILE (i10) + StrAdd(tempStr,buf2+i,1) + i++ + ELSE + StrAdd(tempStr,'\n') + IF (StrCmp(TrimStr(tempStr),'SEEN-BY: ',9)=FALSE) AND (StrCmp(TrimStr(tempStr),'AREA: ',6)=FALSE) AND (tempStr[0]<>1) THEN Write(fh2,tempStr,StrLen(tempStr)) + StrCopy(tempStr,'') + i++ + ENDIF + ENDWHILE + IF (StrLen(tempStr)>0) AND (StrCmp(TrimStr(tempStr),'SEEN-BY: ',9)=FALSE) AND (StrCmp(TrimStr(tempStr),'AREA: ',6)=FALSE) AND (tempStr[0]<>1) THEN Write(fh2,tempStr,StrLen(tempStr)) + Close(fh2) + fh2:=0 + ELSE + WriteF('Error saving message body for message \d\n\n',newMsgNum) + ENDIF + Dispose(buf2) + buf2:=0 + ELSE + Seek(mf,bufsz,OFFSET_CURRENT) + ENDIF + ENDIF + n:=1 + c++ + ELSEIF (buf[0]=0) AND (buf[1]=0) + ->double null indicates no more data + n:=0 + ELSE + WriteF('Error reading message header from \s invalid message type found\n\n',filename) + Raise(ERR_READ_MESSAGES_DAT) + ENDIF + UNTIL (n=0) OR (CtrlC()) + + Close(fh) + fh:=0 + + IF needToSave + ms.highMsgNum:=newMsgNum+1 + StringF(fname,'\sMailStats',msgBase) + fh:=Open(fname,MODE_NEWFILE) + IF fh>0 + Write(fh,ms,SIZEOF mailStat) + Close(fh) + fh:=0 + ELSE + WriteF('Error saving MailStats\n\n') + Raise(ERR_WRITE_MAILSTAT) + ENDIF + needToSave:=FALSE + ENDIF + + IF mf>0 THEN Close(mf) + mf:=0 + RETURN TRUE + + ELSE + WriteF('Error opening \s\n\n',filename) + Raise(ERR_READ_MESSAGES_DAT) + ENDIF +EXCEPT DO + IF fh>0 THEN Close(fh) + IF fh2>0 THEN Close(fh2) + IF mf>0 THEN Close(mf) + IF buf<>0 THEN Dispose(buf) + IF buf2<>0 THEN Dispose(buf2) +ENDPROC + +PROC processPackets(scanPath:PTR TO CHAR) + DEF packetFilename[255]:STRING + DEF fname[255]:STRING + DEF fBlock:PTR TO fileinfoblock + DEF tempStr[255]:STRING + DEF fLock + + IF(fBlock:=AllocDosObject(DOS_FIB,NIL)) + IF(fLock:=Lock(scanPath,ACCESS_READ)) + + IF(Examine(fLock,fBlock)) + WHILE(ExNext(fLock,fBlock)) + StrCopy(fname,fBlock.filename) + RightStr(tempStr,fname,4) + UpperStr(tempStr) + IF StrCmp(tempStr,'.PKT') + StringF(packetFilename,'\s\s',scanPath,fBlock.filename) + IF processPacketFile(packetFilename) + SetProtection(packetFilename,FIBF_OTR_DELETE) + DeleteFile(packetFilename) + ENDIF + ENDIF + ENDWHILE + ENDIF + UnLock(fLock) + ENDIF + FreeDosObject(DOS_FIB,fBlock) + ENDIF +ENDPROC + +PROC processBundles(unpackCommand:PTR TO CHAR, scanPath:PTR TO CHAR, tempDir:PTR TO CHAR) + DEF cleanUp[255]:STRING + DEF unpack[255]:STRING + DEF fname[255]:STRING + DEF fBlock:PTR TO fileinfoblock + DEF tempStr[255]:STRING + DEF bundleFilename[255]:STRING + DEF fLock + + IF(fBlock:=AllocDosObject(DOS_FIB,NIL)) + IF(fLock:=Lock(scanPath,ACCESS_READ)) + + IF(Examine(fLock,fBlock)) + WHILE(ExNext(fLock,fBlock)) + IF fBlock.direntrytype < 0 + StrCopy(fname,fBlock.filename) + RightStr(tempStr,fname,4) + UpperStr(tempStr) + IF StrCmp(tempStr,'.PKT')=FALSE + StringF(bundleFilename,'\s\s',scanPath,fBlock.filename) + + StrCopy(unpack,unpackCommand) + replacestr(unpack,'{filename}',bundleFilename) + exec(unpack) + processPackets(tempDir) + StringF(cleanUp,'delete \s ALL',tempDir) + exec(cleanUp) + + SetProtection(bundleFilename,FIBF_OTR_DELETE) + DeleteFile(bundleFilename) + ENDIF + ENDIF + ENDWHILE + ENDIF + UnLock(fLock) + ENDIF + FreeDosObject(DOS_FIB,fBlock) + ENDIF + + + +ENDPROC + +PROC trimStr(src:PTR TO CHAR) + DEF i + DEF tempStr[255]:STRING + + StrCopy(tempStr,TrimStr(src)) + + i:=EstrLen(tempStr)-1 + WHILE (i>=0) + IF tempStr[i]<>" " + i:=-1 + ELSE + SetStr(tempStr,i) + i-- + ENDIF + ENDWHILE + + StrCopy(src,tempStr) +ENDPROC + +PROC processConfigLine(inString,categoryStr,optName,optValue) + DEF t[255]:STRING + DEF l + StrCopy(t,inString) + trimStr(t) + l:=EstrLen(t) + IF l>1 + IF (t[0]="[") AND (t[l-1]="]") + StrCopy(categoryStr,t+1,l-2) + trimStr(categoryStr) + UpperStr(categoryStr) + StrCopy(optName,'') + StrCopy(optValue,'') + RETURN + ENDIF + ENDIF + l:=InStr(t,'=') + IF l>0 + StrCopy(optName,t,l) + trimStr(optName) + UpperStr(optName) + StrCopy(optValue,t+l+1,ALL) + trimStr(optValue) + ELSE + StrCopy(optName,'') + StrCopy(optValue,'') + ENDIF +ENDPROC + +PROC main() HANDLE + DEF mode[255]:STRING + DEF inboundDir[255]:STRING + DEF inboundInsecureDir[255]:STRING + DEF outboundDir[255]:STRING + + DEF ftnUnpackCommand[255]:STRING + + DEF tempDir[255]:STRING + + DEF cmdCopy[255]:STRING + + DEF pktPass[8]:STRING + + DEF cfgFile[255]:STRING + DEF myargs:PTR TO LONG,rdargs + + DEF fh,lock + DEF tempStr[255]:STRING + DEF msgBundleFilename[255]:STRING + DEF msgPacketFilename[255]:STRING + DEF dow[3]:STRING + + DEF category[255]:STRING + DEF optionName[255]:STRING + DEF optionValue[255]:STRING + + DEF originNode,destNode,originNet,destNet,originZone,destZone,originPoint,destPoint,attr,cost + DEF tearLine[255]:STRING + DEF originLine[255]:STRING + DEF tzOffset[10]:STRING + + WriteF('Ami-Express FTN file processor Copyright 2020 Darren Coles\n') + + myargs:=[0,0]:LONG + IF rdargs:=ReadArgs('CFG/A',myargs,NIL) + IF myargs[0]<>NIL + AstrCopy(cfgFile,myargs[0],255) + ENDIF + FreeArgs(rdargs) + ELSE + RETURN + ENDIF + + confNames:=NEW confNames.stringlist(100) + msgBasePaths:=NEW msgBasePaths.stringlist(100) + + fh:=Open(cfgFile,MODE_OLDFILE) + IF fh>0 + + REPEAT + ReadStr(fh,tempStr) + processConfigLine(tempStr,category,optionName,optionValue) + + IF StrCmp('MAIN',category) AND StrCmp('MODE',optionName) THEN StrCopy(mode,optionValue) + IF StrCmp('MAIN',category) AND StrCmp('INBOUND',optionName) THEN StrCopy(inboundDir,optionValue) + IF StrCmp('MAIN',category) AND StrCmp('INBOUNDINSEC',optionName) THEN StrCopy(inboundInsecureDir,optionValue) + IF StrCmp('MAIN',category) AND StrCmp('OUTBOUND',optionName) THEN StrCopy(outboundDir,optionValue) + IF StrCmp('MAIN',category) AND StrCmp('UNPACKCMD',optionName) THEN StrCopy(ftnUnpackCommand,optionValue) + IF StrCmp('MAIN',category) AND StrCmp('TEMPDIR',optionName) THEN StrCopy(tempDir,optionValue) + + IF StrCmp('ORIGINNET',category) AND StrCmp('ZONE',optionName) THEN originZone:=Val(optionValue) + IF StrCmp('ORIGINNET',category) AND StrCmp('NET',optionName) THEN originNet:=Val(optionValue) + IF StrCmp('ORIGINNET',category) AND StrCmp('NODE',optionName) THEN originNode:=Val(optionValue) + + IF StrCmp('DESTNET',category) AND StrCmp('ZONE',optionName) THEN destZone:=Val(optionValue) + IF StrCmp('DESTNET',category) AND StrCmp('NET',optionName) THEN destNet:=Val(optionValue) + IF StrCmp('DESTNET',category) AND StrCmp('NODE',optionName) THEN destNode:=Val(optionValue) + + IF StrCmp('MISC',category) AND StrCmp('PASSWORD',optionName) THEN StrCopy(pktPass,optionValue) + IF StrCmp('MISC',category) AND StrCmp('COST',optionName) THEN cost:=Val(optionValue) + IF StrCmp('MISC',category) AND StrCmp('ATTR',optionName) THEN attr:=Val(optionValue) + IF StrCmp('MISC',category) AND StrCmp('TEAR',optionName) THEN StrCopy(tearLine,optionValue) + IF StrCmp('MISC',category) AND StrCmp('ORIGIN',optionName) THEN StrCopy(originLine,optionValue) + IF StrCmp('MISC',category) AND StrCmp('TZOFFSET',optionName) THEN StrCopy(tzOffset,optionValue) + UNTIL StrCmp(category,'CONFS') + UpperStr(mode) + + WHILE(ReadStr(fh,tempStr)<>-1) OR (StrLen(tempStr)>0) + confNames.add(tempStr) + ReadStr(fh,tempStr) + msgBasePaths.add(tempStr) + ENDWHILE + Close(fh) + fh:=0 + ELSE + WriteF('Error opening FTN.cfg\n\n') + Raise(ERR_NOCFG) + ENDIF + + IF StrCmp(mode,'OUT') OR StrCmp(mode,'BOTH') + WriteF('Processing outgoing messages\n') + + ->remove trailing slash + StrCopy(tempStr,tempDir,StrLen(tempDir)-1) + + IF (lock:=CreateDir(tempStr)) THEN UnLock(lock) + + StringF(msgPacketFilename,'\s\z\h[4]\z\h[4].Out',tempDir,destNet,destNode) + + ->create messages bundle by scraping confs + createMessagesBundle(originNode,destNode,originNet,destNet,originZone,destZone,originPoint,destPoint,attr,cost,pktPass,msgPacketFilename,tearLine,originLine,tzOffset) + + IF FileLength(msgPacketFilename)<>-1 + StringF(cmdCopy,'copy \s \s',msgPacketFilename,outboundDir) + IF exec(cmdCopy)=0 + DeleteFile(msgPacketFilename) + ELSE + WriteF('Failure when copying message bundle to outbound folder\n\n') + ENDIF + ELSE + WriteF('No messages to post\n\n') + ENDIF + ENDIF + + IF StrCmp(mode,'IN') OR StrCmp(mode,'BOTH') + WriteF('Processing incoming messages\n') + IF StrLen(inboundDir)>0 THEN processBundles(ftnUnpackCommand,inboundDir,tempDir) + IF StrLen(inboundInsecureDir)>0 THEN processBundles(ftnUnpackCommand,inboundInsecureDir,tempDir) + IF StrLen(inboundDir)>0 THEN processPackets(inboundDir) + IF StrLen(inboundInsecureDir)>0 THEN processPackets(inboundInsecureDir) + ENDIF + WriteF('All done\n') + +EXCEPT DO + IF confNames<>NIL THEN END confNames + IF msgBasePaths<>NIL THEN END msgBasePaths +ENDPROC \ No newline at end of file diff --git a/qwk.cfg b/qwk.cfg new file mode 100644 index 0000000..030d433 --- /dev/null +++ b/qwk.cfg @@ -0,0 +1,84 @@ +[MAIN] +MODE=OUT +BBSNAME=My BBS +BBSLOCATION=UK +BBSNUMBER=XXX-XXX-XXXX +BBSID=FREEWAY +SYSOPNAME=me +USERNAME=username +GETCMD=curl -o t:qwk.zip ftp://myusername:mysecretpass@freeway.apana.org/freeway.qwk +PUTCMD=curl -T t:{bbsid}.rep ftp://myusername:mypassword@freeway.apana.org/freeway.rep +UNPACKCMD=unzip t:qwk.zip MESSAGES.DAT -d t: +PACKCMD=zip t:{bbsid}.rep t:{bbsid}.MSG t:CONTROL.DAT +PACKEDTEMP=t:qwk.zip +MSGTEMP=t:MESSAGES.DAT +CONTROLTEMP=t:CONTROL.DAT +MSGFILE=t:{bbsid}.MSG +REPFILE=t:{bbsid}.rep +[CONFS] +11001 +RTN COMMOD +bbs:Conf05/MsgBase.1/ +11002 +RTN AMIGA +bbs:Conf05/MsgBase.2/ +11003 +RTN COL AD +bbs:Conf05/MsgBas +11004 +RTN ATARIP +bbs:Conf05/MsgBase.4/ +11005 +RTN BBSADS +bbs:Conf05/MsgBase.5/ +11006 +RTN GENERA +bbs:Conf05/MsgBase.6/ +11007 +RTN BUY SE +bbs:Conf05/MsgBase.7/ +11008 +RTN TEST +bbs:Conf05/MsgBase.8/ +11009 +RTN PC ALL +bbs:Conf05/MsgBase.9/ +11010 +RTN CONSOL +bbs:Conf05/MsgBase.10/ +11011 +RTN ADM +bbs:Conf05/MsgBase.11/ +11012 +RTN SUGGES +bbs:Conf05/MsgBase.12/ +11013 +RTN EMULAT +bbs:Conf05/MsgBase.13/ +11014 +RTN SINCLA +bbs:Conf05/MsgBase.14/ +11015 +RTN MSDOS +bbs:Conf05/MsgBase.15/ +11016 +RTN APPLE +bbs:Conf05/MsgBase.16/ +11017 +RTN RETROP +bbs:Conf05/MsgBase.17/ +11018 +RTN MAINFR +bbs:Conf05/MsgBase.18/ +11019 +RTN MYSTIC +bbs:Conf05/MsgBase.19/ +11020 +RTN SYNC +bbs:Conf05/MsgBase.20/ +11021 +RTN TI +bbs:Conf05/MsgBase.21/ +11022 +RTN CNET +bbs:Conf05/MsgBase.22/ \ No newline at end of file diff --git a/qwk.e b/qwk.e new file mode 100644 index 0000000..180e0b7 --- /dev/null +++ b/qwk.e @@ -0,0 +1,754 @@ + + MODULE 'dos/dos','dos/dostags','dos/datetime' + MODULE '*stringlist' + + DEF confIds=NIL:PTR TO stringlist + DEF confNames=NIL:PTR TO stringlist + DEF msgBasePaths=NIL:PTR TO stringlist + DEF bbsName[255]:STRING + DEF bbsLocation[255]:STRING + DEF bbsNumber[255]:STRING + DEF sysopName[255]:STRING + DEF userName[255]:STRING + DEF bbsId[255]:STRING + DEF msgNum + + ENUM ERR_NOCFG,ERR_QWK_GRAB,ERR_QWK_UNPACK,ERR_QWK_PACK,ERR_WRITE_MAILSTAT,ERR_READ_MESSAGES_DAT,ERR_READ_MAILSTAT,ERR_READ_HEADERFILE + + CONST RESULT_SUCCESS=-1,RESULT_FAILURE=0 + +OBJECT qwkHeader + status:CHAR + num:LONG + to[26]:ARRAY OF CHAR + msgdate[14]:ARRAY OF CHAR + from[26]:ARRAY OF CHAR + subject[26]:ARRAY OF CHAR + password[13]:ARRAY OF CHAR + inReplyTo:LONG + blockCount:LONG + active: CHAR + confNum: INT + relativeMsgNum: INT + netTag: CHAR +ENDOBJECT + +OBJECT mailStat + lowestKey : LONG + highMsgNum : LONG + lowestNotDel : LONG + pad[6]:ARRAY OF CHAR +ENDOBJECT + +OBJECT mailHeader + status: CHAR + msgNumb: LONG + toName[31]: ARRAY OF CHAR + fromName[31]: ARRAY OF CHAR + subject[31]: ARRAY OF CHAR + msgDate: LONG + recv: LONG + pad: CHAR +ENDOBJECT + +PROC exec(fileName:PTR TO CHAR) + DEF tags,r + tags:=NEW [SYS_INPUT,0,SYS_OUTPUT,0,SYS_ASYNCH,FALSE,NIL]:LONG + r:=SystemTagList(fileName,tags) + IF r=-1 + WriteF('Error executing \s\n\n',fileName) + ENDIF + END tags +ENDPROC r + +PROC replacestr(sourcestring,searchtext,replacetext) + DEF newstring,tempstring,oldpos, pos,len + newstring:=String(255) + tempstring:=String(255) + len:=StrLen(searchtext) /* not estrlen since this is likely to be a hard coded constant */ + pos:=InStr(sourcestring,searchtext) + IF pos<>-1 + oldpos:=0 + WHILE pos<>-1 + IF pos<>oldpos + MidStr(tempstring,sourcestring,oldpos,pos-oldpos) + StrAdd(newstring,tempstring) + ENDIF + StrAdd(newstring,replacetext) + pos:=pos+len + oldpos:=pos + pos:=InStr(sourcestring,searchtext,oldpos) + ENDWHILE + pos:=EstrLen(sourcestring) + IF pos<>oldpos + MidStr(tempstring,sourcestring,oldpos,pos-oldpos) + StrAdd(newstring,tempstring) + ENDIF + StrCopy(sourcestring,newstring) + ENDIF + DisposeLink(newstring) + DisposeLink(tempstring) +ENDPROC + +PROC trimRight(src:PTR TO CHAR,dest:PTR TO CHAR) + DEF n,v=0 + StrCopy(dest,src) + n:=EstrLen(dest) + IF n>0 THEN v:=dest[n-1] + WHILE (n>0) AND (v=" ") + SetStr(dest,n-1) + n:=EstrLen(dest) + IF n>0 THEN v:=dest[n-1] + ENDWHILE +ENDPROC + +PROC fillStrCopy(src:PTR TO CHAR,dest:PTR TO CHAR,len) + DEF i + FOR i:=0 TO len-1 + dest[i]:=0 + ENDFOR + AstrCopy(dest,src,len) +ENDPROC + +PROC saveMh(fh,mailHeader) + DEF result + + result:=Write(fh,mailHeader,1) -> STATUS + result:=result+Write(fh,mailHeader+110,1) ->PAD + result:=result+Write(fh,mailHeader+2,4) ->MsgNum + result:=result+Write(fh,mailHeader+6,31) ->toName + result:=result+Write(fh,mailHeader+38,31) ->fromName + result:=result+Write(fh,mailHeader+70,31) ->subject + result:=result+Write(fh,mailHeader+110,1) ->PAD + result:=result+Write(fh,mailHeader+102,9) ->msgdate, recv & pad + result:=result+Write(fh,mailHeader+110,1) ->PAD +ENDPROC result + +PROC getMsgBasePath(confNum,msgBasePath:PTR TO CHAR) + DEF i + FOR i:=0 TO confIds.count()-1 + IF Val(confIds.item(i))=confNum + StrCopy(msgBasePath,msgBasePaths.item(i),ALL) + ENDIF + ENDFOR +ENDPROC + +PROC createMessageDat2(confNum,msgDatFilename:PTR TO CHAR, srcFilename:PTR TO CHAR) + DEF fh,fh2 + DEF tempStr[255]:STRING + DEF fromName[255]:STRING + DEF toName[255]:STRING + DEF subject[255]:STRING + DEF msgDateTime[255]:STRING + DEF msgDate[10]:STRING + DEF msgTime[10]:STRING + DEF msgbuf, msgsz,bufsz + DEF status,p,i + fh:=Open(msgDatFilename,MODE_READWRITE) + + IF fh>0 + Seek(fh,0,OFFSET_END) + IF Seek(fh,0,OFFSET_CURRENT)=0 + StringF(tempStr,'\l\s[128]',bbsId,'') + Write(fh,tempStr,128) + ENDIF + + fh2:=Open(srcFilename,MODE_OLDFILE) + IF fh2>0 + + ReadStr(fh2,fromName) + ReadStr(fh2,toName) + ReadStr(fh2,subject) + ReadStr(fh2,msgDateTime) + + p:=Seek(fh2,0,OFFSET_END) + msgsz:=Seek(fh2,p,OFFSET_BEGINNING)-p + + bufsz:=(msgsz+127)/128*128 + msgbuf:=New(bufsz) + Read(fh2,msgbuf,msgsz) + FOR i:=msgsz TO bufsz-1 DO msgbuf[i]:=32 + Close(fh2) + + status:=" " + StrCopy(msgDate,msgDateTime,8) + IF (p:=InStr(msgDateTime,' '))>=0 + StrCopy(msgTime,msgDateTime+p+1,5) + ELSE + StrCopy(msgTime,'') + ENDIF + + StringF(tempStr,'\c\l\d[7]\l\s[8]\l\s[5]\l\s[25]\l\s[25]\l\s[25] \l\d[6]\c ',status,confNum, + msgDate,msgTime,toName,fromName,subject,(bufsz/128)+1,$E1) + tempStr[123]:=confNum AND $FF + tempStr[124]:=Shr(confNum,8) AND $FF + tempStr[125]:=msgNum AND $FF + tempStr[126]:=Shr(msgNum,8) AND $FF + + Write(fh,tempStr,128) + msgNum++ + + Write(fh,msgbuf,bufsz) + + Dispose(msgbuf) + ENDIF + Close (fh) + ENDIF +ENDPROC + +PROC createMessagesDat(msgFilename:PTR TO CHAR) + DEF i + DEF msgOutPath[255]:STRING + DEF fBlock:PTR TO fileinfoblock + DEF fLock + DEF msgFile[255]:STRING + DEF confNum + + IF(fBlock:=AllocDosObject(DOS_FIB,NIL)) + FOR i:=0 TO confIds.count()-1 + confNum:=Val(confIds.item(i)) + StringF(msgOutPath,'\sEXT-OUT',msgBasePaths.item(i)) + IF(fLock:=Lock(msgOutPath,ACCESS_READ)) + IF(Examine(fLock,fBlock)) + WHILE(ExNext(fLock,fBlock)) + StringF(msgFile,'\s/\s',msgOutPath,fBlock.filename) + createMessageDat2(confNum,msgFilename,msgFile) + SetProtection(msgFile,FIBF_OTR_DELETE) + DeleteFile(msgFile) + ENDWHILE + ENDIF + UnLock(fLock) + + ENDIF + ENDFOR + FreeDosObject(DOS_FIB,fBlock) + ENDIF + +ENDPROC + +PROC fileWriteLn(fh,str: PTR TO CHAR) + DEF stat + IF (stat:=fileWrite(fh,str))<>RESULT_SUCCESS THEN RETURN stat +ENDPROC fileWrite(fh,'\n') + +PROC fileWrite(fh,str: PTR TO CHAR) + DEF s + + s:=Write(fh,str,StrLen(str)) + IF s<>StrLen(str) THEN RETURN RESULT_FAILURE +ENDPROC RESULT_SUCCESS + +PROC formatLongDateTime2(cDateVal,outDateStr,seperatorChar) + DEF d : PTR TO datestamp + DEF dt : datetime + DEF datestr[10]:STRING + DEF timestr[10]:STRING + DEF r,dateVal + + dateVal:=cDateVal-21600 + + d:=dt.stamp + d.tick:=(dateVal-Mul(Div(dateVal,60),60)) + d.tick:=Mul(d.tick,50) + dateVal:=Div(dateVal,60) + d.days:=Div((dateVal),1440)-2922 ->-2922 days between 1/1/70 and 1/1/78 + d.minute:=dateVal-(Mul(d.days+2922,1440)) + + dt.format:=FORMAT_USA + dt.flags:=0 + dt.strday:=0 + dt.strdate:=datestr + dt.strtime:=timestr + + IF DateToStr(dt) + StringF(outDateStr,'\s\c\s',datestr,seperatorChar,timestr) + RETURN TRUE + ENDIF +ENDPROC FALSE + +PROC createControlDat(controlFilename:PTR TO CHAR) + DEF fo,conf + DEF tempstr[255]:STRING + + fo:=Open(controlFilename,MODE_NEWFILE) + IF(fo=0) + RETURN 0 + ENDIF + + fileWriteLn(fo,bbsName) + fileWriteLn(fo,bbsLocation) + fileWriteLn(fo,bbsNumber) + StringF(tempstr,'\s, Sysop',sysopName) + fileWriteLn(fo,tempstr) + + StringF(tempstr,'000000,\s',bbsId) + fileWriteLn(fo,tempstr) + + formatLongDateTime2(getSystemTime(),tempstr,",") + fileWriteLn(fo,tempstr) + + fileWriteLn(fo,userName) + + fileWriteLn(fo,'') + fileWriteLn(fo,'0') + fileWriteLn(fo,'0') + + StringF(tempstr,'\d\b\n',confIds.count()) + fileWrite(fo,tempstr) + FOR conf:=0 TO confIds.count()-1 + StringF(tempstr,'\s\b\n',confIds.item(conf)) + fileWrite(fo,tempstr) + StringF(tempstr,'\s',confNames.item(conf)) + IF StrLen(tempstr)>10 THEN SetStr(tempstr,10) + StrAdd(tempstr,'\b\n') + fileWrite(fo,tempstr) + ENDFOR + fileWrite(fo,'HELLO\b\n') + fileWrite(fo,'NEWS\b\n') + fileWrite(fo,'GOODBYE\b\n') + Close(fo) +ENDPROC + +->returns system time converted to c time format +PROC getSystemTime() + DEF currDate: datestamp + DEF startds:PTR TO datestamp + DEF s1,s2,s3,s4 + + startds:=DateStamp(currDate) + + s1:=startds.days+2922 + s1:=Mul(1440,s1) + s1:=Mul(60,s1) + s2:=Mul(60,startds.minute) + s3:=startds.tick/50 + s4:=Mul(Mul(startds.days+2922,1440),60)+(startds.minute*60)+(startds.tick/50) + + ->2922 days between 1/1/70 and 1/1/78 + +ENDPROC s4+21600 + + +PROC getEncodedDate(dateStr:PTR TO CHAR) + DEF dt:datetime + DEF strDate[20]:STRING + DEF strTime[20]:STRING + DEF dval + + + StrCopy(strDate,dateStr,8) + StrCopy(strTime,dateStr+8,5) + StrAdd(strTime,':00') + + dt.format:=FORMAT_USA + dt.flags:=0 + dt.strday:=0 + dt.strdate:=strDate + dt.strtime:=strTime + + IF StrToDate(dt)=0 THEN RETURN 0 + + dval:=Mul(Mul(dt.stamp.days+2922,1440),60)+(dt.stamp.minute*60)+(dt.stamp.tick/50) + + ->2922 days between 1/1/70 and 1/1/78 + +ENDPROC dval+21600 + +PROC trimStr(src:PTR TO CHAR) + DEF i + DEF tempStr[255]:STRING + + StrCopy(tempStr,TrimStr(src)) + + i:=EstrLen(tempStr)-1 + WHILE (i>=0) + IF tempStr[i]<>" " + i:=-1 + ELSE + SetStr(tempStr,i) + i-- + ENDIF + ENDWHILE + + StrCopy(src,tempStr) +ENDPROC + +PROC processConfigLine(inString,categoryStr,optName,optValue) + DEF t[255]:STRING + DEF l + StrCopy(t,inString) + trimStr(t) + l:=EstrLen(t) + IF l>1 + IF (t[0]="[") AND (t[l-1]="]") + StrCopy(categoryStr,t+1,l-2) + trimStr(categoryStr) + UpperStr(categoryStr) + StrCopy(optName,'') + StrCopy(optValue,'') + RETURN + ENDIF + ENDIF + l:=InStr(t,'=') + IF l>0 + StrCopy(optName,t,l) + trimStr(optName) + UpperStr(optName) + StrCopy(optValue,t+l+1,ALL) + trimStr(optValue) + ELSE + StrCopy(optName,'') + StrCopy(optValue,'') + ENDIF +ENDPROC + +PROC main() HANDLE + DEF qh: qwkHeader + DEF ms: mailStat + DEF mh: mailHeader + DEF buf=0:PTR TO CHAR + DEF buf2=0:PTR TO CHAR,bufsz + DEF mf=0,fh=0,fh2=0 + DEF n,c,i + DEF tempStr[255]:STRING + DEF newMsgNum + DEF fname[255]:STRING + DEF msgBase[255]:STRING + DEF qwkConfId + DEF lastConfId=-1 + DEF mode[255]:STRING + DEF qwkFilename[255]:STRING + DEF qwkGetCommand[255]:STRING + DEF qwkPutCommand[255]:STRING + DEF qwkPackCommand[255]:STRING + DEF qwkUnpackCommand[255]:STRING + DEF qwkMessageFilename[255]:STRING + DEF qwkControlFilename[255]:STRING + DEF qwkRepMessageFilename[255]:STRING + DEF qwkOutputFilename[255]:STRING + DEF cfgFile[255]:STRING + DEF needToSave + DEF myargs:PTR TO LONG,rdargs + + DEF category[255]:STRING + DEF optionName[255]:STRING + DEF optionValue[255]:STRING + + WriteF('Ami-Express QWK file processor Copyright 2020 Darren Coles\n') + + myargs:=[0,0]:LONG + IF rdargs:=ReadArgs('CFG/A',myargs,NIL) + IF myargs[0]<>NIL + AstrCopy(cfgFile,myargs[0],255) + ENDIF + FreeArgs(rdargs) + ELSE + RETURN + ENDIF + + confIds:=NEW confIds.stringlist(100) + confNames:=NEW confNames.stringlist(100) + msgBasePaths:=NEW msgBasePaths.stringlist(100) + + fh:=Open(cfgFile,MODE_OLDFILE) + IF fh>0 + + REPEAT + ReadStr(fh,tempStr) + processConfigLine(tempStr,category,optionName,optionValue) + + IF StrCmp('MAIN',category) AND StrCmp('MODE',optionName) THEN StrCopy(mode,optionValue) + IF StrCmp('MAIN',category) AND StrCmp('BBSNAME',optionName) THEN StrCopy(bbsName,optionValue) + IF StrCmp('MAIN',category) AND StrCmp('BBSLOCATION',optionName) THEN StrCopy(bbsLocation,optionValue) + IF StrCmp('MAIN',category) AND StrCmp('BBSNUMBER',optionName) THEN StrCopy(bbsNumber,optionValue) + IF StrCmp('MAIN',category) AND StrCmp('BBSID',optionName) THEN StrCopy(bbsId,optionValue) + IF StrCmp('MAIN',category) AND StrCmp('SYSOPNAME',optionName) THEN StrCopy(sysopName,optionValue) + IF StrCmp('MAIN',category) AND StrCmp('USERNAME',optionName) THEN StrCopy(userName,optionValue) + IF StrCmp('MAIN',category) AND StrCmp('GETCMD',optionName) THEN StrCopy(qwkGetCommand,optionValue) + IF StrCmp('MAIN',category) AND StrCmp('PUTCMD',optionName) THEN StrCopy(qwkPutCommand,optionValue) + IF StrCmp('MAIN',category) AND StrCmp('UNPACKCMD',optionName) THEN StrCopy(qwkUnpackCommand,optionValue) + IF StrCmp('MAIN',category) AND StrCmp('PACKCMD',optionName) THEN StrCopy(qwkPackCommand,optionValue) + IF StrCmp('MAIN',category) AND StrCmp('PACKEDTEMP',optionName) THEN StrCopy(qwkFilename,optionValue) + IF StrCmp('MAIN',category) AND StrCmp('MSGTEMP',optionName) THEN StrCopy(qwkMessageFilename,optionValue) + IF StrCmp('MAIN',category) AND StrCmp('CONTROLTEMP',optionName) THEN StrCopy(qwkControlFilename,optionValue) + IF StrCmp('MAIN',category) AND StrCmp('MSGFILE',optionName) THEN StrCopy(qwkRepMessageFilename,optionValue) + IF StrCmp('MAIN',category) AND StrCmp('REPFILE',optionName) THEN StrCopy(qwkOutputFilename,optionValue) + + UNTIL StrCmp(category,'CONFS') + UpperStr(mode) + + replacestr(qwkGetCommand,'{bbsid}',bbsId) + replacestr(qwkPutCommand,'{bbsid}',bbsId) + replacestr(qwkUnpackCommand,'{bbsid}',bbsId) + replacestr(qwkPackCommand,'{bbsid}',bbsId) + replacestr(qwkFilename,'{bbsid}',bbsId) + replacestr(qwkMessageFilename,'{bbsid}',bbsId) + replacestr(qwkControlFilename,'{bbsid}',bbsId) + replacestr(qwkRepMessageFilename,'{bbsid}',bbsId) + replacestr(qwkOutputFilename,'{bbsid}',bbsId) + + WHILE(ReadStr(fh,tempStr)<>-1) OR (StrLen(tempStr)>0) + confIds.add(tempStr) + ReadStr(fh,tempStr) + confNames.add(tempStr) + ReadStr(fh,tempStr) + msgBasePaths.add(tempStr) + ENDWHILE + Close(fh) + fh:=0 + ELSE + WriteF('Error opening Qwk.cfg\n\n') + Raise(ERR_NOCFG) + ENDIF + + IF StrCmp(mode,'OUT') OR StrCmp(mode,'BOTH') + WriteF('Processing outgoing messages\n') + IF FileLength(qwkOutputFilename)=-1 + ->no qwk output file so create item + + msgNum:=1 + + DeleteFile(qwkRepMessageFilename) + DeleteFile(qwkControlFilename) + + ->create messages.dat by scraping confs + createMessagesDat(qwkRepMessageFilename) + + createControlDat(qwkControlFilename) + + IF FileLength(qwkRepMessageFilename)<>-1 + exec(qwkPackCommand) + + IF FileLength(qwkOutputFilename)=-1 + WriteF('Error packing qwk file\n\n') + Raise(ERR_QWK_PACK) + ENDIF + ENDIF + DeleteFile(qwkRepMessageFilename) + DeleteFile(qwkControlFilename) + ELSE + WriteF('Processing already existing qwk output file (\s)\n\n',qwkOutputFilename) + ENDIF + + IF FileLength(qwkOutputFilename)<>-1 + IF exec(qwkPutCommand)=0 + DeleteFile(qwkOutputFilename) + ELSE + WriteF('Failure when sending qwk file to remote server\n\n') + ENDIF + ELSE + WriteF('No messages to post\n\n') + ENDIF + ENDIF + + IF StrCmp(mode,'IN') OR StrCmp(mode,'BOTH') + WriteF('Processing incoming messages\n') + + IF FileLength(qwkFilename)=-1 + ->no qwk file to process so grab a new one + + exec(qwkGetCommand) + IF FileLength(qwkFilename)=-1 + WriteF('No qwk file to process\n\n') + Raise(ERR_QWK_GRAB) + ENDIF + + ELSE + WriteF('Processing already existing qwk file (\s)\n\n',qwkFilename) + ENDIF + + DeleteFile(qwkMessageFilename) + exec(qwkUnpackCommand) + + IF FileLength(qwkMessageFilename)=-1 + WriteF('Error unpacking qwk file\n\n') + Raise(ERR_QWK_UNPACK) + ENDIF + DeleteFile(qwkFilename) + + needToSave:=FALSE + mf:=Open(qwkMessageFilename,MODE_OLDFILE) + IF mf>0 + Seek(mf,128,OFFSET_BEGINNING) + buf:=New(128) + c:=0 + REPEAT + n:=Read(mf,buf,128) + IF n>0 + qh.status:=buf[0] + StrCopy(tempStr,buf+1,7) + qh.num:=Val(tempStr) + AstrCopy(qh.msgdate,buf+8,14) + AstrCopy(qh.to,buf+21,26) + AstrCopy(qh.from,buf+46,26) + AstrCopy(qh.subject,buf+71,26) + AstrCopy(qh.password,buf+96,13) + StrCopy(tempStr,buf+108,8) + qh.inReplyTo:=Val(tempStr) + StrCopy(tempStr,buf+116,8) + qh.blockCount:=Val(tempStr) + qh.active:=buf[122] + qh.confNum:=buf[123]+(256*buf[124]) + qh.relativeMsgNum:=buf[125]+(256*buf[126]) + qh.netTag:=buf[127] + bufsz:=128*(qh.blockCount-1) + WriteF('id: \d\n',c) + WriteF('message: \d\n',qh.num) + WriteF('conf: \d\n',qh.confNum) + WriteF('to: \s\n',qh.to) + WriteF('from: \s\n',qh.from) + WriteF('subject: \s\n',qh.subject) + WriteF('\n') + + IF qh.confNum<>lastConfId + + IF fh>0 + Close(fh) + fh:=0 + ENDIF + IF needToSave + ms.highMsgNum:=newMsgNum+1 + StringF(fname,'\sMailStats',msgBase) + fh:=Open(fname,MODE_NEWFILE) + IF fh>0 + Write(fh,ms,SIZEOF mailStat) + Close(fh) + fh:=0 + ELSE + WriteF('Error saving MailStats\n\n') + Raise(ERR_WRITE_MAILSTAT) + ENDIF + needToSave:=FALSE + ENDIF + + getMsgBasePath(qh.confNum,msgBase) + IF StrLen(msgBase)=0 + WriteF('Qwk conf \d not configured, skipping messages for this conf\n\n',qh.confNum) + qwkConfId:=-1 + ELSE + qwkConfId:=qh.confNum + + StringF(fname,'\sMailStats',msgBase) + IF fh>0 THEN Close(fh) + fh:=Open(fname,MODE_READWRITE) + IF fh>0 + IF Read(fh,ms,SIZEOF mailStat)=0 + ms.lowestKey:=1 + ms.lowestNotDel:=1 + ms.highMsgNum:=1 + ms.pad[0]:=0;ms.pad[1]:=0;ms.pad[2]:=0;ms.pad[3]:=0;ms.pad[4]:=0;ms.pad[5]:=0 + Write(fh,ms,SIZEOF mailStat) + Close(fh) + fh:=0 + ELSE + Close(fh) + fh:=0 + ENDIF + ELSE + WriteF('Error opening MailStats (\s)\n\n',fname) + Raise(ERR_READ_MAILSTAT) + ENDIF + + newMsgNum:=ms.highMsgNum-1 + StringF(fname,'\sHeaderFile',msgBase) + fh:=Open(fname,MODE_READWRITE) + IF fh>0 + Seek(fh,0,OFFSET_END) + ELSE + WriteF('Error opening HeaderFile\n\n') + Raise(ERR_READ_HEADERFILE) + ENDIF + + ENDIF + + ENDIF + + lastConfId:=qh.confNum + + IF qh.confNum=qwkConfId + newMsgNum++ + + buf2:=New(bufsz) + Read(mf,buf2,bufsz) + + mh.pad:=0 + mh.status:="P" + mh.msgNumb:=newMsgNum + + trimRight(qh.to,tempStr) + fillStrCopy(tempStr,mh.toName,31) + + trimRight(qh.from,tempStr) + fillStrCopy(tempStr,mh.fromName,31) + + trimRight(qh.subject,tempStr) + fillStrCopy(tempStr,mh.subject,31) + + mh.msgDate:=getEncodedDate(qh.msgdate) + mh.recv:=0 + + IF saveMh(fh,mh)<>110 + WriteF('Error saving mail header for message \d\n',newMsgNum) + ENDIF + + needToSave:=TRUE + + StringF(fname,'\s\d',msgBase,newMsgNum) + fh2:=Open(fname,MODE_NEWFILE) + IF fh2>0 + FOR i:=0 TO bufsz-1 + IF buf2[i]=$e3 THEN buf2[i]:=10 + ENDFOR + Write(fh2,buf2,bufsz) + Close(fh2) + fh2:=0 + ELSE + WriteF('Error saving message body for message \d\n\n',newMsgNum) + ENDIF + Dispose(buf2) + buf2:=0 + ELSE + Seek(mf,bufsz,OFFSET_CURRENT) + ENDIF + ENDIF + c++ + UNTIL (n=0) OR (CtrlC()) + + Close(fh) + fh:=0 + + IF needToSave + ms.highMsgNum:=newMsgNum+1 + StringF(fname,'\sMailStats',msgBase) + fh:=Open(fname,MODE_NEWFILE) + IF fh>0 + Write(fh,ms,SIZEOF mailStat) + Close(fh) + fh:=0 + ELSE + WriteF('Error saving MailStats\n\n') + Raise(ERR_WRITE_MAILSTAT) + ENDIF + needToSave:=FALSE + ENDIF + + IF mf>0 THEN Close(mf) + mf:=0 + DeleteFile(qwkMessageFilename) + + ELSE + WriteF('Error opening MESSAGES.DAT\n\n') + Raise(ERR_READ_MESSAGES_DAT) + ENDIF + ENDIF + +EXCEPT DO + IF confIds<>NIL THEN END confIds + IF confNames<>NIL THEN END confNames + IF msgBasePaths<>NIL THEN END msgBasePaths + IF fh>0 THEN Close(fh) + IF fh2>0 THEN Close(fh2) + IF mf>0 THEN Close(mf) + IF buf<>0 THEN Dispose(buf) + IF buf2<>0 THEN Dispose(buf2) +ENDPROC \ No newline at end of file