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