home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a013 / 1.ddi / SOURCE.EXE / F_ARSAVE.PRG < prev    next >
Encoding:
Text File  |  1991-01-25  |  2.3 KB  |  68 lines
  1. *****************************************************************
  2. FUNCTION ARSAVE (arr_name, arr_file)
  3. *****************************************************************
  4.  
  5. * Saves an array to a disk file
  6.  
  7. * Copyright(c) 1991 -- James Occhiogrosso
  8.  
  9. LOCAL arr_string, cntr, str_num, dec_pos, elem_delim
  10.  
  11. * Define element delimiter
  12. elem_delim = CHR(255)
  13.  
  14. * Return error if any parameter is incorrect.
  15. IF PCOUNT() != 2 .OR. VALTYPE(arr_file) != 'C' .OR. ;
  16.                       VALTYPE(arr_name) != 'A'
  17.     RETURN .F.
  18. ENDIF
  19.  
  20. * If extension is not passed, default to .ARR
  21. IF AT('.', arr_file) = 0
  22.    arr_file = arr_file + '.ARR'
  23. ENDIF
  24.  
  25. * Put length of the array at start of array string.
  26. arr_string = PADL(LEN(arr_name),4) + elem_delim
  27.  
  28. * Add each element and the delimiter to the string.
  29. FOR cntr = 1 TO LEN(arr_name)
  30.    elem_type = VALTYPE(arr_name[cntr])
  31.  
  32.    IF elem_type = 'U'
  33.       * Element is undefined.
  34.       arr_string = arr_string + 'U' + elem_delim
  35.    ELSEIF elem_type = 'C'
  36.       * Element is character - No adjustment required.
  37.       arr_string = arr_string + 'C' + arr_name[cntr] + elem_delim
  38.    ELSEIF elem_type = 'D'
  39.       * Element is a date - Convert to a character string
  40.       arr_string = arr_string + 'D' + DTOC(arr_name[cntr]) + ;
  41.                                       elem_delim
  42.    ELSEIF elem_type = 'L'
  43.       * Element is logical - Convert to T or F character
  44.       arr_string = arr_string + 'L' + IF(arr_name[cntr], ;
  45.                                  'T', 'F') + elem_delim
  46.    ELSEIF elem_type = 'N'
  47.       * Element is a number. Convert to left justified string
  48.       str_num = LTRIM(STR(arr_name[cntr]))
  49.       dec_pos = AT('.', str_num)
  50.  
  51.       IF dec_pos = 0
  52.           * No decimal positions, put zero in last 3 bytes
  53.           arr_string = arr_string + 'N' + PADL(LEN(str_num),3) ; 
  54.                        + '  0' + str_num + elem_delim
  55.       ELSE
  56.           * Decimal positions exist, save them in last 3 bytes
  57.           arr_string = arr_string + 'N' +  ;
  58.                        PADL(LEN(str_num),3) + ;
  59.                        PADL(LEN(str_num)-dec_pos,3) + ;
  60.                        str_num + elem_delim
  61.       ENDIF
  62.    ENDIF
  63. NEXT
  64.  
  65. * Write the file and return .T. if successful.
  66. RETURN( MEMOWRIT(arr_file, arr_string) )
  67.  
  68.