home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / clipper / nettos11.zip / ACCTNG / GACCSTA.PRG < prev    next >
Text File  |  1993-02-23  |  4KB  |  139 lines
  1. /*
  2.  * File......: GACCSTA.PRG
  3.  * Author....: Joseph D. Booth
  4.  * CIS ID....: 72040,2112
  5.  * Date......: $Date$
  6.  * Revision..: $Revision$
  7.  * Log file..: $Logfile$
  8.  * 
  9.  * This is an original work by Joseph D. Booth and is placed in the
  10.  * public domain.
  11.  *
  12.  * Modification history:
  13.  * ---------------------
  14.  *
  15.  * $Log$
  16.  *
  17.  */
  18.  
  19.  
  20. /*  $DOC$
  21.  *  $FUNCNAME$
  22.  *     FN_gAccStat()
  23.  *  $CATEGORY$
  24.  *     Accounting
  25.  *  $ONELINER$
  26.  *     Get Account Status of an Object
  27.  *  $SYNTAX$
  28.  *     aStatus := FN_gAccStat( cObjName,nObjType )
  29.  *  $ARGUMENTS$
  30.  *     <cObjName> is the name of the bindery object
  31.  *     <nObjType> is the bindery object's type
  32.  *
  33.  *  $RETURNS$
  34.  *
  35.  *      <aStatus> is an array containing three elements as follows:
  36.  *
  37.  *         aStatus[1] : Account Balance (numeric)
  38.  *         aStatus[2] : Credit Limit (numeric)
  39.  *         aStatus[3] : Array of holds (array)
  40.  *                      { nObject_id,nHold_Amt }
  41.  *
  42.  *     If the call was successful the status array will be updated
  43.  *     accordingly, otherwise an empty array is returned.
  44.  *    
  45.  *     If an empty array is returned, you can examine the return
  46.  *     code from FN_ERROR() for one of the following:
  47.  *
  48.  *             192      No account privileges
  49.  *
  50.  *                      The object that is making this call must
  51.  *                      be a member of the SET property 
  52.  *                      "ACCOUNT_SERVERS" for this file server,
  53.  *                      and accounting must be installed.
  54.  *
  55.  *             193      No account balance
  56.  *     
  57.  *  $DESCRIPTION$
  58.  *     
  59.  *  This function returns the status of the account status for given
  60.  *  bindery object.  The return pack holds the following information:
  61.  *
  62.  *    Account Balance:  Current balance in units of money, usually cents
  63.  *    Credit Limit   :  Minimum balance, if negative, user can request
  64.  *                      more services than the account balance allows.  If
  65.  *                      positive, you can ensure that money is alway left
  66.  *                      in the account.  Once the account balance drops
  67.  *                      below the credit limit, services will be denied.
  68.  *    Server holds   :  Services (other bindery objects) can place holds
  69.  *                      on an account.  A hold reserves a certain amount
  70.  *                      of money for the service until the service bills
  71.  *                      for it.  An object can have up to 16 holds against
  72.  *                      it.  This array contains the object id and the amount
  73.  *                      of the hold for up to the 16 service holds.
  74.  *
  75.  *  $EXAMPLES$
  76.  *     
  77.  *      #define  ACCOUNT_BALANCE     aResult[1]
  78.  *      #define  CREDIT_LIMIT        aResult[2]
  79.  *
  80.  *
  81.  *      procedure PrintJob
  82.  *      if oktorun(cWho,nType)
  83.  *         //
  84.  *         // Run the printer job
  85.  *         //
  86.  *      else
  87.  *         Alert( "Insufficient funds" )
  88.  *      endif
  89.  *      return
  90.  *
  91.  *
  92.  *      function oktorun(cWho,nType)
  93.  *      LOCAL   aResult:={}, is_ok := .F.
  94.  *      aResult := FN_gAccSta(cWho,nType)
  95.  *      if !empty( aResult )
  96.  *         is_ok := ACCOUNT_BALANCE > CREDIT_LIMIT
  97.  *      endif
  98.  *
  99.  *      return NIL
  100.  *
  101.  *  $SEEALSO$
  102.  *      FN_sAccChg() FN_sAccHold() FN_sAccNote()
  103.  *  $INCLUDE$
  104.  *     
  105.  *  $END$
  106.  */
  107.  
  108.  
  109. #include "ftint86.ch"
  110. #include "netto.ch"
  111.  
  112. #define GETACCOUNTSTAT  150      /* 96h */
  113. #define NW_ACCT_CALL    227      /* E3h */
  114.  
  115.  
  116. function fn_gaccsta(cObject,nType)
  117.   LOCAL cRequest, cReply, aStat := {}
  118.   LOCAL x,y
  119.  
  120.   default nType to  OT_USER
  121.  
  122.   cRequest := I2BYTE( GETACCOUNTSTAT )+;
  123.               W2HILO( nType )+;
  124.               FN_NAMEL( cObject )
  125.   cReply   := repl( chr(0), 258 )
  126.  
  127.   if _fnReq( NW_ACCT_CALL, cRequest, @cReply ) == 0
  128.      Aadd( aStat, HILO2L( substr(cReply,1,4) ) )
  129.      Aadd( aStat, HILO2L( substr(cReply,5,4) ) )
  130.      for x:= 130 to 252 step 8
  131.         if ( y:= HILO2L(substr(cReply,x,4)) ) > 0
  132.            Aadd( aStat, { y, HILO2L(substr(cReply,x+4,4)) } )
  133.         endif
  134.      next
  135.  
  136.   endif
  137.  
  138.   return aStat
  139.