Oberon/A2/Oberon.MultiMail.Mod

(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich. Refer to the "General ETH Oberon System Source License" contract available at: http:&#47;/www.oberon.ethz.ch/ *) MODULE MultiMail IN Oberon;	(** portable *) (* ejz, *) IMPORT Files, Objects, Texts, Oberon, Strings, Fonts, Base64, NetTools, MIME, Mail, Links, Gadgets, Lists, Streams, TextStreams; VAR W: Texts.Writer; PROCEDURE SearchText(text: Texts.Text; CONST pat: ARRAY OF CHAR; VAR pos: SIGNED32): BOOLEAN; CONST MaxPatLen = 128; VAR i, l, sPatLen: SIZE; R: Texts.Reader; sPat: ARRAY MaxPatLen OF CHAR; sDv: ARRAY MaxPatLen + 1 OF SIGNED16; ch: CHAR; PROCEDURE CalcDispVec; VAR i, j, d: SIGNED32; BEGIN i := 1; d := 1; WHILE i &#60;= sPatLen DO 				j := 0; WHILE (j + d &#60; sPatLen) & (sPat&#91;j] = sPat&#91;j + d]) DO 					INC(j) END; WHILE i &#60;= j + d DO 					sDv&#91;i] := SHORT(d); INC(i) END; INC(d) END END CalcDispVec; BEGIN COPY(pat, sPat); sPatLen := Strings.Length(sPat); CalcDispVec; IF sPatLen > 0 THEN Texts.OpenReader(R, text, pos); Texts.Read(R, ch); INC(pos); l := text.len; i := 0; WHILE (i # sPatLen) & (pos &#60;= l) DO 				IF ch = sPat&#91;i] THEN INC(i); IF i &#60; sPatLen THEN Texts.Read(R, ch); INC(pos) END ELSIF i = 0 THEN Texts.Read(R, ch); INC(pos) ELSE i := i - sDv&#91;i] END END ELSE i := -1 END; RETURN i = sPatLen END SearchText; PROCEDURE Send*; VAR S: Mail.SMTPSession; Sw: Streams.Stream; server: Mail.ServerName; email: Mail.AdrString; cont: MIME.Content; obj: Objects.Object; text, mail, ascii: Texts.Text; buf: Texts.Buffer; list: Lists.List; item: Lists.Item; boundary: ARRAY 128 OF CHAR; magStr, val: ARRAY 16 OF CHAR; pos, magic: SIGNED32; F: Files.File; h: MIME.Header; R: Texts.Reader; ch: CHAR; autoCc: BOOLEAN; BEGIN Texts.OpenWriter(W); obj := Gadgets.FindObj(Gadgets.context, "body"); Links.GetLink(obj, "Model", obj); text := obj(Texts.Text); obj := Gadgets.FindObj(Gadgets.context, "files"); list := obj(Lists.List); NEW(mail); Texts.Open(mail, ""); NEW(buf); Texts.OpenBuf(buf); Mail.GetSetting("SMTP", server, FALSE); Mail.GetSetting("EMail", email, FALSE); Mail.GetSetting("AutoCc", boundary, TRUE); Strings.StrToBool(boundary, autoCc); (* gen boundary *) magic := Oberon.Time; boundary := ""; Strings.IntToStr(magic, magStr); Strings.Append(boundary, magStr); (* mime header *) Sw := TextStreams.OpenReader(text, 0); MIME.ReadHeader(Sw, NIL, h, pos); Texts.OpenReader(R, text, pos); Texts.Read(R, ch); IF ((ch = Strings.CR) OR (ch = Strings.LF)) OR R.eot THEN ch := Strings.CR; WHILE (pos > 0) & ((ch = Strings.CR) OR (ch = Strings.LF)) DO 				DEC(pos); Texts.OpenReader(R, text, pos); Texts.Read(R, ch) END; INC(pos); IF pos > text.len THEN pos := text.len END END; Texts.Save(text, 0, pos, buf); Texts.Append(mail, buf); Texts.WriteLn(W); Texts.WriteString(W, "X-Mailer: MultiMail for Oberon (ejz)"); Texts.WriteLn(W); Texts.WriteString(W, "MIME-Version: 1.0"); Texts.WriteLn(W); Texts.WriteString(W, 'Content-Type: multipart/mixed; boundary="'); 		Texts.WriteString(W, boundary); Texts.Write(W, 022X); Texts.WriteLn(W); 		Texts.WriteLn(W); 		Texts.WriteString(W, "This is a multi-part message in MIME format."); 		Texts.WriteLn(W); Texts.WriteLn(W); (* message *) 		Texts.WriteString(W, "--"); Texts.WriteString(W, boundary); 		Texts.WriteLn(W); Texts.Append(mail, W.buf); 		Mail.GetSetting("ContType", val, TRUE); 		NEW(cont); cont.typ := MIME.GetContentType("text/plain"); 		IF val&#91;0] = "0" THEN 			cont.encoding := MIME.EncBin 		ELSIF val&#91;0] = "1" THEN 			cont.encoding := MIME.Enc8Bit 		ELSIF val&#91;0] = "2" THEN 			cont.typ := MIME.GetContentType(MIME.OberonMime); cont.encoding := MIME.EncAsciiCoderC 		ELSE 			cont.encoding := MIME.EncAuto; 			Mail.QueryContType(text, pos, cont) 		END; 		IF cont.encoding IN {MIME.EncAsciiCoder, MIME.EncAsciiCoderC, MIME.EncAsciiCoderCPlain} THEN Texts.WriteString(W, "X-Content-Type: "); Texts.WriteString(W, MIME.OberonMime); Texts.WriteLn(W); Texts.Append(mail, W.buf) END; Sw := TextStreams.OpenWriter(mail); MIME.WriteISOMime(Sw, cont); TextStreams.WriteLn(Sw); TextStreams.WriteLn(Sw); IF cont.encoding IN {MIME.EncAsciiCoder, MIME.EncAsciiCoderC, MIME.EncAsciiCoderCPlain} THEN IF cont.encoding IN {MIME.EncAsciiCoder, MIME.EncAsciiCoderC} THEN MIME.WriteText(text, pos, text.len, Sw, cont, FALSE, TRUE) END; TextStreams.WriteString(Sw, Mail.OberonStart); TextStreams.WriteLn(Sw); Mail.MakeAscii(text, pos, text.len, cont.encoding # MIME.EncAsciiCoder, ascii); cont.typ := MIME.GetContentType("text/plain"); MIME.WriteText(ascii, 0, ascii.len, Sw, cont, FALSE, TRUE) ELSE Texts.OpenReader(R, text, pos); Texts.Read(R, ch); INC(pos); WHILE ~R.eot & (ch &#60;= " ") & (R.lib IS Fonts.Font) DO 				Texts.Read(R, ch); INC(pos) END; DEC(pos); MIME.WriteText(text, pos, text.len, Sw, cont, FALSE, TRUE) END; TextStreams.WriteLn(Sw); Sw.Flush(Sw); (* attachments *) pos := 0; ASSERT(~SearchText(text, boundary, pos)); NEW(text); item := list.items; WHILE item # NIL DO 			Texts.WriteString(W, "--"); Texts.WriteString(W, boundary); Texts.WriteLn(W); Texts.WriteString(W, "Mime-Version: 1.0"); Texts.WriteLn(W); Texts.WriteString(W, "Content-Type: application/octet-stream"); Texts.WriteLn(W); Texts.WriteString(W, "Content-Transfer-Encoding: base64"); Texts.WriteLn(W); Texts.WriteString(W, 'Content-Disposition: attachment; filename="'); 			Texts.WriteString(W, item.s); Texts.Write(W, 022X); Texts.WriteLn(W); 			Texts.WriteLn(W); Texts.Append(mail, W.buf); 			F := Files.Old(item.s); 			IF F # NIL THEN 				Texts.Open(text, ""); Base64.EncodeFile(F, text); 				Texts.Save(text, 0, text.len, buf); Texts.Append(mail, buf); 				pos := 0; ASSERT(~SearchText(text, boundary, pos)); 				Texts.WriteLn(W) 			ELSE 				Texts.OpenWriter(W); 				Texts.WriteString(W, item.s); Texts.WriteString(W, " not found"); 				Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); 				RETURN 			END; 			item := item.next 		END; 		Texts.WriteString(W, "--"); Texts.WriteString(W, boundary); Texts.WriteString(W, "--"); Texts.WriteLn(W); 		Texts.WriteLn(W); Texts.Append(mail, W.buf); 		cont.typ := MIME.GetContentType("text/plain"); cont.encoding := MIME.EncBin; 		Mail.OpenSMTP(S, server, email, Mail.DefSMTPPort); IF S.res = NetTools.Done THEN Texts.WriteString(W, "mailing "); Texts.Append(Oberon.Log, W.buf); Mail.SendMail(S, mail, cont, autoCc); Mail.CloseSMTP(S) END; Texts.WriteString(W, S.reply); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END Send; END MultiMail. MultiMail.Panel System.Free MultiMail ~