Reusable Part S_153RML: Email
Name: S_153RML
Description: The following RDMLX reusable part is used by various other email demonstration forms to define and send email.
;
;
* ----------;
* Disclaimer;
* ----------;
*;
* This material is supplied as an example only.;
*;
* No warranty concerning this material or its use in any way;
* whatsoever is expressed or implied.;
*;
;
;
FUNCTION OPTIONS(*DIRECT);
BEGIN_COM DISPLAYPOSITION(1) TABPOSITION(1);
;
DEFINE_COM CLASS(#STD_TEXTS) NAME(#MAIL_PROFILE);
DEFINE_COM CLASS(#STD_TEXTS) NAME(#MAIL_PASSWORD);
DEFINE_COM CLASS(#STD_BOOL) NAME(#MAIL_RECEIPT);
DEFINE_COM CLASS(#STD_TEXTL) NAME(#MAIL_SUBJECT);
DEFINE_COM CLASS(#STD_BOOL) NAME(#MAIL_SESSION);
;
Define_Pty MAPIProfile Set(*auto #MAIL_PROFILE);
Define_Pty MAPIPassword Set(*auto #MAIL_PASSWORD);
Define_Pty ReceiptRequired Set(*auto #MAIL_RECEIPT);
Define_Pty Subject Set(*auto #MAIL_SUBJECT);
Define_Pty SeparateSession Set(*auto #MAIL_SESSION);
;
Define_Evt MailErrorDetected;
;
* Text definition Values;
;
Define #Itm_Space RefFld(#Std_Texts);
Define #Itq_Space RefFld(#Itm_Space);
;
Def_Cond *ISpace '#Itm_Space *ne *Blanks';
Def_Cond *NoISpace '#Itm_Space *eq *Blanks';
;
Define #Itm_Name RefFld(#Std_Texts);
Define #Itm_Seqn RefFld(#Std_Num);
;
Define #Itm_Text *Char 255;
Define #Itm_TextA *Char 1 To_Overlay(#Itm_Text 1);
Define #Itm_TextB *Char 254 To_Overlay(#Itm_Text 2);
Define #Itm_Temp *Char 254;
;
Define #Itm_AdCR RefFld(#Std_Bool);
Define #Itm_Blank RefFld(#Std_Bool);
;
Group_By #XG_ItmGrp Fields(#Itm_Name #Itm_Seqn #Itm_Text #Itm_AdCR #Itm_Blank);
Group_By #XG_ItqGrp Fields(#Itm_Seqn #Itm_Name);
;
;
* Attachment definition Values;
;
Define #Atc_Space RefFld(#Itm_Space);
;
Def_Cond *ASpace '#Atc_Space *ne *Blanks';
Def_Cond *NoASpace '#Atc_Space = *Blanks';
;
Define #Atc_Name RefFld(#Std_TextS);
Define #Atc_File RefFld(#SysVar$Av) Length(*RefFld *Minus 1);
;
Group_By #XG_AtcGrp Fields(#Atc_Name #Atc_File);
;
;
* Recipient definition Values;
;
Define #Rcp_Space RefFld(#Itm_Space);
;
Def_Cond *RSpace '#Rcp_Space *ne *Blanks';
Def_Cond *NoRSpace '#Rcp_Space = *Blanks';
;
Define #Rcp_Name RefFld(#Std_TextS);
Define #Rcp_Type Type(*char) Length(3);
Define #Rcp_VName RefFld(#SysVar$Av) Length(*RefFld *Minus 1);
Define #Rcp_Addr RefFld(#SysVar$Av) Length(*RefFld *Minus 1);
Define #Rcp_SMTP RefFld(#Std_Bool);
;
Group_By #XG_RcpGrp Fields(#Rcp_Name #Rcp_Type #Rcp_VName #Rcp_Addr #Rcp_SMTP);
;
;
* Miscellaneous Definitions;
;
Define #BRetCode *char 2;
Def_Cond *RetOkay '#BRetCode = ok';
Def_Cond *RetNOkay '#BRetCode *ne ok';
;
Define #MBRetCode *char 2;
Def_Cond *MailOkay '#MBRetCode = ok';
Def_Cond *MailNOkay '#MBRetCode *ne ok';
;
Define #TempChar *Char 10;
Define #TempNum RefFld(#Date) Length(10) Decimals(0) edit_code(4) default(0) To_Overlay(#TempChar);
Define #NextName RefFld(#Std_Num);
;
;
* ============================================================;
;
SubRoutine CrtUSpace ((#RetSpace *Returned));
;
Define #RetSpace RefFld(#Itm_Space);
;
* Loop around until a unique non-existent space name can be found;
;
Begin_Loop Using(#TempNum);
Use TConcat (*Component '.' #TempChar) (#RetSpace);
Use Space_Operation (#RetSpace CheckExistence) (#BRetCode);
Leave *RetNOkay;
End_Loop ;
;
* Create the uniquely named space and return the name used to the caller;
;
Use Create_Space (#RetSpace);
;
EndRoutine ;
;
* ============================================================;
;
SubRoutine MakeName ((#UseName *Both));
;
Define #UseName RefFld(#Std_Texts);
;
If '#UseName = *Blanks';
Change #NextName '#NextName + 1';
Change #TempNum #NextName;
Change #UseName #TempChar;
Endif ;
;
EndRoutine ;
;
;
* ============================================================;
;
Subroutine Initialize;
Set (#MAIL_Profile #MAIL_Password #Mail_Subject) Value(' ');
Set #MAIL_Receipt Value(FALSE);
Set #MAIL_Session Value(FALSE);
Change #NextName 0;
EndRoutine ;
;
* ============================================================;
;
EvtRoutine Handling(#Com_Owner.CreateInstance);
;
Execute Initialize;
;
EndRoutine ;
;
* ============================================================;
;
MthRoutine Close;
;
Execute Initialize;
;
If *ISpace;
Use Destroy_Space (#Itm_Space);
Use Destroy_Space (#Itq_Space);
Change (#Itm_Space #Itq_Space) *Null;
Endif ;
;
If *ASpace;
Use Destroy_Space (#Atc_Space);
Change #Atc_Space *Null;
Endif ;
;
If *RSpace;
Use Destroy_Space (#Rcp_Space);
Change #Rcp_Space *Null;
Endif ;
;
EndRoutine ;
;
* ============================================================;
;
SubRoutine Open;
;
If *NoISpace;
;
Execute CrtUSpace (#Itm_Space);
Use Define_Space_Cell (#Itm_Space Itm_Name 'Key NoCase');
Use Define_Space_Cell (#Itm_Space Itm_Seqn);
Use Define_Space_Cell (#Itm_Space Itm_Text);
Use Define_Space_Cell (#Itm_Space Itm_AdCR);
Use Define_Space_Cell (#Itm_Space Itm_Blank);
;
Execute CrtUSpace (#Itq_Space);
Use Define_Space_Cell (#Itq_Space Itm_Seqn Key);
Use Define_Space_Cell (#Itq_Space Itm_Name);
;
Endif ;
;
If *NoASpace;
;
Execute CrtUSpace (#Atc_Space);
Use Define_Space_Cell (#Atc_Space Atc_Name 'Key Nocase');
Use Define_Space_Cell (#Atc_Space Atc_File);
;
Endif ;
;
If *NoRSpace;
;
Execute CrtUSpace (#Rcp_Space);
Use Define_Space_Cell (#Rcp_Space Rcp_Name 'Key Nocase');
Use Define_Space_Cell (#Rcp_Space Rcp_Type);
Use Define_Space_Cell (#Rcp_Space Rcp_VName);
Use Define_Space_Cell (#Rcp_Space Rcp_Addr);
Use Define_Space_Cell (#Rcp_Space Rcp_SMTP);
;
Endif ;
;
;
EndRoutine ;
;
* ============================================================;
;
Subroutine CvttoChar ((#Cvt_Dec *Received)(#Cvt_Val *Received)(#Cvt_Rslt *Returned));
;
Define #Cvt_Dec RefFld(#Std_Num);
Define #Cvt_Val Type(*dec) Length(30) Decimals(9);
Define #Cvt_Rslt RefFld(#SysVar$Av);
;
Define #Work00 *dec 21 0;
Define #Work01 *dec 21 1;
Define #Work02 *dec 21 2;
Define #Work03 *dec 21 3;
Define #Work04 *dec 21 4;
Define #Work05 *dec 21 5;
Define #Work06 *dec 21 6;
Define #Work07 *dec 21 7;
Define #Work08 *dec 21 8;
Define #Work09 *dec 21 9;
;
Define #WorkTemp *Char 31;
;
Case #Cvt_Dec;
;
When '= 0';
Change #Work00 #Cvt_Val;
use Numeric_String (#Work00) (#WorkTemp);
When '= 1';
Change #Work01 #Cvt_Val;
use Numeric_String (#Work01) (#WorkTemp);
When '= 2';
Change #Work02 #Cvt_Val;
use Numeric_String (#Work02) (#WorkTemp);
When '= 3';
Change #Work03 #Cvt_Val;
use Numeric_String (#Work03) (#WorkTemp);
When '= 4';
Change #Work04 #Cvt_Val;
use Numeric_String (#Work04) (#WorkTemp);
When '= 5';
Change #Work05 #Cvt_Val;
use Numeric_String (#Work05) (#WorkTemp);
When '= 6';
Change #Work06 #Cvt_Val;
use Numeric_String (#Work06) (#WorkTemp);
When '= 7';
Change #Work07 #Cvt_Val;
use Numeric_String (#Work07) (#WorkTemp);
When '= 8';
Change #Work08 #Cvt_Val;
use Numeric_String (#Work08) (#WorkTemp);
Otherwise ;
Change #Work09 #Cvt_Val;
use Numeric_String (#Work09) (#WorkTemp);
;
EndCase ;
;
Change #Cvt_Rslt #WorkTemp;
;
EndRoutine ;
;
;
;
* ============================================================;
;
MthRoutine InsertItem;
Define_Map *Input #Std_Texts #SymName Mandatory(' ');
Define_Map *Input #Std_Num #Order Mandatory(0);
Define_Map *input #SysVar$Av #TextValue Mandatory(' ');
Define_Map *Input #Std_NumL #NumericValue Mandatory(-9999999.99999);
Define_Map *Input #Std_Num #Decimals Mandatory(0);
Define_Map *Input #Std_Bool #AppendCR Mandatory('TRUE');
Define_Map *Input #Std_Bool #LeadingBlank Mandatory('FALSE');
;
Execute Open;
;
Execute MakeName (#SymName.Value);
;
Change #Itm_Name #SymName.Value;
Change #Itm_Seqn #Order.Value;
;
if '#NumericValue.Value *ne -9999999.99999';
Execute CvttoChar (#Decimals.Value #NumericValue.Value #Itm_Text);
Else ;
Change #Itm_Text #TextValue.Value;
Endif ;
;
Change #Itm_AdCR #AppendCR.Value;
Use UpperCase (#Itm_AdCR) (#Itm_AdCR);
;
Change #Itm_Blank #LeadingBlank.Value;
Use UpperCase (#Itm_Blank) (#Itm_Blank);
;
Use Insert_In_Space (#Itm_Space #XG_ItmGrp);
Use Insert_In_Space (#Itq_Space #XG_ItqGrp);
;
EndRoutine ;
;
* ============================================================;
;
MthRoutine DeleteItem;
Define_Map *Input #Std_Texts #SymName;
;
Change #Itm_Name #SymName.Value;
;
Use Fetch_In_Space (#Itm_Space #Itm_Name) (#BRetCode #XG_ItmGrp);
;
If *RetOkay;
;
Use Delete_In_Space (#Itq_Space #Itm_Seqn);
;
Use Delete_In_Space (#Itm_Space #Itm_Name);
;
Endif ;
;
;
EndRoutine ;
;
* ============================================================;
;
MthRoutine UpdateItem;
Define_Map *Input #Std_Texts #SymName;
Define_Map *input #SysVar$Av #TextValue Mandatory(' ');
Define_Map *Input #Std_NumL #NumericValue Mandatory(-9999999.99999);
Define_Map *Input #Std_Num #Decimals Mandatory(0);
Define_Map *Input #Std_Bool #AppendCR Mandatory('SAME');
Define_Map *Input #Std_Bool #LeadingBlank Mandatory('SAME');
;
Execute Open;
;
Change #Itm_Name #SymName.Value;
;
Use Fetch_In_Space (#Itm_Space #Itm_Name) (#BRetCode #XG_ItmGrp);
;
If *RetOkay;
;
if '#NumericValue.Value *ne -9999999.99999';
Execute CvttoChar (#Decimals.Value #NumericValue.Value #Itm_Text);
Else ;
Change #Itm_Text #TextValue.Value;
Endif ;
;
Use UpperCase (#AppendCR) (#AppendCR);
;
if '#AppendCR.Value *ne SAME';
Change #Itm_AdCR #AppendCR.Value;
Use UpperCase (#Itm_AdCR) (#Itm_AdCR);
Endif ;
;
If '#LeadingBlank.Value *ne SAME';
Change #Itm_Blank #LeadingBlank.Value;
Use UpperCase (#Itm_Blank) (#Itm_Blank);
Endif ;
;
Use Update_In_Space (#Itm_Space #XG_ItmGrp);
;
Endif ;
;
EndRoutine ;
;
;
* ============================================================;
;
MthRoutine InsertAttachment;
Define_Map *Input #Std_Texts #SymName Mandatory(' ');
Define_Map *input #SysVar$Av #FileName Mandatory(' ');
;
Execute Open;
;
Execute MakeName (#SymName.Value);
;
Change #Atc_Name #SymName.Value;
Change #Atc_File #FileName.Value;
;
Use Insert_In_Space (#Atc_Space #XG_AtcGrp);
;
EndRoutine ;
;
* ============================================================;
;
MthRoutine DeleteAttachment;
Define_Map *Input #Std_Texts #SymName;
;
Execute Open;
;
Change #Atc_Name #SymName.Value;
;
Use Delete_In_Space (#Atc_Space #Atc_Name);
;
EndRoutine ;
;
* ============================================================;
;
MthRoutine UpdateAttachment;
Define_Map *Input #Std_Texts #SymName;
Define_Map *input #SysVar$Av #FileName Mandatory('SAME');
;
Execute Open;
;
Change #Atc_Name #SymName.Value;
;
Use Fetch_In_Space (#Atc_Space #Atc_Name) (#BRetCode #XG_AtcGrp);
;
If *RetOkay;
;
if '#FileName.Value *ne SAME';
Change #Atc_File #FileName.Value;
Endif ;
;
Use Update_In_Space (#Atc_Space #XG_AtcGrp);
;
Endif ;
;
EndRoutine ;
;
;
* ============================================================;
;
MthRoutine InsertRecipient;
Define_Map *Input #Std_Texts #SymName Mandatory(' ');
Define_Map *Input #Std_Bool #Type Mandatory('TO');
Define_Map *input #SysVar$Av #EMailAddress Mandatory(' ');
Define_Map *input #SysVar$Av #VisualName Mandatory(' ');
Define_Map *input #Std_Bool #SMTPPrefix Mandatory('TRUE');
;
Execute Open;
;
Execute MakeName (#SymName.Value);
;
If '#VisualName.Value = *Blanks';
Set #VisualName Value(#EMailAddress.Value);
Endif ;
;
Change #Rcp_Name #SymName.Value;
Change #Rcp_Type #Type.Value;
Use UpperCase (#Rcp_Type) (#Rcp_Type);
Change #Rcp_VName #VisualName.Value;
Change #Rcp_Addr #EMailAddress.Value;
Change #Rcp_SMTP #SMTPPrefix.Value;
Use UpperCase (#Rcp_SMTP) (#Rcp_SMTP);
;
Use Insert_In_Space (#Rcp_Space #XG_RcpGrp);
;
EndRoutine ;
;
* ============================================================;
;
MthRoutine DeleteRecipient;
Define_Map *Input #Std_Texts #SymName;
;
Change #Rcp_Name #SymName.Value;
;
Use Delete_In_Space (#Rcp_Space #Rcp_Name);
;
EndRoutine ;
;
* ============================================================;
;
MthRoutine UpdateRecipient;
Define_Map *Input #Std_Texts #SymName;
Define_Map *Input #Std_Bool #Type Mandatory('SAME');
Define_Map *input #SysVar$Av #EMailAddress Mandatory('SAME');
Define_Map *input #SysVar$Av #VisualName Mandatory('SAME');
Define_Map *input #Std_Bool #SMTPPrefix Mandatory('SAME');
;
Execute Open;
;
Change #Rcp_Name #SymName.Value;
;
Use Fetch_In_Space (#Rcp_Space #Rcp_Name) (#BRetCode #XG_RcpGrp);
;
If *RetOkay;
;
if '#Type.Value *ne SAME';
Change #Rcp_Type #Type.Value;
Use UpperCase (#Rcp_Type) (#Rcp_Type);
Endif ;
;
if '#SMTPPrefix.Value *ne SAME';
Change #Rcp_SMTP #SMTPPrefix.Value;
Use UpperCase (#Rcp_SMTP) (#Rcp_SMTP);
Endif ;
;
if '#VisualName.Value *ne SAME';
Change #Rcp_VName #VisualName.Value;
Endif ;
;
if '#EMailAddress.Value *ne SAME';
Change #Rcp_Addr #EMailAddress.Value;
Endif ;
;
Use Update_In_Space (#Rcp_Space #XG_RcpGrp);
;
Endif ;
;
EndRoutine ;
;
;
;
* ============================================================;
;
MthRoutine Send;
Define_Map *Output #Std_Num #ErrorCount Mandatory(0);
Def_Cond *MailError '#ErrorCount.Value > 0';
Define #Char255 *Char 255;
Define #Char005 *char 4;
;
* Perform standard open;
;
Execute Open;
;
* Initialize the error counter;
;
Set #ErrorCount Value(0);
;
* Start the mail interfacing logic;
;
Use Mail_Start () (#MBRetCode);
Execute CheckError (#ErrorCount.Value);
If *MailError;
Return ;
Endif ;
;
* Set the profile name;
;
If '#Mail_Profile.Value *ne *blanks';
Change #Char255 #Mail_Profile.Value;
Use Mail_Set_Option (ProfileName #Char255) (#MBRetCode);
Execute CheckError (#ErrorCount.Value);
If *MailError;
Return ;
Endif ;
Endif ;
;
* Set the password;
;
If '#Mail_Password.Value *ne *blanks';
Change #Char255 #Mail_Password.Value;
Use Mail_Set_Option (Password #Char255) (#MBRetCode);
Execute CheckError (#ErrorCount.Value);
If *MailError;
Return ;
Endif ;
Endif ;
;
* Set the requires receipt option;
;
Change #Std_Bool #Mail_Receipt.Value;
Use UpperCase (#Std_Bool) (#Std_Bool);
If '#Std_Bool = True';
Use Mail_Set_Option (Receipt_Requested Y) (#MBRetCode);
Execute CheckError (#ErrorCount.Value);
If *MailError;
Return ;
Endif ;
Endif ;
;
* Set the separate session option;
;
Change #Std_Bool #Mail_Session.Value;
Use UpperCase (#Std_Bool) (#Std_Bool);
If '#Std_Bool = True';
Use Mail_Set_Option (MAPI_NEW_SESSION Y) (#MBRetCode);
Execute CheckError (#ErrorCount.Value);
If *MailError;
Return ;
Endif ;
Endif ;
;
;
* Set the subject;
;
If '#Mail_Subject.Value *ne *blanks';
Change #Char255 #Mail_Subject.Value;
Use Mail_Set_Subject (#Char255) (#MBRetCode);
Execute CheckError (#ErrorCount.Value);
If *MailError;
Return ;
Endif ;
Endif ;
;
;
* Add the text details;
;
Use Select_In_Space (#Itq_Space) (#BRetCode #XG_ItqGrp);
DoWhile *RetOkay;
Use Fetch_In_Space (#Itm_Space #Itm_Name) (#BRetCode #XG_ItmGrp);
;
If *RetOkay;
;
If '#Itm_Blank = True';
Change #Itm_Temp #Itm_Text;
Change #Itm_Text *Null;
Change #Itm_TextB #Itm_Temp;
EndIf ;
;
if '#Itm_AdCR = True';
Use Mail_Add_Text (#Itm_Text Y) (#MBRetCode);
Else ;
Use Mail_Add_Text (#Itm_Text N) (#MBRetCode);
Endif ;
;
Execute CheckError (#ErrorCount.Value);
If *MailError;
Return ;
Endif ;
;
Endif ;
;
Use SelectNext_In_Space (#Itq_Space) (#BRetCode #XG_ItqGrp);
EndWhile ;
;
;
* Add the recipient details;
;
Use Select_In_Space (#Rcp_Space) (#BRetCode #XG_RcpGrp);
DoWhile *RetOkay;
;
If '#Rcp_SMTP = True';
Change #Char005 #Rcp_Addr;
Use UpperCase (#Char005) (#Char005);
If '#Char005 *ne SMTP:';
Use TConcat ('SMTP:' #Rcp_Addr) (#Rcp_Addr);
Endif ;
Endif ;
;
Use Mail_Add_Recipient (#Rcp_Type #Rcp_VName #Rcp_Addr) (#MBRetCode);
;
Execute CheckError (#ErrorCount.Value);
If *MailError;
Return ;
Endif ;
;
Use SelectNext_In_Space (#Rcp_Space) (#BRetCode #XG_RcpGrp);
EndWhile ;
;
;
* Add the attachment details;
;
Use Select_In_Space (#Atc_Space) (#BRetCode #XG_AtcGrp);
DoWhile *RetOkay;
;
Use Mail_Add_Attachment (#Atc_File) (#MBRetCode);
;
Execute CheckError (#ErrorCount.Value);
If *MailError;
Return ;
Endif ;
;
Use SelectNext_In_Space (#Atc_Space) (#BRetCode #XG_AtcGrp);
EndWhile ;
;
;
* Now send the mail;
;
Use Mail_Send () (#MBRetCode);
Execute CheckError (#ErrorCount.Value);
If *MailError;
Return ;
Endif ;
;
EndRoutine ;
;
;
* ============================================================;
;
Subroutine CheckError ((#ErrCount *Both));
Define #ErrCount RefFld(#Std_Num);
;
If *MailNOkay;
Change #ErrCount '#ErrCount + 1';
Signal MailErrorDetected;
Endif ;
;
EndRoutine ;
;
;
END_COM ;
Name: S_153RML
Description: The following RDMLX reusable part is used by various other email demonstration forms to define and send email.
;
;
* ----------;
* Disclaimer;
* ----------;
*;
* This material is supplied as an example only.;
*;
* No warranty concerning this material or its use in any way;
* whatsoever is expressed or implied.;
*;
;
;
FUNCTION OPTIONS(*DIRECT);
BEGIN_COM DISPLAYPOSITION(1) TABPOSITION(1);
;
DEFINE_COM CLASS(#STD_TEXTS) NAME(#MAIL_PROFILE);
DEFINE_COM CLASS(#STD_TEXTS) NAME(#MAIL_PASSWORD);
DEFINE_COM CLASS(#STD_BOOL) NAME(#MAIL_RECEIPT);
DEFINE_COM CLASS(#STD_TEXTL) NAME(#MAIL_SUBJECT);
DEFINE_COM CLASS(#STD_BOOL) NAME(#MAIL_SESSION);
;
Define_Pty MAPIProfile Set(*auto #MAIL_PROFILE);
Define_Pty MAPIPassword Set(*auto #MAIL_PASSWORD);
Define_Pty ReceiptRequired Set(*auto #MAIL_RECEIPT);
Define_Pty Subject Set(*auto #MAIL_SUBJECT);
Define_Pty SeparateSession Set(*auto #MAIL_SESSION);
;
Define_Evt MailErrorDetected;
;
* Text definition Values;
;
Define #Itm_Space RefFld(#Std_Texts);
Define #Itq_Space RefFld(#Itm_Space);
;
Def_Cond *ISpace '#Itm_Space *ne *Blanks';
Def_Cond *NoISpace '#Itm_Space *eq *Blanks';
;
Define #Itm_Name RefFld(#Std_Texts);
Define #Itm_Seqn RefFld(#Std_Num);
;
Define #Itm_Text *Char 255;
Define #Itm_TextA *Char 1 To_Overlay(#Itm_Text 1);
Define #Itm_TextB *Char 254 To_Overlay(#Itm_Text 2);
Define #Itm_Temp *Char 254;
;
Define #Itm_AdCR RefFld(#Std_Bool);
Define #Itm_Blank RefFld(#Std_Bool);
;
Group_By #XG_ItmGrp Fields(#Itm_Name #Itm_Seqn #Itm_Text #Itm_AdCR #Itm_Blank);
Group_By #XG_ItqGrp Fields(#Itm_Seqn #Itm_Name);
;
;
* Attachment definition Values;
;
Define #Atc_Space RefFld(#Itm_Space);
;
Def_Cond *ASpace '#Atc_Space *ne *Blanks';
Def_Cond *NoASpace '#Atc_Space = *Blanks';
;
Define #Atc_Name RefFld(#Std_TextS);
Define #Atc_File RefFld(#SysVar$Av) Length(*RefFld *Minus 1);
;
Group_By #XG_AtcGrp Fields(#Atc_Name #Atc_File);
;
;
* Recipient definition Values;
;
Define #Rcp_Space RefFld(#Itm_Space);
;
Def_Cond *RSpace '#Rcp_Space *ne *Blanks';
Def_Cond *NoRSpace '#Rcp_Space = *Blanks';
;
Define #Rcp_Name RefFld(#Std_TextS);
Define #Rcp_Type Type(*char) Length(3);
Define #Rcp_VName RefFld(#SysVar$Av) Length(*RefFld *Minus 1);
Define #Rcp_Addr RefFld(#SysVar$Av) Length(*RefFld *Minus 1);
Define #Rcp_SMTP RefFld(#Std_Bool);
;
Group_By #XG_RcpGrp Fields(#Rcp_Name #Rcp_Type #Rcp_VName #Rcp_Addr #Rcp_SMTP);
;
;
* Miscellaneous Definitions;
;
Define #BRetCode *char 2;
Def_Cond *RetOkay '#BRetCode = ok';
Def_Cond *RetNOkay '#BRetCode *ne ok';
;
Define #MBRetCode *char 2;
Def_Cond *MailOkay '#MBRetCode = ok';
Def_Cond *MailNOkay '#MBRetCode *ne ok';
;
Define #TempChar *Char 10;
Define #TempNum RefFld(#Date) Length(10) Decimals(0) edit_code(4) default(0) To_Overlay(#TempChar);
Define #NextName RefFld(#Std_Num);
;
;
* ============================================================;
;
SubRoutine CrtUSpace ((#RetSpace *Returned));
;
Define #RetSpace RefFld(#Itm_Space);
;
* Loop around until a unique non-existent space name can be found;
;
Begin_Loop Using(#TempNum);
Use TConcat (*Component '.' #TempChar) (#RetSpace);
Use Space_Operation (#RetSpace CheckExistence) (#BRetCode);
Leave *RetNOkay;
End_Loop ;
;
* Create the uniquely named space and return the name used to the caller;
;
Use Create_Space (#RetSpace);
;
EndRoutine ;
;
* ============================================================;
;
SubRoutine MakeName ((#UseName *Both));
;
Define #UseName RefFld(#Std_Texts);
;
If '#UseName = *Blanks';
Change #NextName '#NextName + 1';
Change #TempNum #NextName;
Change #UseName #TempChar;
Endif ;
;
EndRoutine ;
;
;
* ============================================================;
;
Subroutine Initialize;
Set (#MAIL_Profile #MAIL_Password #Mail_Subject) Value(' ');
Set #MAIL_Receipt Value(FALSE);
Set #MAIL_Session Value(FALSE);
Change #NextName 0;
EndRoutine ;
;
* ============================================================;
;
EvtRoutine Handling(#Com_Owner.CreateInstance);
;
Execute Initialize;
;
EndRoutine ;
;
* ============================================================;
;
MthRoutine Close;
;
Execute Initialize;
;
If *ISpace;
Use Destroy_Space (#Itm_Space);
Use Destroy_Space (#Itq_Space);
Change (#Itm_Space #Itq_Space) *Null;
Endif ;
;
If *ASpace;
Use Destroy_Space (#Atc_Space);
Change #Atc_Space *Null;
Endif ;
;
If *RSpace;
Use Destroy_Space (#Rcp_Space);
Change #Rcp_Space *Null;
Endif ;
;
EndRoutine ;
;
* ============================================================;
;
SubRoutine Open;
;
If *NoISpace;
;
Execute CrtUSpace (#Itm_Space);
Use Define_Space_Cell (#Itm_Space Itm_Name 'Key NoCase');
Use Define_Space_Cell (#Itm_Space Itm_Seqn);
Use Define_Space_Cell (#Itm_Space Itm_Text);
Use Define_Space_Cell (#Itm_Space Itm_AdCR);
Use Define_Space_Cell (#Itm_Space Itm_Blank);
;
Execute CrtUSpace (#Itq_Space);
Use Define_Space_Cell (#Itq_Space Itm_Seqn Key);
Use Define_Space_Cell (#Itq_Space Itm_Name);
;
Endif ;
;
If *NoASpace;
;
Execute CrtUSpace (#Atc_Space);
Use Define_Space_Cell (#Atc_Space Atc_Name 'Key Nocase');
Use Define_Space_Cell (#Atc_Space Atc_File);
;
Endif ;
;
If *NoRSpace;
;
Execute CrtUSpace (#Rcp_Space);
Use Define_Space_Cell (#Rcp_Space Rcp_Name 'Key Nocase');
Use Define_Space_Cell (#Rcp_Space Rcp_Type);
Use Define_Space_Cell (#Rcp_Space Rcp_VName);
Use Define_Space_Cell (#Rcp_Space Rcp_Addr);
Use Define_Space_Cell (#Rcp_Space Rcp_SMTP);
;
Endif ;
;
;
EndRoutine ;
;
* ============================================================;
;
Subroutine CvttoChar ((#Cvt_Dec *Received)(#Cvt_Val *Received)(#Cvt_Rslt *Returned));
;
Define #Cvt_Dec RefFld(#Std_Num);
Define #Cvt_Val Type(*dec) Length(30) Decimals(9);
Define #Cvt_Rslt RefFld(#SysVar$Av);
;
Define #Work00 *dec 21 0;
Define #Work01 *dec 21 1;
Define #Work02 *dec 21 2;
Define #Work03 *dec 21 3;
Define #Work04 *dec 21 4;
Define #Work05 *dec 21 5;
Define #Work06 *dec 21 6;
Define #Work07 *dec 21 7;
Define #Work08 *dec 21 8;
Define #Work09 *dec 21 9;
;
Define #WorkTemp *Char 31;
;
Case #Cvt_Dec;
;
When '= 0';
Change #Work00 #Cvt_Val;
use Numeric_String (#Work00) (#WorkTemp);
When '= 1';
Change #Work01 #Cvt_Val;
use Numeric_String (#Work01) (#WorkTemp);
When '= 2';
Change #Work02 #Cvt_Val;
use Numeric_String (#Work02) (#WorkTemp);
When '= 3';
Change #Work03 #Cvt_Val;
use Numeric_String (#Work03) (#WorkTemp);
When '= 4';
Change #Work04 #Cvt_Val;
use Numeric_String (#Work04) (#WorkTemp);
When '= 5';
Change #Work05 #Cvt_Val;
use Numeric_String (#Work05) (#WorkTemp);
When '= 6';
Change #Work06 #Cvt_Val;
use Numeric_String (#Work06) (#WorkTemp);
When '= 7';
Change #Work07 #Cvt_Val;
use Numeric_String (#Work07) (#WorkTemp);
When '= 8';
Change #Work08 #Cvt_Val;
use Numeric_String (#Work08) (#WorkTemp);
Otherwise ;
Change #Work09 #Cvt_Val;
use Numeric_String (#Work09) (#WorkTemp);
;
EndCase ;
;
Change #Cvt_Rslt #WorkTemp;
;
EndRoutine ;
;
;
;
* ============================================================;
;
MthRoutine InsertItem;
Define_Map *Input #Std_Texts #SymName Mandatory(' ');
Define_Map *Input #Std_Num #Order Mandatory(0);
Define_Map *input #SysVar$Av #TextValue Mandatory(' ');
Define_Map *Input #Std_NumL #NumericValue Mandatory(-9999999.99999);
Define_Map *Input #Std_Num #Decimals Mandatory(0);
Define_Map *Input #Std_Bool #AppendCR Mandatory('TRUE');
Define_Map *Input #Std_Bool #LeadingBlank Mandatory('FALSE');
;
Execute Open;
;
Execute MakeName (#SymName.Value);
;
Change #Itm_Name #SymName.Value;
Change #Itm_Seqn #Order.Value;
;
if '#NumericValue.Value *ne -9999999.99999';
Execute CvttoChar (#Decimals.Value #NumericValue.Value #Itm_Text);
Else ;
Change #Itm_Text #TextValue.Value;
Endif ;
;
Change #Itm_AdCR #AppendCR.Value;
Use UpperCase (#Itm_AdCR) (#Itm_AdCR);
;
Change #Itm_Blank #LeadingBlank.Value;
Use UpperCase (#Itm_Blank) (#Itm_Blank);
;
Use Insert_In_Space (#Itm_Space #XG_ItmGrp);
Use Insert_In_Space (#Itq_Space #XG_ItqGrp);
;
EndRoutine ;
;
* ============================================================;
;
MthRoutine DeleteItem;
Define_Map *Input #Std_Texts #SymName;
;
Change #Itm_Name #SymName.Value;
;
Use Fetch_In_Space (#Itm_Space #Itm_Name) (#BRetCode #XG_ItmGrp);
;
If *RetOkay;
;
Use Delete_In_Space (#Itq_Space #Itm_Seqn);
;
Use Delete_In_Space (#Itm_Space #Itm_Name);
;
Endif ;
;
;
EndRoutine ;
;
* ============================================================;
;
MthRoutine UpdateItem;
Define_Map *Input #Std_Texts #SymName;
Define_Map *input #SysVar$Av #TextValue Mandatory(' ');
Define_Map *Input #Std_NumL #NumericValue Mandatory(-9999999.99999);
Define_Map *Input #Std_Num #Decimals Mandatory(0);
Define_Map *Input #Std_Bool #AppendCR Mandatory('SAME');
Define_Map *Input #Std_Bool #LeadingBlank Mandatory('SAME');
;
Execute Open;
;
Change #Itm_Name #SymName.Value;
;
Use Fetch_In_Space (#Itm_Space #Itm_Name) (#BRetCode #XG_ItmGrp);
;
If *RetOkay;
;
if '#NumericValue.Value *ne -9999999.99999';
Execute CvttoChar (#Decimals.Value #NumericValue.Value #Itm_Text);
Else ;
Change #Itm_Text #TextValue.Value;
Endif ;
;
Use UpperCase (#AppendCR) (#AppendCR);
;
if '#AppendCR.Value *ne SAME';
Change #Itm_AdCR #AppendCR.Value;
Use UpperCase (#Itm_AdCR) (#Itm_AdCR);
Endif ;
;
If '#LeadingBlank.Value *ne SAME';
Change #Itm_Blank #LeadingBlank.Value;
Use UpperCase (#Itm_Blank) (#Itm_Blank);
Endif ;
;
Use Update_In_Space (#Itm_Space #XG_ItmGrp);
;
Endif ;
;
EndRoutine ;
;
;
* ============================================================;
;
MthRoutine InsertAttachment;
Define_Map *Input #Std_Texts #SymName Mandatory(' ');
Define_Map *input #SysVar$Av #FileName Mandatory(' ');
;
Execute Open;
;
Execute MakeName (#SymName.Value);
;
Change #Atc_Name #SymName.Value;
Change #Atc_File #FileName.Value;
;
Use Insert_In_Space (#Atc_Space #XG_AtcGrp);
;
EndRoutine ;
;
* ============================================================;
;
MthRoutine DeleteAttachment;
Define_Map *Input #Std_Texts #SymName;
;
Execute Open;
;
Change #Atc_Name #SymName.Value;
;
Use Delete_In_Space (#Atc_Space #Atc_Name);
;
EndRoutine ;
;
* ============================================================;
;
MthRoutine UpdateAttachment;
Define_Map *Input #Std_Texts #SymName;
Define_Map *input #SysVar$Av #FileName Mandatory('SAME');
;
Execute Open;
;
Change #Atc_Name #SymName.Value;
;
Use Fetch_In_Space (#Atc_Space #Atc_Name) (#BRetCode #XG_AtcGrp);
;
If *RetOkay;
;
if '#FileName.Value *ne SAME';
Change #Atc_File #FileName.Value;
Endif ;
;
Use Update_In_Space (#Atc_Space #XG_AtcGrp);
;
Endif ;
;
EndRoutine ;
;
;
* ============================================================;
;
MthRoutine InsertRecipient;
Define_Map *Input #Std_Texts #SymName Mandatory(' ');
Define_Map *Input #Std_Bool #Type Mandatory('TO');
Define_Map *input #SysVar$Av #EMailAddress Mandatory(' ');
Define_Map *input #SysVar$Av #VisualName Mandatory(' ');
Define_Map *input #Std_Bool #SMTPPrefix Mandatory('TRUE');
;
Execute Open;
;
Execute MakeName (#SymName.Value);
;
If '#VisualName.Value = *Blanks';
Set #VisualName Value(#EMailAddress.Value);
Endif ;
;
Change #Rcp_Name #SymName.Value;
Change #Rcp_Type #Type.Value;
Use UpperCase (#Rcp_Type) (#Rcp_Type);
Change #Rcp_VName #VisualName.Value;
Change #Rcp_Addr #EMailAddress.Value;
Change #Rcp_SMTP #SMTPPrefix.Value;
Use UpperCase (#Rcp_SMTP) (#Rcp_SMTP);
;
Use Insert_In_Space (#Rcp_Space #XG_RcpGrp);
;
EndRoutine ;
;
* ============================================================;
;
MthRoutine DeleteRecipient;
Define_Map *Input #Std_Texts #SymName;
;
Change #Rcp_Name #SymName.Value;
;
Use Delete_In_Space (#Rcp_Space #Rcp_Name);
;
EndRoutine ;
;
* ============================================================;
;
MthRoutine UpdateRecipient;
Define_Map *Input #Std_Texts #SymName;
Define_Map *Input #Std_Bool #Type Mandatory('SAME');
Define_Map *input #SysVar$Av #EMailAddress Mandatory('SAME');
Define_Map *input #SysVar$Av #VisualName Mandatory('SAME');
Define_Map *input #Std_Bool #SMTPPrefix Mandatory('SAME');
;
Execute Open;
;
Change #Rcp_Name #SymName.Value;
;
Use Fetch_In_Space (#Rcp_Space #Rcp_Name) (#BRetCode #XG_RcpGrp);
;
If *RetOkay;
;
if '#Type.Value *ne SAME';
Change #Rcp_Type #Type.Value;
Use UpperCase (#Rcp_Type) (#Rcp_Type);
Endif ;
;
if '#SMTPPrefix.Value *ne SAME';
Change #Rcp_SMTP #SMTPPrefix.Value;
Use UpperCase (#Rcp_SMTP) (#Rcp_SMTP);
Endif ;
;
if '#VisualName.Value *ne SAME';
Change #Rcp_VName #VisualName.Value;
Endif ;
;
if '#EMailAddress.Value *ne SAME';
Change #Rcp_Addr #EMailAddress.Value;
Endif ;
;
Use Update_In_Space (#Rcp_Space #XG_RcpGrp);
;
Endif ;
;
EndRoutine ;
;
;
;
* ============================================================;
;
MthRoutine Send;
Define_Map *Output #Std_Num #ErrorCount Mandatory(0);
Def_Cond *MailError '#ErrorCount.Value > 0';
Define #Char255 *Char 255;
Define #Char005 *char 4;
;
* Perform standard open;
;
Execute Open;
;
* Initialize the error counter;
;
Set #ErrorCount Value(0);
;
* Start the mail interfacing logic;
;
Use Mail_Start () (#MBRetCode);
Execute CheckError (#ErrorCount.Value);
If *MailError;
Return ;
Endif ;
;
* Set the profile name;
;
If '#Mail_Profile.Value *ne *blanks';
Change #Char255 #Mail_Profile.Value;
Use Mail_Set_Option (ProfileName #Char255) (#MBRetCode);
Execute CheckError (#ErrorCount.Value);
If *MailError;
Return ;
Endif ;
Endif ;
;
* Set the password;
;
If '#Mail_Password.Value *ne *blanks';
Change #Char255 #Mail_Password.Value;
Use Mail_Set_Option (Password #Char255) (#MBRetCode);
Execute CheckError (#ErrorCount.Value);
If *MailError;
Return ;
Endif ;
Endif ;
;
* Set the requires receipt option;
;
Change #Std_Bool #Mail_Receipt.Value;
Use UpperCase (#Std_Bool) (#Std_Bool);
If '#Std_Bool = True';
Use Mail_Set_Option (Receipt_Requested Y) (#MBRetCode);
Execute CheckError (#ErrorCount.Value);
If *MailError;
Return ;
Endif ;
Endif ;
;
* Set the separate session option;
;
Change #Std_Bool #Mail_Session.Value;
Use UpperCase (#Std_Bool) (#Std_Bool);
If '#Std_Bool = True';
Use Mail_Set_Option (MAPI_NEW_SESSION Y) (#MBRetCode);
Execute CheckError (#ErrorCount.Value);
If *MailError;
Return ;
Endif ;
Endif ;
;
;
* Set the subject;
;
If '#Mail_Subject.Value *ne *blanks';
Change #Char255 #Mail_Subject.Value;
Use Mail_Set_Subject (#Char255) (#MBRetCode);
Execute CheckError (#ErrorCount.Value);
If *MailError;
Return ;
Endif ;
Endif ;
;
;
* Add the text details;
;
Use Select_In_Space (#Itq_Space) (#BRetCode #XG_ItqGrp);
DoWhile *RetOkay;
Use Fetch_In_Space (#Itm_Space #Itm_Name) (#BRetCode #XG_ItmGrp);
;
If *RetOkay;
;
If '#Itm_Blank = True';
Change #Itm_Temp #Itm_Text;
Change #Itm_Text *Null;
Change #Itm_TextB #Itm_Temp;
EndIf ;
;
if '#Itm_AdCR = True';
Use Mail_Add_Text (#Itm_Text Y) (#MBRetCode);
Else ;
Use Mail_Add_Text (#Itm_Text N) (#MBRetCode);
Endif ;
;
Execute CheckError (#ErrorCount.Value);
If *MailError;
Return ;
Endif ;
;
Endif ;
;
Use SelectNext_In_Space (#Itq_Space) (#BRetCode #XG_ItqGrp);
EndWhile ;
;
;
* Add the recipient details;
;
Use Select_In_Space (#Rcp_Space) (#BRetCode #XG_RcpGrp);
DoWhile *RetOkay;
;
If '#Rcp_SMTP = True';
Change #Char005 #Rcp_Addr;
Use UpperCase (#Char005) (#Char005);
If '#Char005 *ne SMTP:';
Use TConcat ('SMTP:' #Rcp_Addr) (#Rcp_Addr);
Endif ;
Endif ;
;
Use Mail_Add_Recipient (#Rcp_Type #Rcp_VName #Rcp_Addr) (#MBRetCode);
;
Execute CheckError (#ErrorCount.Value);
If *MailError;
Return ;
Endif ;
;
Use SelectNext_In_Space (#Rcp_Space) (#BRetCode #XG_RcpGrp);
EndWhile ;
;
;
* Add the attachment details;
;
Use Select_In_Space (#Atc_Space) (#BRetCode #XG_AtcGrp);
DoWhile *RetOkay;
;
Use Mail_Add_Attachment (#Atc_File) (#MBRetCode);
;
Execute CheckError (#ErrorCount.Value);
If *MailError;
Return ;
Endif ;
;
Use SelectNext_In_Space (#Atc_Space) (#BRetCode #XG_AtcGrp);
EndWhile ;
;
;
* Now send the mail;
;
Use Mail_Send () (#MBRetCode);
Execute CheckError (#ErrorCount.Value);
If *MailError;
Return ;
Endif ;
;
EndRoutine ;
;
;
* ============================================================;
;
Subroutine CheckError ((#ErrCount *Both));
Define #ErrCount RefFld(#Std_Num);
;
If *MailNOkay;
Change #ErrCount '#ErrCount + 1';
Signal MailErrorDetected;
Endif ;
;
EndRoutine ;
;
;
END_COM ;