home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / NWTP04 / XMESS / PMAIL.PAS next >
Pascal/Delphi Source File  |  1993-12-28  |  13KB  |  409 lines
  1. {$X+,B-,V-}
  2. Unit pmail;
  3.  
  4. {Example unit for the nwMess unit / NwTP 0.4 API. (c) 1994, R.Spronk }
  5.  
  6. INTERFACE {as of 931228}
  7.  
  8. uses nwMisc,nwBindry,nwMess,nwServ;
  9.      {nwserv used for GetFileServerDateAndTime only. }
  10.  
  11. CONST {Mail Options}
  12.   PM_NO_NOTIFY    =$02;
  13.   PM_DELIVER_IF_AF=$10;
  14.   PM_NO_CONF_REQ  =$08;
  15.   PM_NO_MAIL      =$04;
  16.  
  17. Var result:word;
  18.  
  19. Function PMailInstalled:boolean;
  20. { Checks if an object PEGASUS_MAIL of type OT_PEGASUS_MAIL exists
  21.   in the bindery. If the object exists, pmail is installed.}
  22.  
  23. Function SendMailFile(DestObjectName:string;objType:word;
  24.                       subject,fileName:string):boolean;
  25. { PEGASUS MAIL V3.0 Compatible:
  26.  
  27.   Sends a messagebody textfile (ASCII) to the mail directory of the
  28.   destination object. The object can either be a user or a group object.
  29.   Wildcards are allowed.
  30.  
  31.   The destination object will see the calling object as the message
  32.   originating object.
  33.  
  34.   Notes:
  35.   -Autoforwarding will be ignored.
  36.   -This is a single server function.
  37.   -Possible resultcodes:
  38.    $0     Success;
  39.  
  40.    $100 * The given file could not be found. Supply full path and filename.
  41.    $101 * User and Group objects only;
  42.    $102 ? Error scanning bindery, see Nwbindry.Result for netware error # ;
  43.    $110 ? Group has no members / error reading members of a group.
  44.    $111 * Group or user object doesn't exist
  45.  
  46.    $200 * Insufficient privilege to use the mail system.
  47.    $201 * You are not allowed to send to groups.
  48.    $202 * The supplied receiver user object has no access to mail /
  49.           has halted all incoming mail OR
  50.           the receiving object equals the sending object.
  51.  
  52.   -All msgs were sent when the resultcode is $00;
  53.   -No msgs are send. (resultcodes marked with *)
  54.   -Some or no msgs may have been sent before this error occured.(marked ?)
  55. }
  56.  
  57. IMPLEMENTATION{=============================================================}
  58.  
  59. Function PMailInstalled:boolean;
  60. Var lastObj     :LongInt;
  61.     foundObjName:string;
  62.     rt          :word;
  63.     rid         :LongInt;
  64.     rf,rs       :byte;
  65.     rhp         :Boolean;
  66. begin
  67. { Checks if an object PEGASUS_MAIL of type OT_PEGASUS_MAIL exists
  68.   in the bindery. If the object exists, pmail is installed.}
  69. lastObj:=-1;
  70. PmailInstalled:=ScanBinderyObject('PEGASUS_MAIL',OT_PEGASUS_MAIL,lastObj,
  71.                                   foundObjName,rt,rid,rf,rs,rhp);
  72. end;
  73.  
  74. {------------------Send file as message--------------------------------------}
  75.  
  76. Type TPmailHdr=record
  77.                from,too,date,subject,xmailer:string;
  78.                end;
  79.  
  80. var senderObjId:LongInt;
  81.     warning    :byte;
  82.     time       :novTimeRec;
  83.  
  84.  
  85. Procedure getRandomFileName(Var filename:string);
  86. { construct a semi-random filename out of the current date & time }
  87. Var tim:novTimeRec;
  88.     t  :byte;
  89. begin
  90. nwServ.GetFileServerDateAndTime(tim);
  91. fileName[0]:=#8;
  92. filename[1]:=chr(tim.month);
  93. filename[2]:=chr(tim.day);
  94. filename[3]:=chr(tim.hour);
  95. filename[4]:=chr(tim.min DIV 2);
  96. filename[5]:=chr(tim.sec DIV 2);
  97. filename[6]:=chr(random(36));
  98. filename[7]:=chr(random(36));
  99. filename[8]:=chr(random(36));
  100. for t:=1 to 8
  101.  do if filename[t]<=#9 then inc(filename[t],ord('0'))
  102.                        else inc(filename[t],ord('A')-10);
  103. end;
  104.  
  105. Function IsObjGroupMember(objId:longInt;GroupName:string):boolean;
  106. Var objName:string;
  107.     objType:word;
  108. begin
  109. IsObjGroupMember:=GetBinderyObjectName(objId,objName,objType)
  110.                and IsBinderyObjectInSet(GroupName,OT_USER_GROUP,'GROUP_MEMBERS',
  111.                                         objName,OT_USER);
  112. end;
  113.  
  114. Function PmailNotifyUser(objName:string):boolean;
  115. { Read the MAIL_OPTIONS property (created by Pmail) of the destination object.
  116.   Structure of the property:
  117.  
  118.   01 len Pmail_forwarding_adress_(asciiz)        [OPTIONAL]
  119.   02 len Internet_forwarding_adress_(asciiz)     [OPTIONAL]
  120.   03  04 extended_features_byte ???_byte         [NOT optional]
  121.   04 len Charon 3.5+ sender synonym.             [OPTIONAL]
  122.  
  123.   Notes: -len= 3+length of the next asciiz string (excluding trailing 0)
  124.          -the above fields appear within the property in random order.
  125.  
  126.   If the PM_NO_NOTIFY or the PM_NO_MAIL flag within the extended features
  127.   byte is set, then the destination object won't be notified. }
  128. Var segNbr   :word;
  129.     propValue:PropertyType;
  130.     moreSeg  :boolean;
  131.     propFlags:Byte;
  132.     t        :word;
  133.     fieldFlag:byte;
  134.     Notify   :boolean;
  135. begin
  136. SegNbr:=1;
  137. warning:=$00;
  138. IF ReadPropertyValue(objName,OT_USER,'MAIL_OPTIONS',SegNbr,
  139.                      propValue,moreSeg,propFlags)
  140.  then begin
  141.       t:=1;
  142.  
  143.       REPEAT
  144.       fieldFlag:=propValue[t];
  145.       if fieldFlag<>3 then t:=t+propValue[t+1];
  146.       UNTIL (t>127) or (fieldFlag=3);
  147.  
  148.       if fieldFlag=3
  149.        then begin
  150.             Notify:=((propValue[t+2] and PM_NO_NOTIFY)=0)
  151.                     and ((propValue[t+2] and PM_NO_MAIL)=0);
  152.             if (propValue[t+2] and PM_NO_MAIL)>0
  153.              then warning:=$02;
  154.             end;
  155.       end
  156.  else if nwBindry.result=$EC { empty property, default: notify. }
  157.        then Notify:=true
  158.        else Notify:=false; { when in doubt, don't notify }
  159. PmailNotifyUser:=Notify;
  160. end;
  161.  
  162.  
  163. Procedure SendMsgToUser(UserObjID:LongInt;VAR Hdr:TPmailHdr;fileName:string);
  164. {copy file as a msg to the users' mail directory.}
  165. Var userObjName:string;
  166.     objType    :word;
  167.     buffer     :array[1..4096] of byte;
  168.     bytesRead,bufOffs:word;
  169.     MsgFilePath,MailDir,MailFile:string;
  170.     Fin,Fout   :file;
  171.     sendIt,NotifyReceiver:boolean;
  172.     MsgFrom    :string;
  173. begin
  174. SendIt:=NOT(UserObjId=SenderObjId); { don't mail yourself }
  175.  
  176. { checking Pmail settings.. }
  177. IF IsObjGroupMember(UserObjId,'NOMAILBOX')
  178.    then SendIt:=false;
  179.  
  180. IsObjGroupMember(UserObjId,'MAILUSERS');
  181. if (nwBindry.result=$EA) { no such member }
  182.    OR IsObjGroupMember(UserObjId,'NOMAIL')
  183.  then sendit:=false;
  184.  
  185. GetBinderyObjectName(UserObjID,UserObjName,objType);
  186. NotifyReceiver:=PmailNotifyUser(UserObjName);
  187. if warning=$02 { receiving user has PM_NO_MAIL flag raised }
  188.  then sendit:=false;
  189.  
  190. if sendit
  191.  then begin
  192.       warning:=$00;
  193.       if pos('From',hdr.from)=0
  194.        then Hdr.from:=   'From:           '+Hdr.from;
  195.       MsgFrom:=Hdr.From; delete(MsgFrom,1,16);
  196.       Hdr.too :=   'To:             '+UserObjName;
  197.       if pos('Date',Hdr.date)=0
  198.        then Hdr.date:=   'Date:           '+Hdr.date;
  199.       if pos('Subj',Hdr.subject)=0
  200.        then Hdr.subject:='Subject:        '+hdr.subject;
  201.       Hdr.xmailer:='X-mailer:       NwTP gateway to Pmail.';
  202.  
  203.       bufOffs:=1;
  204.       move(hdr.from[1],buffer[bufOffs],ord(hdr.from[0]));
  205.       inc(bufOffs,2+ord(hdr.from[0]));
  206.       buffer[bufOffs-2]:=13;buffer[bufOffs-1]:=10; { ret/ lf }
  207.       move(hdr.too[1],buffer[bufOffs],ord(hdr.too[0]));
  208.       inc(bufOffs,2+ord(hdr.too[0]));
  209.       buffer[bufOffs-2]:=13;buffer[bufOffs-1]:=10; { ret/ lf }
  210.       move(hdr.date[1],buffer[bufOffs],ord(hdr.date[0]));
  211.       inc(bufOffs,2+ord(hdr.date[0]));
  212.       buffer[bufOffs-2]:=13;buffer[bufOffs-1]:=10; { ret/ lf }
  213.       move(hdr.subject[1],buffer[bufOffs],ord(hdr.subject[0]));
  214.       inc(bufOffs,2+ord(hdr.subject[0]));
  215.       buffer[bufOffs-2]:=13;buffer[bufOffs-1]:=10; { ret/ lf }
  216.       move(hdr.xmailer[1],buffer[bufOffs],ord(hdr.xmailer[0]));
  217.       inc(bufOffs,2+ord(hdr.xmailer[0]));
  218.       buffer[bufOffs-2]:=13;buffer[bufOffs-1]:=10; { ret/ lf }
  219.       buffer[bufOffs]:=13;buffer[bufOffs+1]:=10;   { empty line }
  220.       inc(bufOffs,2);
  221.  
  222.       MailDir:=HexStr(UserObjId,8);
  223.       while maildir[1]='0' do delete(Maildir,1,1);
  224.       GetRandomFileName(MailFile);
  225.  
  226.       {$I-}
  227.       MsgFilePath:='SYS:MAIL\'+MailDir+'\'+MailFile+'.CNM';
  228.       assign(Fin,fileName);
  229.       reset(Fin,1);
  230.       assign(Fout,MsgFilePath);
  231.       rewrite(Fout,1);
  232.       { buffOfs-1 = number of bytes in buffer already filled }
  233.       BlockRead(Fin,buffer[bufOffs],4096-(bufOffs-1),bytesRead);
  234.       BlockWrite(Fout,buffer[1],bytesRead+(bufOffs-1));
  235.       REPEAT
  236.       BlockRead(Fin,buffer[1],4096,bytesRead);
  237.       BlockWrite(Fout,buffer[1],bytesRead);
  238.       UNTIL bytesRead<4096;
  239.       close(Fin);
  240.       close(Fout);
  241.       {$I+}
  242.  
  243.       IF NotifyReceiver
  244.        then nwMess.SendmessageToUser(UserObjName,
  245.                    '(NwTP/Pmail:) You have mail. (From:'+MsgFrom+')')
  246.       end
  247.  else warning:=$01;
  248. end;
  249.  
  250. Procedure SendMsgToGroup(GroupObjName:string;Hdr:TPmailHdr;fileName:string);
  251. Label abrt;
  252. Var NbrOfWrites:word;
  253.     i          :byte;
  254.  
  255.     lastObj       :LongInt;
  256.     foundGroupName:string;
  257.     rt            :word;
  258.     rid           :LongInt;
  259.     rf,rs         :byte;
  260.     rhp           :boolean;
  261.  
  262.     SegNbr   :byte;
  263.     propValue:PropertyType;
  264.     moreSeg  :boolean;
  265.     propFlags:byte;
  266.  
  267.     objId : LongInt;
  268. begin
  269. NbrOfWrites:=0;
  270. lastObj:=-1;
  271. WHILE ScanBinderyObject(GroupObjName,OT_USER_GROUP,lastObj,
  272.                         foundGroupName,rt,rid,rf,rs,rhp)
  273. do begin {1}
  274.    if (GroupObjName<>'NOMAIL') and (GroupObjName<>'NOMAILBOX')
  275.    then begin {3}
  276.         SegNbr:=1;
  277.         While ReadPropertyValue(foundGroupName,OT_USER_GROUP,'GROUP_MEMBERS',
  278.                                 SegNbr,propValue,moreSeg,propFlags)
  279.          do begin {5}
  280.             i:=1;
  281.             Repeat
  282.               objId:=MakeLong((PropValue[i] *256 +PropValue[i+1]),
  283.                             (PropValue[i+2] *256 + PropValue[i+3] ) );
  284.               if objId<>0
  285.                then begin
  286.                     SendMsgToUser(objId,Hdr,fileName);
  287.                     inc(NbrOfWrites);
  288.                     end;
  289.               inc(i,4);
  290.             Until (i>128) or (objId=0);
  291.             inc(SegNbr);
  292.             end; {5}
  293.         If nwBindry.Result<>$EC {no such segment}
  294.          then begin
  295.               Result:=$110;
  296.               goto abrt;
  297.               end;
  298.         end; {3}
  299.    end; {1}
  300. if nwBindry.Result<>$FC {no such object}
  301.  then begin
  302.       result:=$111;
  303.       goto abrt;
  304.       end;
  305. if NbrOfWrites=0 {no users found}
  306.  then result:=$110;
  307.  
  308. abrt: ;
  309. end;
  310.  
  311.  
  312. Function SendMailFile(DestObjectName:string;objType:word;
  313.                       subject,fileName:string):boolean;
  314. Var secLevel  :byte;
  315.     senderName:string;
  316.     SenderObjType:word;
  317.     Hdr       :TPmailHdr;
  318.     lastObj   :longInt;
  319.     foundUserName:string;
  320.     rt        :word;
  321.     rf,rs     :byte;
  322.     rhp       :boolean;
  323.     DestObjId :longint;
  324.     testFile  :file;
  325. begin
  326. Warning:=$00;
  327.  
  328. { check: does filename exist? if not, stop right away. error $100 }
  329. {$I-}
  330. assign(testFile,filename);
  331. reset(testFile);
  332. if IOresult<>0
  333.  then begin
  334.       result:=$100;
  335.       SendmailFile:=False;
  336.       exit;
  337.       end
  338.  else close(testFile);
  339. {$I+}
  340.  
  341. GetBinderyAccessLevel(secLevel,senderObjId);
  342. GetBinderyObjectName(senderObjId,senderName,SenderObjType);
  343.  
  344. {checking pmail config. groups... }
  345. IsObjGroupMember(senderObjId,'MAILUSERS');
  346. if (nwBindry.result=$EA) { mailusers group exists, sender not a member }
  347.    OR IsObjGroupMember(senderObjId,'NOMAIL')
  348.    then begin
  349.         result:=$200; { Insufficient privilege to use the mail system. }
  350.         SendMailFile:=false;
  351.         exit;
  352.         end;
  353.  
  354. Hdr.from:=senderName;
  355. Hdr.subject:=subject;
  356. GetFileServerDateAndTime(time);
  357. NovTimeRec2String(time,Hdr.date);
  358.  
  359. Result:=0;
  360. if objType=OT_USER
  361.  then begin
  362.       lastObj:=-1;
  363.       WHILE ScanBinderyObject(DestObjectName,OT_USER,lastObj,
  364.                               foundUserName,rt,DestObjID,rf,rs,rhp)
  365.       do begin
  366.          SendMsgToUser(DestObjId,Hdr,fileName);
  367.          end;
  368.       IF nwBindry.result<>$FC { no such object } then result:=$102;
  369.       end
  370.  else if objType=OT_USER_GROUP
  371.       then begin
  372.            IsObjGroupMember(senderObjId,'GROUPMAIL');
  373.            if (nwBindry.result=$EA) { group groupmail exists, sender not a member }
  374.              OR IsObjGroupMember(senderObjId,'NOGROUPMAIL')
  375.            then result:=$201 { don't send }
  376.            else SendMsgToGroup(DestObjectName,Hdr,fileName)
  377.            end
  378.       else result:=$101;
  379.  
  380. if (warning=$01) and (objType=OT_USER) and (result=$00)
  381.    and (pos('*',DestObjectName)=0) and (pos('?',DestObjectName)=0)
  382.  then result:=$202;
  383.  
  384. SendMailFile:=(result=0);
  385. { possible resultcodes:
  386.   $0     Success;
  387.  
  388.   $100 * The given file could not be found. Supply full path and filename.
  389.   $101 * User and Group objects only;
  390.   $102 ? Error scanning bindery, see Nwbindry.Result for netware error # ;
  391.   $110 ? Group has no members / error reading members of a group.
  392.   $111 * Group or user object doesn't exist
  393.  
  394.   $200 * Insufficient privilege to use the mail system.
  395.   $201 * You are not allowed to send to groups.
  396.   $202 * The supplied receiver user object has no access to mail /
  397.          has halted all incoming mail OR
  398.          the receiving object equals the sending object.
  399.  
  400. Note: -All msgs were send when the resultcode is $00;
  401.       -No msgs are send. (resultcodes marked with *)
  402.       -Some or no msgs may have been send before this error occured.(marked ?)
  403. }
  404. end;
  405.  
  406. begin
  407. Randomize;
  408. end.
  409.