home *** CD-ROM | disk | FTP | other *** search
/ Power CD-ROM!! 7 / POWERCD7.ISO / prgmming / clipper / datepack.prg < prev    next >
Text File  |  1993-10-14  |  2KB  |  88 lines
  1. /*
  2.  * File......: DATEPACK.PRG
  3.  * Author....: Dave Pearson
  4.  * BBS.......: The Dark Knight Returns
  5.  * Net/Node..: 050/069
  6.  * User Name.: Dave Pearson
  7.  * Date......: 31/03/93
  8.  * Revision..: 1.0
  9.  *
  10.  * This is an original work by Dave Pearson and is placed in the public
  11.  * domain.
  12.  *
  13.  * Modification history:
  14.  * ---------------------
  15.  *
  16.  * $Log$
  17.  *
  18.  */
  19.  
  20. #include "GT_Lib.Ch"
  21.  
  22. /*  $DOC$
  23.  *  $FUNCNAME$
  24.  *      GT_DATEPACK()
  25.  *  $CATEGORY$
  26.  *      Compression
  27.  *  $ONELINER$
  28.  *      Pack a Clipper date value down to 50% it's original size.
  29.  *  $SYNTAX$
  30.  *      GT_DatePack([<dDate>]) --> cPackedDate
  31.  *  $ARGUMENTS$
  32.  *      <dDate> is the date value to be packed. If not passed it defaults
  33.  *      to the system date.
  34.  *  $RETURNS$
  35.  *      A character string that is a packed version of the date.
  36.  *  $DESCRIPTION$
  37.  *      GT_DatePack() can be used to pack a date value into half it's
  38.  *      original size. This can be a help when trying to reduce the size
  39.  *      requirements of your database files.
  40.  *  $EXAMPLES$
  41.  *      // Place a couple of packed date values into a database.
  42.  *
  43.  *      Customer->Entry_Date := GT_DatePack()   // Todays date.
  44.  *      Customer->Call_Date  := GT_DatePack(dCallDate)
  45.  *  $SEEALSO$
  46.  *      GT_DateUnPack()
  47.  *  $END$
  48.  */
  49.  
  50. function GT_DatePack(dDate)
  51. default dDate to date()
  52. return(chr(day(dDate))+chr(month(dDate))+i2bin(year(dDate)))
  53.  
  54. /*  $DOC$
  55.  *  $FUNCNAME$
  56.  *      GT_DATEUNPACK()
  57.  *  $CATEGORY$
  58.  *      Compression
  59.  *  $ONELINER$
  60.  *      Un-Pack a packed date created to GT_DatePack().
  61.  *  $SYNTAX$
  62.  *      GT_DateUnPack(<cPackedDate>) --> dDate
  63.  *  $ARGUMENTS$
  64.  *      <cPackedDate> is a date value in it's packed format.
  65.  *  $RETURNS$
  66.  *      A Clipper date value.
  67.  *  $DESCRIPTION$
  68.  *      GT_DateUnPack() is used to create a Clipper date value from a
  69.  *      packed date created with GT_DatePack().
  70.  *  $EXAMPLES$
  71.  *      // Retrieve a date value from a database.
  72.  *
  73.  *      dCallDate := GT_DateUnPack(Customer->Call_Date)
  74.  *  $SEEALSO$
  75.  *      GT_DatePack()
  76.  *  $END$
  77.  */
  78.  
  79. function GT_DateUnPack(cDate)
  80. local dDate := ctod(NULL)
  81. default cDate to NULL
  82. if !empty(cDate) .and. (len(cDate) == 4)
  83.    dDate := GT_SToD(padl(alltrim(str(bin2w(right(cDate,2)))),4,"0") +;
  84.                     padl(alltrim(str(asc(substr(cDate,2,1)))),2,"0")+;
  85.                     padl(alltrim(str(asc(left(cDate,1)))),2,"0"))
  86. endif
  87. return(dDate)
  88.