home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a084 / 2.ddi / CKSAMPLE / ISOLE.PRG < prev    next >
Encoding:
Text File  |  1993-05-25  |  2.6 KB  |  115 lines
  1. function isole
  2. parameters tablename,fieldname
  3.  
  4. * This routine checks to see if the given memo field
  5. * contains the OLE signature.
  6.  
  7. * constants
  8. left_right = .f.
  9. right_left = .t.
  10. ole_signature = chr(21)+chr(28)
  11.  
  12. fieldname = upper(fieldname)
  13.  
  14. * open the table
  15. chan = fopen(tablename)
  16. if chan < 0
  17.     return -1
  18. endif
  19.  
  20. * check to make sure this is a FoxPro table
  21. onebyte = fread(chan,1)
  22. if asc(onebyte) <> 245
  23.     =fclose(chan)
  24.     return -4
  25. endif
  26.  
  27. * throw away last update date
  28. junk = fread(chan,3)
  29.  
  30. * get number of records
  31. four_bytes = fread(chan,4)
  32. num_recs = hex2int(four_bytes,right_left)
  33.  
  34. * get first data record position
  35. two_bytes = fread(chan,2)
  36. data_start = hex2int(two_bytes,right_left)
  37.  
  38. * get length of one data record
  39. two_bytes = fread(chan,2)
  40. rec_length = hex2int(two_bytes,right_left)
  41.  
  42. junk = fread(chan,20)
  43.  
  44. * get first field name
  45. fname = fread(chan,10)
  46. do while upper(fname) <> fieldname and not feof(chan)
  47.     junk = fread(chan,22)
  48.     fname = fread(chan,10)
  49. enddo
  50.  
  51. * was the requested field in the table?
  52. if fname = fieldname
  53.     junk = fread(chan,1)
  54.     
  55.     * check to see if this field is a memo field
  56.     onebyte = fread(chan,1)
  57.     if onebyte <> 'M'
  58.         = fclose(chan)
  59.         return -2
  60.     else
  61.         * we know that this field is a memo
  62.         
  63.         * open memo file
  64.         mfile_name = left(tablename,len(tablename)-(len(tablename)-rat(".",tablename))) + "FPT"
  65.         memo_file = fopen(mfile_name)
  66.         if memo_file < 0
  67.             =fclose(chan)
  68.             return -7
  69.         endif
  70.         
  71.         * get block size
  72.         junk = fread(memo_file,6)
  73.         two_bytes = fread(memo_file,2)
  74.         block_size = hex2int(two_bytes,left_right)
  75.         
  76.         * get displacement of field in record
  77.         four_bytes = fread(chan,4)
  78.         field_disp = hex2int(four_bytes,right_left)
  79.                 
  80.         * scan through each record to see if data is OLE
  81.         * go to start of data
  82.         = fseek(chan,data_start,0)
  83.         * go to field location within record
  84.         = fseek(chan,field_disp,1)
  85.         for i = 1 to num_recs
  86.             * get block number in memo file
  87.             block_num = val(fread(chan,10))
  88.             * if the memo is not empty
  89.             if block_num > 0
  90.                 * go to the start of this memo (+8 is signature offset)
  91.                 = fseek(memo_file,(block_size * block_num)+8,0)
  92.                 * get signature
  93.                 two_bytes = fread(memo_file,2)
  94.                 if two_bytes <> ole_signature
  95.                     * This is not an OLE object. Get out.
  96.                     =fclose(chan)
  97.                     =fclose(memo_file)
  98.                     return -6
  99.                 endif        
  100.             endif
  101.             * Go to next memo field
  102.             = fseek(chan,rec_length - 10,1)
  103.         endfor
  104.         * if we got this far each memo had an OLE signature
  105.         =fclose(chan)
  106.         =fclose(memo_file)
  107.         return 1        
  108.     endif
  109. else
  110.     * requested field was not in the table
  111.     =fclose(chan)
  112.     return -5
  113. endif
  114.  
  115.