home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / NWTP04 / NWACCT.PAS < prev    next >
Pascal/Delphi Source File  |  1994-01-01  |  19KB  |  511 lines
  1. {$X+,V-,B-}
  2. Unit nwAcct;
  3.  
  4. { nwAcct unit as of 931228 / NwTP 0.4 API. (c) 1994, R.Spronk }
  5.  
  6. INTERFACE
  7.  
  8. Uses nwMisc,nwBindry,nwConn;
  9.  
  10. { Primary functions:                  Interrupt: Comments:
  11.  
  12. * GetAccountStatus                    (F217/96)  (1)
  13. * SubmitAccountCharge                 (F217/97)  (2)(3)
  14. * SubmitAccountHold                   (F217/98)  (2)
  15. * SubmitAccountNote                   (F217/99)  (2)
  16.  
  17.   Secondary functions:
  18.  
  19. * AccountingInstalled    (4)
  20. * SetAccountStatus       (5)
  21. * AddAccountingServer    (5)
  22. * DeleteAccountingServer (5)
  23. * DeleteAccountHolds     (2)
  24.  
  25.   Notes: (1) To be called by:
  26.              -accounting servers;
  27.              -supervisor equivalent users;
  28.              -objects querying their own account status.
  29.          (2) To be called by accounting servers only.
  30.          (3) Can be imitated by supervisor-equivalent users by
  31.              calling GetAccountStatus and SetAccountStatus. Atomicity
  32.              of such a bindery transaction can not be guaranteed.
  33.          (4) Can be called by all logged on users.
  34.          (5) Supervisor equivalent users only.
  35.  
  36. }
  37.  
  38. Var result:word;
  39.  
  40.  
  41. {F217/96 [2.15c+]}
  42. Function GetAccountStatus(objName:string; objType:word;
  43.                           Var balance,limit,holds:LongInt):boolean;
  44. { equivalent to reading the ACCOUNT_BALANCE and ACCOUNT_HOLDS properties
  45.   of the object. The properties may not exist. }
  46. { !! will only work when the caller is an accounting server !! }
  47.  
  48. {F217/97 [2.15c+]}
  49. Function SubmitAccountCharge(objName:string; objType:word;
  50.                              charge,cancelHoldAmount:Longint;
  51.                              serviceType, commentType:word; comment:string):boolean;
  52. { -The cancelHold amount should be exactly the same as the amount that
  53.    was put on huld with the SubmitAccountHold call. If no
  54.    SubmitAccountHold call was made, the cancelHoldAmount should be set to zero.
  55.   -'negative charges' are allowed. They will increase the balance of
  56.    the object objName of objType.
  57.   -Use the objectType of caller for the serviceType parameter.
  58.    (audit log purposes)
  59.   -Set commentType to 0 and comment to '' if you aren't interested in the
  60.    audit log. }
  61.  
  62. {F217/98 [2.15c+]}
  63. Function SubmitAccountHold(objName:string; objType:word;
  64.                            reserveAmount:Longint         ):boolean;
  65.  
  66. {F217/99 [2.15c+]}
  67. Function SubmitAccountNote(objName:string; objType:word;
  68.                            serviceType,commentType:word; comment:string):boolean;
  69.  
  70. {--------Secondary Functions-----------------------------------------------}
  71.  
  72. Function AccountingInstalled:boolean;
  73. Function SetAccountStatus(objName:string; objType:word; balance,limit:LongInt):boolean;
  74. { need to be supervisor equivalent to use this call }
  75. Function AddAccountingServer(objName:string;objType:word):boolean;
  76. { need to be supervisor equivalent to use this call }
  77. Function DeleteAccountingServer(objName:string;objType:word):boolean;
  78. { need to be supervisor equivalent to use this call }
  79. Function DeleteAccountHolds(objName:string; objType:word):boolean;
  80. { delete all holds the caller (an accounting server) has on the
  81.   object with name objName of type objType. }
  82.  
  83. Type Tcharge=record
  84.              DaysOfCharge:Byte; { bit 0=sunday,.. bit 6=saturday }
  85.              TimeOfCharge:Byte; { 0:00=0 ..23:30 =47, half-hour
  86.                                   during which the specified 'new' rate takes effect. }
  87.              ChargeRateMultiplier,
  88.              ChargeRateDivisor:Word;
  89.              end;
  90.      TchargeRec=record
  91.                 NextChargeTime:Longint; { minutes since 1-1-1985 }
  92.                 charges:array[1..20] of Tcharge;
  93.                 end;
  94.  
  95.  
  96. Type TchargeTableEntry=array[0..47] of Real;
  97. Var ChargeTable:Array [0..6] of TchargeTableEntry;
  98.  
  99. IMPLEMENTATION {===========================================================}
  100.  
  101. USES Dos;
  102.  
  103. Var UnitReqBuffer:array[1..576] of byte;
  104.     UnitReplyBuffer:array[1..576] of byte;
  105.     UnitRegs:registers;
  106.  
  107. Procedure F2SystemCall(subf:byte;req_size,rep_size:word);
  108. begin
  109. With UnitRegs
  110.  do begin
  111.     DS := Seg(UnitReqBuffer);  SI := Ofs(UnitReqBuffer);   CX := Req_size;
  112.     ES := Seg(UnitReplyBuffer);DI := Ofs(UnitReplyBuffer); DX := rep_size;
  113.     AH := $F2; AL := subf;
  114.     MSDOS(UnitRegs);
  115.     Result:=al;
  116.     end;
  117. end;
  118.  
  119. Procedure GetBindryAccountStatus(objName:string; objType:word;
  120.                                 Var balance,limit,holds:LongInt);
  121. { called by GetAccountStatus when the calling object isn't an
  122.   accounting server. The F217/96 fails, but a bindery read will
  123.   work for supervisor-equivalent users. }
  124. Var accPropVal:propertyType;
  125.     accVal: record
  126.             _balance:LongInt; {hi-lo}
  127.             _limit:LongInt;   {hi-lo}
  128.             _Reserved:array[1..120] of byte; { NW internal info }
  129.             end ABSOLUTE accPropVal;
  130.     holdPropVal:propertyType;
  131.     holdVal: array[1..16]
  132.               of record
  133.                  AccountServerID:Longint; {hi-lo}
  134.                  HoldAmount     :LongInt; {hi-lo}
  135.                  end ABSOLUTE holdPropVal;
  136.     moreSegments:boolean;
  137.     t,propFlags:byte;
  138. begin
  139. IF ReadPropertyValue(objName,objType,'ACCOUNT_BALANCE',1,
  140.                     accPropVal,moreSegments,propFlags)
  141.   then begin
  142.        balance:=Lswap(accVal._balance);
  143.        limit:=Lswap(accVal._limit);
  144.        IF ReadPropertyValue(objName,objType,'ACCOUNT_HOLDS',1,
  145.                             holdPropVal,moreSegments,propFlags)
  146.         then begin { holds exist. }
  147.              holds:=0;
  148.              for t:=1 to 16
  149.               do if holdVal[t].AccountServerID<>0
  150.                  then holds:=holds+Lswap(holdVal[t].HoldAmount);
  151.              end;
  152.        if nwBindry.result=$FB
  153.          then begin
  154.               result:=0;
  155.               holds:=0;
  156.               end
  157.          else result:=nwBindry.result;
  158.        end
  159.   else if nwBindry.result=$FB { no such property }
  160.         then result:=$C1
  161.         else if nwBindry.result=$F1 { invalid bindery security }
  162.              then result:=$C0
  163.              else result:=nwBindry.result;
  164. { resultcodes: 00 success; C0 No Account Privileges; C1 No Account Balance;
  165.   96 Server Out Of memory; FC No Such Object; FE Server Bindery Locked;
  166.   FF Bindery Failure}
  167. end;
  168.  
  169.  
  170. {F217/96 [2.15c+]}
  171. Function GetAccountStatus(objName:string; objType:word;
  172.                           Var balance,limit,holds:LongInt):boolean;
  173. { equivalent to reading the ACCOUNT_BALANCE and ACCOUNT_HOLDS properties
  174.   of the object. The properties may not exist. }
  175. { This function will be successfull if:
  176.      a) the caller is an accounting server on the current fileserver
  177.   OR b) the caller is supervisor-equivalent
  178.   OR c) the caller is querying his own account status }
  179. var req:record
  180.         len:word;
  181.         subF:byte;
  182.         _objType:word; {hi-lo}
  183.         _objName:string[48];
  184.         end                   ABSOLUTE UnitReqBuffer;
  185.     reply:record
  186.           _balance: LongInt; {hi-lo}
  187.           _limit  : Longint; {hi-lo}
  188.           reserved: array [1..120] of byte;
  189.           _holds  : array [1..16]
  190.                      of record
  191.                         serverObjId:LongInt; {hi-lo}
  192.                         HoldAmount :LongInt  {hi-lo}
  193.                         end;
  194.           end                 ABSOLUTE UnitReplyBuffer;
  195.     t:byte;
  196. begin
  197. With req
  198.  do begin
  199.     len:=sizeOf(req)-2;
  200.     subf:=$96;
  201.     _objType:=swap(objType); { force hi-lo}
  202.     PstrCopy(_objName,objName,48); UpString(_objName);
  203.     end;
  204. F2SystemCall($17,sizeOf(req),sizeOf(reply));
  205. With reply
  206.  do begin
  207.     balance:=Lswap(_balance); { force lo-hi again }
  208.     limit:=Lswap(_limit); { force lo-hi again }
  209.     holds:=0;
  210.     for t:=1 to 16
  211.      do if _holds[t].serverObjId<>0
  212.       then holds:=holds+Lswap(_holds[t].holdAmount); { force lo-hi again }
  213.     end;
  214. IF result=$C0 { no account privileges }
  215.  then GetBindryAccountStatus(objName,objType,balance,limit,holds);
  216.       { try to read status not as an accounting server, but as a supervisor }
  217. GetAccountStatus:=(result=0);
  218. { resultcodes: 00 success; C0 No Account Privileges; C1 No Account Balance }
  219. end;
  220.  
  221.  
  222. {F217/97 [2.15c+]}
  223. Function SubmitAccountCharge(objName:string; objType:word;
  224.                              charge,cancelHoldAmount:Longint;
  225.                              serviceType, commentType:word; comment:string):boolean;
  226. { -The cancelHold amount should be exactly the same as the amount that
  227.    was put on huld with the SubmitAccountHold call. If no
  228.    SubmitAccountHold call was made, the cancelHoldAmount should be set to zero.
  229.   -'negative charges' are allowed. They will increase the balance of
  230.    the object objName of objType.
  231.   -Use the objectType of caller for the serviceType parameter.
  232.    (audit log purposes)
  233.   -Set commentType to 0 and comment to '' if you aren't interested in the
  234.    audit log.
  235.   -To be called by accounting servers only.
  236.   -Can be imitated by supervisor-equivalent users by
  237.    calling GetAccountStatus and SetAccountStatus. Atomicity
  238.    of such a bindery transcation can not be guaranteed.
  239.  
  240.    }
  241. Var req:record
  242.         len :word;
  243.         subf:byte;
  244.         _serviceType:word;    {hi-lo}
  245.         _charge     :Longint; {hi-lo}
  246.         _cancelHold :Longint; {hi-lo}
  247.         _objType    :word;    {hi-lo}
  248.         _commentType:word;    {hi-lo}
  249.         _objNameAndComment:Array[1..305] of char;
  250.         end                ABSOLUTE UnitReqBuffer;
  251.     p:byte;
  252. begin
  253. With req
  254. do begin
  255.    subf:=$97;
  256.    _serviceType:= swap(serviceType);      {force hi-lo}
  257.    _charge     :=Lswap(charge);           {force hi-lo}
  258.    _cancelHold :=Lswap(cancelHoldAmount); {force hi-lo}
  259.    _objType    := swap(objType);          {force hi-lo}
  260.    _commentType:= swap(commentType);      {force hi-lo}
  261.    p:=ord(objName[0]);if p>48 then p:=48;
  262.    UpString(objName);
  263.    Move(objname[0],_objNameandComment[1],p+1);
  264.    Move(comment[0],_objNameandComment[p+2],ord(comment[0])+1);
  265.    len:=15+p+1+ord(comment[0])+1;
  266.    end;
  267. F2SystemCall($17,req.len+2,0);
  268. SubmitAccountCharge:=(result=$00);
  269. { resultcodes: 00 successfull; C0 No Account Privileges;
  270.                C1 No Account Balance; C2 Credit Limit Exceeded. }
  271. end;
  272.  
  273.  
  274. {F217/98 [2.15c+]}
  275. Function SubmitAccountHold(objName:string; objType:word;
  276.                            reserveAmount:Longint         ):boolean;
  277. { To be called by accounting servers only. }
  278. Var req:record
  279.         len :word;
  280.         subf:byte;
  281.         _reserveAmount:Longint; {hi-lo}
  282.         _objType:word; {hi-lo}
  283.         _objName:string[48];
  284.         end                ABSOLUTE UnitReqBuffer;
  285.    p:byte;
  286. begin
  287. With req
  288. do begin
  289.    subf:=$98;
  290.    _reserveAmount:=Lswap(ReserveAmount); { force hi-lo}
  291.    _objType:=swap(objType); { force hi-lo }
  292.    p:=ord(objName[0]); if p>48 then p:=48;
  293.    _objName:=objname;UpString(_objName);_objName[0]:=chr(p);
  294.    len:=7+p+1;
  295.    end;
  296. F2SystemCall($17,req.len+2,0);
  297. SubmitAccountHold:=(result=$00);
  298. { resultcodes: 00 successfull; C0 No Account Privileges;
  299.                C1 No Account Balance; C2 Credit Limit Exceeded.
  300.                C3 Account Too Many Holds }
  301. end;
  302.  
  303. {F217/99 [2.15c+]}
  304. Function SubmitAccountNote(objName:string; objType:word;
  305.                            serviceType,commentType:word; comment:string):boolean;
  306. { To be called by accounting servers only.}
  307. Var req:record
  308.         len:word;
  309.         subf:byte;
  310.         _serviceType:word; {hi-lo}
  311.         _objType:word; {hi-lo}
  312.         _commentType:word; {hi-lo}
  313.         _objNameAndComment:array[1..305] of char;
  314.         end               ABSOLUTE UnitReqBuffer;
  315.    p:byte;
  316. begin
  317. with req
  318. do begin
  319.    subf:=$99;
  320.    _serviceType:= swap(serviceType);      {force hi-lo}
  321.    _objType    := swap(objType);          {force hi-lo}
  322.    _commentType:= swap(commentType);      {force hi-lo}
  323.    p:=ord(objName[0]);if p>48 then p:=48;
  324.    UpString(objName);
  325.    Move(objname[0],_objNameandComment[1],p+1);
  326.    Move(comment[0],_objNameandComment[p+2],ord(comment[0])+1);
  327.    len:=7+p+1+ord(comment[0])+1;
  328.    end;
  329. F2SystemCall($17,req.len+2,0);
  330. SubmitAccountNote:=(result=0);
  331. {resultcodes: 00 Successful; C0 No Account Privileges }
  332. end;
  333.  
  334. {---------------- Secondary Functions--------------------------------------}
  335.  
  336.  
  337. Function AccountingInstalled:boolean;
  338. Var propVal:propertyType;
  339.     connId:byte;
  340.     moreSegments:boolean;
  341.     propFlags:byte;
  342.     currServerName:string;
  343. begin
  344. IF NOT GetEffectiveConnectionID(ConnId)
  345.   then result:=nwConn.result
  346.   else if NOT GetFileServerName(ConnId,currServerName)
  347.         then result:=nwConn.result
  348.         else begin
  349.              ReadPropertyValue(currServerName,OT_FILE_SERVER,'ACCOUNT_SERVERS',1,
  350.                                propVal,moreSegments,propFlags);
  351.              result:=nwBindry.result;
  352.              end;
  353. AccountingInstalled:=(result=0);
  354. end;
  355.  
  356.  
  357. Function SetAccountStatus(objName:string; objType:word; balance,limit:LongInt):boolean;
  358. { will change the account status to reflect the given parameters.
  359.   any holds will not be changed.
  360.   You need to be supervisor-eq. to do this...}
  361. Var accPropVal:propertyType;
  362.     accVal: record
  363.             _balance:LongInt; {hi-lo}
  364.             _limit:LongInt;   {hi-lo}
  365.             _Reserved:array[1..120] of byte; { NW internal info }
  366.             end ABSOLUTE accPropVal;
  367.     OldBalance,OldLimit,OldHolds:LongInt;
  368.     moreSegments:boolean;
  369.     propFlags:byte;
  370. begin
  371. IF ReadPropertyValue(objName,objType,'ACCOUNT_BALANCE',1,
  372.                     accPropVal,moreSegments,propFlags)
  373.   then begin
  374.        accVal._balance:=Lswap(balance); { force hi-lo}
  375.        accVal._limit:=Lswap(limit); { force hi-lo}
  376.        WritePropertyValue(objName,objType,'ACCOUNT_BALANCE',
  377.                           1,accPropVal,FALSE);
  378.        if (nwBindry.result=$F1) or (nwBindry.result=$F8)
  379.          then result:=$C0
  380.          else result:=nwBindry.result;
  381.        end
  382.   else if nwBindry.result=$FB { no such property }
  383.         then result:=$C1
  384.         else if nwBindry.result=$F1 { invalid bindery security }
  385.              then result:=$C0
  386.              else result:=nwBindry.result;
  387. SetAccountStatus:=(result=$00);
  388. { resultcodes: 00 success; C0 No Account Privileges; C1 No Account Balance;
  389.   96 Server Out Of memory; FC No Such Object; FE Server Bindery Locked;
  390.   FF Bindery Failure}
  391. end;
  392.  
  393.  
  394. Function AddAccountingServer(objName:string;objType:word):boolean;
  395. Var ConnId:byte;
  396.     currServerName:string;
  397. begin
  398. IF NOT GetEffectiveConnectionID(ConnId)
  399.    then result:=nwConn.result
  400.    else if NOT GetFileServerName(ConnId,currServerName)
  401.            then result:=nwConn.result
  402.            else begin
  403.                 AddBinderyObjectToSet(currServerName,OT_FILE_SERVER,'ACCOUNT_SERVERS',
  404.                                       objName,objType);
  405.                 result:=nwBindry.result;
  406.                 end;
  407. AddAccountingServer:=(result=0);
  408. end;
  409.  
  410. Function DeleteAccountingServer(objName:string;objType:word):boolean;
  411. Var ConnId:byte;
  412.     currServerName:string;
  413. begin
  414. IF NOT GetEffectiveConnectionID(ConnId)
  415.    then result:=nwConn.result
  416.    else if NOT GetFileServerName(ConnId,currServerName)
  417.            then result:=nwConn.result
  418.            else begin
  419.                 DeleteBinderyObjectFromSet(currServerName,OT_FILE_SERVER,'ACCOUNT_SERVERS',
  420.                                            objName,objType);
  421.                 result:=nwBindry.result;
  422.                 end;
  423. DeleteAccountingServer:=(result=0);
  424. end;
  425.  
  426. Function DeleteAccountHolds(objName:string; objType:word):boolean;
  427. { delete all holds the caller (an accounting server) has on the
  428.   object with name objName of type objType. }
  429. var req:record
  430.         len:word;
  431.         subF:byte;
  432.         _objType:word; {hi-lo}
  433.         _objName:string[48];
  434.         end                   ABSOLUTE UnitReqBuffer;
  435.     reply:record
  436.           _balance: LongInt; {hi-lo}
  437.           _limit  : Longint; {hi-lo}
  438.           reserved: array [1..120] of byte;
  439.           _holds  : array [1..16]
  440.                      of record
  441.                         serverObjId:LongInt; {hi-lo}
  442.                         HoldAmount :LongInt  {hi-lo}
  443.                         end;
  444.           end                 ABSOLUTE UnitReplyBuffer;
  445.     t:byte;
  446.     holds:LongInt;
  447.     level:byte;
  448.     accServerId:LongInt;
  449.     accServerType:word;
  450.     accServerName:string;
  451. begin
  452. GetBinderyAccessLevel(Level,accServerID);
  453. GetBinderyObjectName(accServerID,accServerName,accServerType);
  454. With req
  455.  do begin
  456.     len:=sizeOf(req)-2;
  457.     subf:=$96;
  458.     _objType:=swap(objType); { force hi-lo}
  459.     PstrCopy(_objName,objName,48); UpString(_objName);
  460.     end;
  461. F2SystemCall($17,sizeOf(req),sizeOf(reply));
  462. if result=0
  463.  then With reply
  464.       do begin
  465.          holds:=0;
  466.          for t:=1 to 16
  467.           do if accServerID=Lswap(_holds[t].serverObjId)
  468.            then holds:=holds+Lswap(_holds[t].holdAmount); { force lo-hi again }
  469.          if holds<>0
  470.           then SubmitAccountCharge(objName,objType,0,holds,
  471.                                    accServerType,0,'clearing holds');
  472.          end;
  473. DeleteAccountHolds:=(result=0);
  474. { resultcodes: 00 success; C0 No Account Privileges; C1 No Account Balance }
  475. end;
  476.  
  477.  
  478. Function GetConnectTimeCharge(Var currentCharge:Real;Var chargeRec:TchargeRec):boolean;
  479. Var propVal:propertyType;
  480.     _chargeRec:TchargeRec             ABSOLUTE propVal;
  481.     _currcharge:record
  482.                 fill:LongInt;
  483.                 currMult,currDiv:word; {hi-lo}
  484.                 end                   ABSOLUTE propVal;
  485.     connId:byte;
  486.     moreSegments:boolean;
  487.     propFlags:byte;
  488.     currServerName:string;
  489. begin
  490. IF NOT GetEffectiveConnectionID(ConnId)
  491.    then result:=nwConn.result
  492.    else if NOT GetFileServerName(ConnId,currServerName)
  493.            then result:=nwConn.result
  494.            else if ReadPropertyValue(currServerName,OT_FILE_SERVER,
  495.                                      'CONNECT_TIME',1,
  496.                                      propVal,moreSegments,propFlags)
  497.                 then begin
  498.                      IF _currCharge.currDiv=0
  499.                       then currentCharge:=0
  500.                       else currentCharge:=Swap(_currCharge.currMult)/Swap(_currCharge.currDiv);
  501.                      move(propVal[9],propVal[5],124);
  502.                      chargeRec:=_chargeRec;
  503.                      result:=0;
  504.                      end
  505.                 else result:=nwBindry.result;
  506. GetConnectTimeCharge:=(result=0);
  507. end;
  508.  
  509.  
  510.  
  511. end.