{**************************************************************************
 ***                         READING/WRITING EMAIL                      ***
 **************************************************************************}
{$I compflgs}
{Expects to use 3rd party email program, so far only written for pmmail}
unit email;

interface

uses devices, setup, tuiedit, objects;

const
	vfNone   = 0;
	vfASCII  = 1; {simply stack 'em up in the outbox}
	vfPMMail = 2; {update folders.bag in the outbox}

type
	PEmailStream = ^TEmailStream;
	TEMailStream = object(TDeviceStream)
		constructor Init;
		procedure Initialise; virtual;          {sends initialisation codes}
		procedure EndPrint; virtual;
		procedure Send; virtual;
	end;

	PEmailSetup = ^TEmailSetup;
	TEmailSetup = object(TSetup)

		InBoxPath 	: string[70];
		OutBoxPath 	: string[70];

		{sending program}
		ViaFormat : word;

		procedure Load; virtual;
		procedure Store; virtual;
		procedure SetButtonDefaults; virtual;
		procedure AddSetupLines(EditBox : PEditBox); virtual;
	end;

var
	EmailSetup : TEmailSetup;

implementation

uses global,
			dosutils,
			kamsetup,
			tuimsgs, dialogs,
			help,
			dattime,
			messtext,
			tasks,
			tui,
			minilib;

{********************************************************
 ***              EMAIL STREAM                        ***
 ********************************************************}

{====== INSTANTIATE STREAM ===============}
constructor TEmailStream.Init;
var Path : string;
		FName : string[8];
		MsgNum : word;

	function MakeFName : string;
	begin
		MakeFName :=Path +FName+PadZero(N2Str(MsgNum),4)+'.MSG';
	end;

begin
	if EmailSetup.OutBoxPath<>'' then
		Path := EmailSetup.OutBoxPath
	else begin
		Path := WorkPath;
		ProgramWarning('No Outbox set - check email setup'#13#10+
										'(NB: Support for PMMAIL only)',hcemailSetup);
	end;

	{makes up file name KAM+char(64+month) no it doesn't}
	FName := 'KAM';  MsgNum := 1;
	while FileExists(MakeFName) do inc(MsgNum);

	inherited Init('email message file', MakeFName);

	Paper^.Width := 70; {default reflow}
	Paper^.Length := 0;
	Paper^.LeftMargin := 0;
	Paper^.TopMargin := 0;

	Filter^.FormFeed := #0; {prevent form feed chars}
end;


{======== CREATE EMAIL HEADER ===================}
{This isn't really the right place to put it, but it will do I think.
It creates the email header necessary for the pop server/etc to handle it}
procedure TEmailStream.Initialise;
begin
	inherited Initialise;

	{make sure there are no null fields}
	with FormCodes^ do begin
		{make sure no null fields}
		if QDecode('SBJ')='' then SetStr('SBJ','(null)');

		if QDecode('TO.EMAIL')='' then begin
			ProgramWarning('Sending Email: No "To" email address!'#13#10
											+'Setting to **'+QDecode('TO.DN')+'@Unknown**',
											hcemailSendWarning);
			SetStr('TO.EMAIL', '**'+QDecode('TO.DN')+'@Unknown**');
		end;

		if QDecode('BY.EMAIL')='' then begin
			ProgramWarning('Sending Email: No "From" email address!'#13#10
										+'Setting to **'+QDecode('BY.DN')+'@Unknown**',
										hcemailSendWarning);
			SetStr('BY.EMAIL', '**'+QDecode('BY.DN')+'@Unknown**');
		end;

		{reversed date}
		SetStr('RTODAY',Tens(Today.Year)+Units(Today.Year)+'-'+
										Tens(Today.Month)+Units(Today.Month)+'-'+
										Tens(Today.Day)+Units(Today.Day));
	end;

	{--- Write Internet email header ----}
	WriteCodedStr('From: "<BY.DN>" <<BY.EMAIL>>'+CRLF);
	WriteCodedStr('To: "<TO.DN>" <<TO.EMAIL>>'+CRLF);
	WriteCodedStr('Date: <TODAY/A> <NOW>'+CRLF);
	WriteCodedStr('Reply-To: "<BY.DN>" <<BY.EMAIL>>'+CRLF);
	Writeln('Priority: Normal');
	Writeln('X-Mailer: Kameleon Management System via Reg PMMail 1.53 for OS/2');
	Writeln('MIME-Version: 1.0');
	Writeln('Content-Type: text/plain; charset="us-ascii"');
	Writeln('Content-Transfer-Encoding: 7bit');
	WriteCodedStr('Subject: <SBJ>'+CRLF);
	Writeln('');
end;

{endprint closes stream so that send can delete the file if nec.}
procedure TEmailStream.EndPrint;
begin
	inherited EndPrint;
	Close; {close printer channel to release for other apps}
end;

procedure TemailStream.Send;
var Prog, Params : string;
		Err : word;
		MailBag : text;
		BagLine : string;
		LastIOREsult : integer;
begin
	case emailSetup.ViaFormat of
		vfPMMail : begin

			{add to mail bag}
			Assign(MailBag, EmailSetup.OutBoxPath + 'FOLDER.BAG');
			{$I-}
			Append(MailBag);
			LastIOResult := IOResult;
			if LastIOResult =2 then begin
				Rewrite(MailBag);
				LastIOResult := IOResult;
			end;
			{$I+}

			if LastIOResult <>0 then begin
				ProgramWarning('Could not open mailbag to send message'#13#10+
										IOError(LastIOResult)+#13#10+
										'Check OutPath in email setup',
										hcemailSetup);
				{delete message file?}
				DeleteFile(DosFIleName);

			end else begin
				BagLine := '3'#222'0'#222'<RTODAY>'#222'<NOW>'#222'<SBJ>'#222
										+'<TO.EMAIL>'#222'<TO.DN>'#222'<BY.EMAIL>'#222'<BY.DN>'#222
										+'?K'#222+GetFileName(DosFileName)+#222;

				BagLine := FormCodes^.QDecodeStr(BagLine);

				system.writeln(MailBag,BagLine);

				system.close(MailBag);
			end;
		end;
	end;

	{send program only runs under os/2}
{	if delspace(EmailSetup.SendProgram)<>'' then begin
		SplitProgParams(EmailSetup.SendProgram, Prog, Params);
		FormCodes^.SetStr('WORKPATH', WorkPath);
		FormCodes^.SetStr('OUTBOX', EmailSetup.OutBoxPath);

		FormCodes^.QDecodeStr(Params); {who to, etc}

{		Err := Run(Prog, Params,rnNone,'Calling email Sender...');{}{}
{	end;{}
end;

{********************************************************
 ***              EMAIL SETUP                         ***
 ********************************************************}

procedure TemailSetup.Load;
begin
	InBoxPath 	:= GetPath('IN BOX', '');
	OutBoxPath 	:= GetPath('OUT BOX', '');
	ViaFormat	 	:= S2Num(Get('VIA FORMAT', N2Str(vfNone)));
end;

procedure TemailSetup.SetButtonDefaults;
begin
	{default to pmmail link}
	InBoxPath := '\PMMAIL\PMMAIL\xxxx.ACT\INBOX.FLD';
	OutBoxPath := '\PMMAIL\PMMAIL\xxxx.ACT\OUTBOX.FLD';

	ViaFormat := vfPMMail;
end;

procedure TemailSetup.Store;
begin
	Put('IN BOX', InBoxPath);
	Put('OUT BOX', OutBoxPath);
	Put('VIA FORMAT', N2Str(ViaFormat));

	ProgramSetup.Store;
end;

{============ EDIT ======================}
procedure TemailSetup.AddSetupLines;
var R : TRect;
begin
	with EditBox^ do begin
		GrowTo(40,12);

		InsTitledField(15,  2,20, 1, '~I~n Box Path', New(PInputELine, init(R, 70)));
		InsTitledField(15,  3,20, 1, '~O~ut Box Path', New(PInputELine, init(R, 70)));

		R.XYLD(15, 5, 20, 3);
		Insert(New(PERadioButtons, init(R, 	NewSITem('~N~one',
																				NewSItem('~A~SCII Box',
																				NewSItem('~P~M Mail', nil))))));
		AddLabel('Via',Current);

	end;
end;


procedure EditemailSetup; far;
begin	EmailSetup.Edit; end;

{*******************************
 ***        INIT             ***
 *******************************}
begin
	EmailSetup.Init('email');
	RegisterTask(DesktopTasks, cmEditemailSetup, @EditemailSetup);
end.



