10 REM > DateFix
   20 REM Fix mailing list messages
   30 REM Ensures file dates matches message dates
   40 :
   50 REM v1.00
   60 REM v1.01 24-May-1998 Ignores if no date set
   70 REM v1.10 23-Jun-1998 Reads update date from fileserver
   80 REM v1.20 03-Oct-1999 Copies dates from load/exec, was SetDates
   90 REM v1.21 28-Aug-2000 Recurses into subdirectories
  100 REM v1.22 15-Oct-2000 Tweeked Date header processing, uses NetFS library
  110 REM v1.23 08-Sep-2017 Updates sent headers
  120 REM v1.24 06-Sep-2018 Reads date from load/exec, sets load/exec to date
  130 REM v1.25 29-Sep-2018 Copes with old-style DigiBank messages
  140 :
  150 ON ERROR REPORT:PRINT ERL:END
  160 memmax%=HIMEM-LOMEM-2048+2048*(HIMEM>&FFFF):IF memmax%<1024:PRINT"No room":END
  170 DIM ctrl% 31,data% memmax%-1:X%=ctrl%:Y%=X%DIV256:name%=data%
  180 fs%=FNfs:PROCexamine
  190 END
  200 :
  210 DEFPROCexamine:LOCAL idx%,f$:REPEAT:f$=FNgbpb8(idx%):idx%=X%!9
  220   IF f$<>"":PROCfile:IF type%=2:OSCLI"Dir "+f$:PROCexamine:OSCLI"Dir ^"
  230 UNTIL f$="":ENDPROC
  240 :
  250 DEFPROCfile
  260 type%=FNfile(f$,5):IF type%<>1:ENDPROC
  270 PRINT f$;SPC(12-LEN f$);
  280 load%=X%!2:exec%=X%!6:size%=X%!10:attr%=X%?14
  290 mdate%=X%!15:mtime%=0:cdate%=mdate%:ctime%=0
  300 IF fs%=5:IF FNNetFS_Op(18,CHR$64+f$)=0:cdate%=X%!5:ctime%=X%!7:mdate%=X%!10:mtime%=X%!12
  310 PROCf_date(cdate%):Cdy%=day%:Cmn%=month%:Cyr%=year%
  320 PROCf_date(mdate%):Sdy%=day%:Smn%=month%:Syr%=year%
  330 PROCf_time(X%!17):Sh%=hour%:Sm%=minute%:Ss%=second%
  340 !X%=exec%:X%!4=load%:PROCDate_ToOrd(X%)
  350 Lh%=hour%:Lm%=minute%:Ls%=second%:Lc%=centi%
  360 Ldy%=day%:Lmn%=month%:Lyr%=year%
  370 :
  380 REM Lxx = timestamp from load/exec addresses
  390 REM Sxx = timestamp from attributes
  400 REM Cxx = timestamp creation date
  410 :
  420 IF Smn%:IF Sdy%:IF Syr%*400+Smn%*32+Sdy%<Lyr%*400+Lmn%*32+Ldy%:Lyr%=Syr%:Lmn%=Smn%:Ldy%=Sdy%
  430 REM Lxx set to earlier of (Lxx, Sxx)
  440 :
  450 in%=OPENIN(f$):PROCgbpb(4,in%,data%,1024,0):CLOSE#in%:in%=0
  460 eol%=13:FOR A%=0 TO 1023:IF data%?A%=10:data%?A%=13:eol%=10
  470 NEXT A%:mem%=data%
  480 IF LEFT$($mem%,6)="<msg> ":PROCAddHeader1
  490 IF LEFT$($mem%,7)="<mail> ":PROCAddHeader2
  500 REM If no header, Lxx used to create a header
  510 :
  520 ptr%=mem%:REPEAT A$=$ptr%:ptr%=ptr%+1+LEN A$:UNTIL A$="" OR LEFT$(A$,4)="Date" OR LEFT$(A$,4)="Sent"
  530 IF A$="":PRINT"no DATE":ENDPROC
  540 A$=FNDateFix(A$):PRINT LEFT$(A$,25);
  550 dy%=VAL MID$(A$,6,2):mn%=INSTR("JanFebMarAprMayJunJulAugSepOctNovDec",MID$(A$,9,3)):mn%=(mn%DIV3+1)AND(mn%>0):yr%=VAL MID$(A$,13):h%=VAL MID$(A$,18,2):m%=VAL MID$(A$,21,2):s%=VAL MID$(A$,24,2)
  560 IF h%>24 OR m%>60 OR s%>60:h%=0:m%=0:s%=0
  570 IF dy%+mn%:Ldy%=dy%:Lmn%=mn%:Lyr%=yr%:Lh%=h%:Lm%=m%:Ls%=s%
  580 REM IF h%+m%+s%:Lh%=h%:Lm%=m%:Ls%=s%
  590 REM Lxx = timestamp from header (or header created from file timestamp)
  600 REM To do: if time=00/00/00, replace with time from datestamp
  610 :
  620 PRINT TAB(38);FNd0(Ldy%,2)"/"FNd0(Lmn%,2)"/";Lyr%;" ";
  630 PRINT FNd0(Lh%,2)":"FNd0(Lm%,2)":"FNd0(Ls%,2)"  ";
  640 PROCSetAddrsAndDate
  650 ENDPROC
  660 :
  670 DEFPROCAddHeader1:REM <msg> ->EMail
  680 ptr%=mem%:to$=FNfetch:IF LEFT$(to$,10)="<msg> @254":to$=FNfetch
  690 subj$=FNfetch:msg%=ptr%-mem%
  700 IF RIGHT$(to$,8)=" ->Email":to$=subj$:A$=FNfetch:subj$=FNfetch:msg%=ptr%-mem%:IF INSTR(to$,"@")=0:ENDPROC
  710 PROCAddHeader
  720 ENDPROC
  730 :
  740 DEFPROCAddHeader2:REM <mail> ->Recipient
  750 ptr%=mem%:to$=FNfetch:subj$=FNfetch:msg%=ptr%-mem%
  760 IF LEFT$(to$,9)="<mail> ->":to$=FNs(MID$(to$,10)) ELSE ENDPROC
  770 PROCAddHeader
  780 ENDPROC
  790 :
  800 DEFPROCAddHeader
  810 IF size%>memmax%-256:ENDPROC
  820 IF LEFT$(subj$,9)="Subject: ":subj$=MID$(subj$,10)
  830 date$=FNd0(Ldy%,2)+" "+MID$("000JanFebMarAprMayJunJulAugSepOctNovDecDDDEEEFFF",Lmn%*3+1,3)+" "+STR$(Lyr%)
  840 IF Lh%+Lm%+Ls%:date$=date$+" "+FNd0(Lh%,2)+":"+FNd0(Lm%,2)+":"+FNd0(Ls%,2)
  850 from$="J.G.Harston <jgh@mdfs.net>"
  860 IF VAL MID$(date$,8,4)<2010:from$="J.G.Harston <jgh@arcade.demon.co.uk>"
  870 IF VAL MID$(date$,8,4)<1998:from$="J.G.Harston <jgh@digibank.demon.co.uk>"
  880 hdr%=LEN to$+5+LEN date$+7+LEN from$+7+LEN subj$+10
  890 OSCLI "Load "+f$+" "+STR$~(mem%+hdr%-msg%)
  900 ptr%=mem%
  910 PROCstore("To: "+to$)
  920 PROCstore("From: "+from$)
  930 PROCstore("Sent: "+date$)
  940 PROCstore("Subject: "+subj$)
  950 OSCLI "Save "+f$+" "+STR$~mem%+"+"+STR$~(size%-msg%+hdr%)+" "+STR$~exec%+" "+STR$~load%
  960 IF eol%=13:ENDPROC
  970 FOR A%=0 TO 1023:IF data%?A%=10:data%?A%=13
  980 NEXT A%:ENDPROC
  990 :
 1000 DEFPROCstore(A$):$ptr%=A$:ptr%?LEN A$=eol%:ptr%=ptr%+1+LEN A$:ENDPROC
 1010 DEFFNfetch:A$=$ptr%:ptr%=ptr%+1+LEN A$:=A$
 1020 :
 1030 DEFFNDateFix(A$):A$=" "+MID$(A$,INSTR(A$,":")+1)
 1040 REPEAT A%=INSTR(A$,CHR$9):IF A%:A$=LEFT$(A$,A%-1)+" "+MID$(A$,A%+1)
 1050 UNTIL A%=0:REPEAT A$=MID$(A$,2):UNTIL ASC A$<>32
 1060 IF LEN A$=11:="     "+A$                                             :REM 14-Nov-1985
 1070 IF LEN A$=15:=LEFT$(A$,3)+","+MID$(A$,5)                             :REM Mon 15 Sep 1986
 1080 IF MID$(A$,15,1)=":":IF MID$(A$,18,1)=":":="     "+A$                :REM 21-Nov-1985 12:34:56
 1090 IF MID$(A$,5,1)=" ":IF MID$(A$,7,1)=" ":A$=LEFT$(A$,5)+"0"+MID$(A$,6):REM Mon, 6 Sep 2008 ...
 1100 IF MID$(A$,8,2)="  ":A$=LEFT$(A$,8)+"0"+MID$(A$,10)                  :REM Thu Dec  9 15:00:22 ...
 1110 IF MID$(A$,12,1)=" ":IF MID$(A$,15,1)=" ":A$=LEFT$(A$,12)+"19"+MID$(A$,13)
 1120 IF MID$(A$,14,1)=":":IF MID$(A$,17,1)=":":A$=LEFT$(A$,3)+", "+MID$(A$,9,2)+MID$(A$,4,5)+MID$(A$,21,4)+MID$(A$,11,9)+MID$(A$,25)
 1130 IF LEN A$=24:=LEFT$(A$,3)+","+MID$(A$,4)    :REM Mon 15 Sep 1986 16:22:06
 1140 IF LEN A$>24:=A$                            :REM Sat, 28 Jun 2008 13:32:52 ....
 1150 =A$
 1160 :
 1170 DEFPROCSetAddrsAndDate
 1180 PROCDate_FromOrd(X%+6,Ldy%,Lmn%,Lyr%,Lh%,Lm%,Ls%,Lc%)
 1190 X%!2=load%:X%?2=X%?10:X%!14=attr%:A%=FNfile(f$,1)
 1200 X%!8=FNf_date(Ldy%,Lmn%,Lyr%):A%=FNNetFS_OpN(19,5,10,f$)
 1210 X%!8=FNf_date(Ldy%,Lmn%,Lyr%):X%!10=FNf_time(Lh%,Lm%,Ls%)
 1220 X%!13=X%!8:X%!15=X%!10:A%=FNNetFS_OpN(19,64,18,f$)
 1230 X%!14=attr%:X%!15=FNf_date(Ldy%,Lmn%,Lyr%):A%=FNfile(f$,4)
 1240 PRINT:ENDPROC
 1250 :
 1260 DEFPROCDate_FromOrd(mem%,d%,m%,y%,hr%,mn%,sc%,cs%):y%=y%MOD400
 1270 d%=y%*365.25+m%*30+d%+VAL MID$("120112234455",m%,1)+((y%MOD4)=0)-((y%-1)DIV100)-(m%>2AND((y%MOD4)=0AND(y%MOD100)<>0ORy%=0))+36493
 1280 IF d%>146066:d%=d%-146097
 1290 d%=d%*&41EB:mem%!1=d%+d%:d%=((hr%*60+mn%)*60+sc%)*100+cs%
 1300 ?mem%=d%:mem%!1=mem%!1+d%DIV256:ENDPROC
 1310 :
 1320 DEFPROCDate_ToOrd(mem%):LOCAL A%,B%,C%,D%
 1330 year%=0:month%=0:day%=0:hour%=0:minute%=0:second%=0:centi%=0
 1340 IF mem%!1<0:ENDPROC:REM Problems with negatives ATM
 1350 D%=mem%!1DIV&83D6+2447065:C%=mem%?0+256*(mem%!1MOD&83D6):centi%=C%MOD100
 1360 C%=C%DIV100:second%=C%MOD60:C%=C%DIV60:minute%=C%MOD60:hour%=C%DIV60
 1370 B%=((D%*4+3)MOD146097AND-4)+3:C%=B%MOD1461DIV4*5+2:D%=D%*4+3
 1380 A%=C%DIV153+2:day%=C%MOD153DIV5+1:month%=A%MOD12+1
 1390 year%=D%DIV146097*100+B%DIV1461+A%DIV12-4800
 1400 ENDPROC
 1410 :
 1420 DEFFNd0(A%,N%)=RIGHT$("000000000"+STR$ A%,N%)
 1430 DEFFNs(A$):IF ASC A$=32:REPEAT:A$=MID$(A$,2):UNTIL ASC A$<>32
 1440 IF RIGHT$(A$,1)=" ":REPEAT:A$=LEFT$(A$,LEN A$-1):UNTIL RIGHT$(A$,1)<>" "
 1450 =A$
 1460 :
 1470 DEFFNfile(f$,A%):$name%=f$:?X%=name%:X%?1=name%DIV256:=(USR&FFDD)AND&FF
 1480 DEFPROCgbpb(A%,chn%,addr%,num%,ptr%):?X%=chn%:X%!1=addr%:X%!5=num%:X%!9=ptr%:CALL &FFD1:ENDPROC
 1490 DEFFNgbpb8(ptr%)
 1500 IF HIMEM>&FFFF:!name%=0:SYS12,9,"",name%,1,ptr%,32TO,,,X%!5,X%!9:IF!name% OR X%!5=0:SYS70,name%TOA$:=A$
 1510 X%!1=name%:X%!5=1:X%!9=ptr%:A%=8:CALL&FFD1:IF X%!5=1:=""
 1520 A%=name%:A%?(1+?A%)=13:=FNs($(A%+1))
 1530 DEFFNfs:LOCAL A%,Y%,E%:=(USR&FFDA)AND&FF
 1540 :
 1550 DEFFNNetFS_Op(A%,A$)=FNNetFS_OpN(A%,0,7,A$)
 1560 DEFFNNetFS_OpN(A%,T%,O%,A$):!X%=0:X%?1=O%+1+LENA$:X%!3=A%
 1570 IFHIMEM>&FFFF:X%?4=T%:$(X%+O%-3)=A$:SYS&60048,A%,X%+4,O%+LENA$,120TOA%:IFA%=0:X%?3=0:=0
 1580 IFHIMEM>&FFFF:IFA%>&FFFF:X%?3=?A%:SYS&2002B,A%+4TO$(X%+4):=X%?3
 1590 X%!4=0:X%?7=T%:$(X%+O%)=A$:A%=&14:CALL&FFF1:=X%?3
 1600 :
 1610 DEFFNf_date(d%,m%,y%):y%=y%-1981:=d%+m%*256+(y%AND15)*4096+(y%DIV16)*32
 1620 DEFFNf_time(h%,m%,s%):=h%+m%*256+s%*65536
 1630 DEFPROCf_date(d%):day%=d%AND31:month%=(d%AND&F00)DIV256
 1640 year%=(d%AND&F000)DIV4096+(d%AND&E0)/2+1981:ENDPROC
 1650 DEFPROCf_time(t%):hour%=t%AND255:minute%=(t%AND&FF00)DIV256
 1660 second%=(t%AND&FF0000)DIV65536:ENDPROC

Download DateFix

BBC BASIC detokeniser and syntax highlighter by Ben Ryves.