home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / clipper / nettos11.zip / BINDERY / WRITPROP.PRG < prev    next >
Text File  |  1993-02-23  |  4KB  |  148 lines
  1. /*
  2.  * File......: WRITPROP.PRG
  3.  * Author....: Kevin Maher/Steve Tyrakowski
  4.  * CIS ID....: 73766,1224
  5.  * Date......: $Date$
  6.  * Revision..: $Revision$
  7.  * Log file..: $Logfile$
  8.  * 
  9.  * This is an original work by Kevin Maher and Steve Tyrakowski
  10.  * and is placed in the public domain.
  11.  *
  12.  * Modification history:
  13.  * ---------------------
  14.  *
  15.  * $Log$
  16.  *
  17.  */
  18.  
  19.  
  20. /*  $DOC$
  21.  *  $FUNCNAME$
  22.  *     FN_WrProVa()
  23.  *  $CATEGORY$
  24.  *     Bindery
  25.  *  $ONELINER$
  26.  *     Write Property Value
  27.  *  $SYNTAX$
  28.  *
  29.  *     FN_WrProVa(cOwnerName, nOwnerType, cProperty, cNewValue) => cOldValue
  30.  *
  31.  *  $ARGUMENTS$
  32.  *
  33.  *     <cOwnerName> is the name of the Bindery Object that owns the
  34.  *       Property you are trying to change. Max Len = 47
  35.  *
  36.  *     <nOwnerType> is <cOwnerName>'s Object Type.  Manifest constants
  37.  *       describing the defined types are included in the NETTO.CH
  38.  *       header file.
  39.  *
  40.  *     <cProperty> is the string containing the name of the property
  41.  *       whose value you want to change.  The property must be of
  42.  *       type item. Max Len = 15
  43.  *
  44.  *     <cNewValue> is a string containing the new value that you want stored
  45.  *       for that property. Max Len = 32,640.  Suggested Max = 128.
  46.  *
  47.  *  $RETURNS$
  48.  *
  49.  *     <cOldValue> returns the previous value of the Property if it
  50.  *          was an Item Property.  Note that fn_Error() must be
  51.  *          checked to determine if it was successful.  If not,
  52.  *          consider checking to see if the fn_rdProVal() still
  53.  *          matches the cOldValue returned here.  If a multi-segment
  54.  *          update failed in the middle, who knows what value the
  55.  *          property might now have.
  56.  *
  57.  *          The function returns NIL, and sets an error code if
  58.  *          the property you attempted to update is a SET.
  59.  *
  60.  *  $DESCRIPTION$
  61.  *
  62.  *     This function changes the value of a property of type ITEM.
  63.  *
  64.  *     Changes to a SET item should use fn_adBndO() or fn_dBndOSe()
  65.  *
  66.  *     The maximum size of the property value is 255 segments of 128
  67.  *     bytes each (32,640).  You should try to keep the values less
  68.  *     than 128 bytes for performance.
  69.  *
  70.  *  $SEEALSO$
  71.  *     fn_rdProVa() fn_adBndO() fn_dBndOSe()
  72.  *  $EXAMPLES$
  73.  *
  74.  *     cOld := FN_WrProVa("LARRY", OT_USER, "IDENTIFICATION" , "Larry H.")
  75.  *     IF fn_Error() == ESUCCESS
  76.  *      Qout("User LARRY's Full Name changed from ")
  77.  *      QQout(cOld)
  78.  *      QQout(" to Larry H.")
  79.  *     ELSE
  80.  *      Qout("Error:",fn_Error())
  81.  *     ENDIF
  82.  *
  83.  *  $END$
  84.  */
  85.  
  86. #include "ftint86.ch"
  87. #include "netto.ch"
  88.  
  89. #define NW_LOG     227
  90.  
  91. #ifdef FT_TEST
  92.   FUNCTION MAIN(cObject, nType, cProperty, cValue)
  93.     LOCAL cOld := FN_WrProVa(cObject, Val(nType), cProperty, cValue)
  94.     IF fn_Error() == ESUCCESS
  95.       QOut(cValue," replaced ", cOld)
  96.     ELSE
  97.       QOut("Error:",fn_Error())
  98.     ENDIF
  99.  
  100.   RETURN ( nil )
  101. #endif
  102.  
  103. FUNCTION FN_WrProVa(cOwner, nType, cProperty, cValue)
  104.   LOCAL nSegment  := 1
  105.   LOCAL cRetVal   := NIL
  106.   LOCAL cSend
  107.   LOCAL aOldValue
  108.  
  109.   ////////  First part of request packet doesn't change
  110.   LOCAL cStart := I2BYTE(62);          // 3Eh  API request code
  111.         + W2HILO(nType);      // nw_int Object type of Owner
  112.         + FN_NameL(cOwner,48);      // Owner's Name
  113.  
  114.   // See  crtprop.prg for Upper(cProperty) discussion
  115.   cProperty := Upper(cProperty)
  116.  
  117.   ////////  See what's in the property now, and test for ITEM type
  118.   aOldValue := fn_ScaProp(cOwner, nType, cProperty)
  119.  
  120.  
  121.   IF !aOldValue == nil .AND. aOldValue[1,6]   // was there an old value?
  122.     cRetVal := aOldValue[1,7]      // If so, save the old value
  123.   ENDIF
  124.  
  125.   DO WHILE fn_Error() == ESUCCESS .AND. Len(cValue) > 128
  126.      cSend := cStart;
  127.         + Chr(nSegment++);          // segment number being stored
  128.         + Chr(255);           // indicates more segments to come
  129.         + FN_NameL(cProperty,16); // Property Name
  130.         + Left(cValue, 128)       // This segments value
  131.  
  132.  
  133.      _fnReq(NW_LOG,cSend,"") // Go do it
  134.      cValue := Substr(cValue,129)      // Remove segment just sent
  135.   ENDDO
  136.  
  137.   IF fn_Error() == ESUCCESS
  138.     cSend := cStart;
  139.        + Chr(nSegment++);         // segment number being stored
  140.        + Chr(0);             // indicates FINAL segments
  141.        + FN_NameL(cProperty,16); // Property Name
  142.        + PadR(cValue,128,Chr(0)) // This segments value, padded to 128
  143.  
  144.     _fnReq(NW_LOG,cSend,"") // Go do it
  145.   ENDIF
  146.  
  147. RETURN cRetVal
  148.