home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / CLIPPER / ARR2FI.ZIP / SAVEARR.PRG < prev    next >
Text File  |  1994-02-09  |  5KB  |  183 lines
  1.  
  2. /*
  3.  * File......   : SAVEARR.PRG
  4.  * Author....   : Peter Kulek
  5.  * Date......   : $Date:   06 Aug 1993  $
  6.  * Compuserve ID: 100140,1220
  7.  * 
  8.  * This is an original work by Peter Kulek
  9.  * And is placed in the public domain.
  10.  *
  11.  * Modification history:
  12.  * ---------------------
  13.  */
  14.  
  15. /*
  16.    
  17.    Endor Ltd 
  18.    63 Church Road
  19.    Albrighton 
  20.    Shropshire
  21.    WV7 3HL
  22.    England
  23.  
  24.    Specialists in design and implementation of EIS and MIS systems 
  25.  
  26.    
  27.    Telephone: 
  28.        Analysis  081 558 2279    Peter Jordan  MD 
  29.        Technical 0902 374 900    Peter Kulek   Technical Director
  30.    
  31.    Compuserve ID 100140,1220
  32.    
  33.    We design EIS and MIS systems for large data users for use on
  34.    laptops to large networks with auto downloading from mainframes.
  35.  
  36.    If you have a large database and cannot get it into a user friendly 
  37.    format please give us a call and we will send you a live sample 
  38.    application that will show you how to manipulate vast quantities 
  39.    of data EASILY, with a minimum of tables. 
  40.    
  41.    For example a complete hierachy from parent holding company through 
  42.    to salesperson with profit and loss at each level, targeting, variances 
  43.    both monetary and percentage, graphs at each level for period and weekly 
  44.    figures all with five tables and designed and implemented within a month 
  45.    from recieving TOR. 
  46.    
  47.    Directors and Managers in large corporations have found it very friendly 
  48.    and most important they use it daily. 
  49.    
  50.    To really appreciate the vast amount of data and the easy interface a
  51.    copy of the application has to be seen.
  52.    
  53.    This is not some system using commercial EIS applications which need
  54.    months of training and have heaps of files floating all over the place.
  55.    This is far superior methodology to any of the current commercial offerings.
  56.     
  57.  
  58.    No Problem to large to solve.
  59. */
  60.  
  61. /*  $DOC$
  62.  *  $FUNCNAME$
  63.  *     ARRAY2FILE()
  64.  *  $CATEGORY$
  65.  *     Array
  66.  *  $ONELINER$
  67.  *     Save Clipper array to a disc file.
  68.  *  $SYNTAX$
  69.  *     Array2File( <aArray>, <cFileName>)
  70.  *  $ARGUMENTS$
  71.  *     <aArray> is any Clipper array including nested
  72.  *     <cFileName> is a DOS file name.
  73.  *  $RETURNS$
  74.  *     number of bytes in file
  75.  *  $DESCRIPTION$
  76.  *     Array2File saves a Clipper Array to a disc file.  Compiled 
  77.  *     code blocks or objects are not saved, but are stored as a NIL
  78.  *  $EXAMPLES$
  79.  *  $SEEALSO$
  80.  *     File2Array()
  81.  *  $END$
  82.  */
  83.  
  84. #include "FILEIO.CH"
  85.  
  86. #define ISARRAY(x)    (valtype(x)=='A')
  87. #define ISLOGIC(x)    (valtype(x)=='L')
  88. #define ISNUMERIC(x)  (valtype(x)=='N')
  89. #define ISCHAR(x)     (valtype(x)=='C')
  90. #define ISDATE(x)     (valtype(x)=='D')
  91. #define ISOBJECT(x)   (valtype(x)=='O')
  92. #define ISNIL(x)      x=NIL
  93.  
  94.  
  95. #ifdef TEST
  96. //Clipper /n/b/dTEST   use debug to test
  97. function test()
  98.      local nMaxLen := 1000
  99.      local bBlock := {||'test'}
  100.      local oTest  := TbrowseNew()
  101.      local aLarge := array(nMaxLen)
  102.      cls
  103.      nStart := seconds()
  104.      for i := 1 to nMaxLen
  105.          aLarge[i] := 'Element No '+str(i,4)
  106.      next
  107.      ? ' Saving Array To File - Number of Elements '+alltrim(str(nMaxLen))
  108.      Array2File('test.ary',;
  109.                        {bBlock,oTest,aLarge,46.78,789.065,45.78,;
  110.                        {date(),{'Another Element'},;
  111.                        'peter','was','here','testing'},;
  112.                        {NIL,{46,78,8,8,8,{date(),.f.,.t.,NIL}}}})
  113.      ? 'Seconds To Write '
  114.      ?? seconds()-nStart
  115.      wait
  116.      ? ' Reading Array From File '
  117.      nStart := seconds()
  118.      aArray := File2Array('test.ary')
  119.      ? 'Seconds To Read '
  120.      ?? seconds() - nStart
  121.      wait
  122.      DispArray(aArray)
  123. return(NIL)
  124. //--------------------------------------------------
  125. static function DispArray(aArray,nDepth)
  126. local nLen := len(aArray)
  127. local i
  128. nDepth  := if(ISNUMERIC(nDepth),nDepth,0)
  129. nDepth++
  130. for i := 1 to nLen
  131.     if ISARRAY(aArray[i])
  132.         DispArray(aArray[i],nDepth)
  133.     else
  134.         ? space(nDepth*4)
  135.         ?? aArray[i]
  136.     endif
  137. next
  138. nDepth--
  139. return(NIL)
  140. #endif
  141. ********************************************************************
  142. function Array2File(cFile,aRay,nDepth,hFile)
  143. local nBytes := 0
  144. local i
  145. nDepth := if(ISNUMERIC(nDepth),nDepth,0)
  146. if hFile == NIL
  147.    if (hFile := fCreate(cFile,FC_NORMAL)) == -1
  148.       return(nBytes)
  149.    endif
  150. endif
  151. nDepth++
  152. nBytes += WriteData(hFile,aRay)
  153. if ISARRAY(aRay) 
  154.    for i := 1 to len(aRay)
  155.       nBytes += Array2File(cFile,aRay[i],nDepth,hFile)
  156.    next
  157. endif
  158. nDepth--
  159. if nDepth == 0
  160.    fClose(hFile)
  161. endif
  162. return(nBytes)
  163. //-----------------------------------------------------------------------------
  164. static function WriteData(hFile,xData)
  165. local cData  := valtype(xData)
  166. local nLen
  167.    if ISCHAR(xData)
  168.        cData += i2bin(len(xData))+xData
  169.    elseif ISNUMERIC(xData)
  170.        cData += i2bin(len(alltrim(str(xData))) )+alltrim(str(xData))
  171.    elseif ISDATE(xData)
  172.        cData += i2bin(8)+dtos(xData)
  173.    elseif ISLOGIC(xData)
  174.        cData += i2bin(1)+if(xData,'T','F')
  175.    elseif ISARRAY(xData) 
  176.        cData += i2bin(len(xData))
  177.    else
  178.        cData += i2bin(0)   // NIL
  179.    endif
  180. return( fWrite(hFile,cData,len(cData)) )
  181.  
  182.  
  183.