home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a012 / 1.ddi / CHAP24.EXE / CHP2419.PRG < prev   
Encoding:
Text File  |  1991-04-30  |  1.8 KB  |  70 lines
  1. /*
  2.    Listing 24.19  DBF2DIF()
  3.    Author: Joe Booth
  4.    Excerpted from "Clipper 5: A Developer's Guide"
  5.    Copyright (c) 1991 M&T Books
  6.                       501 Galveston Drive
  7.                       Redwood City, CA 94063-4728
  8.                       (415) 366-3600
  9. */
  10.  
  11.  
  12. #define SQ chr(34)
  13. #define DQ chr(34)+chr(34)
  14. #define CRLF chr(13)+chr(10)
  15.  
  16. function dbf2dif(cDbf,cDif)
  17. LOCAL retval:=0,buffer,ctr:=0,k,mfld
  18. LOCAL how_many,fh,nbytes
  19.  
  20. use (cDBF) new ALIAS input
  21. go top
  22. fh := Fcreate(Cdif,0)
  23. if fh > -1
  24.    buffer :='TABLE'+CRLF+'0,1'+CRLF+SQ+cDBF+SQ+CRLF +;
  25.             'VECTORS'+CRLF+'0,'+str(fcount(),2)+CRLF+DQ+CRLF+;
  26.             'TUPLES'+CRLF+'0,'+str(lastrec(),6)+CRLF+DQ+CRLF+;
  27.             'DATA'+CRLF+'0,0'+CRLF+DQ+CRLF
  28.    nbytes := Fwrite(fh,buffer,len(buffer))      // DIF header
  29.    if nbytes <> len(buffer)
  30.       retval :=ferror()
  31.       fclose(fh)
  32.       return retval
  33.    endif
  34.    how_many := fcount()
  35.    while !eof()
  36.       ctr++
  37.       buffer := '-1,0'+CRLF+'BOT'+CRLF
  38.       for k = 1 to how_many
  39.         mfld   :=Fieldget(k)
  40.         buffer := buffer + difput(mfld)
  41.       next
  42.       Fwrite(fh,buffer)
  43.       skip +1
  44.    enddo
  45.    fwrite(fh,'-1,0'+CRLF+'EOD'+CRLF,11)
  46.    retval := ferror()
  47.    fclose(fh)
  48. else
  49.    retval := Ferror()
  50. endif
  51. return retval
  52.  
  53.  
  54.  
  55. function difput(fld_data)
  56. LOCAL fld_type := valtype(fld_data),retval:=""
  57. if fld_type = "C"
  58.    retval := '1,0'+CRLF+SQ+trim(fld_data)+SQ+CRLF
  59. elseif fld_type = "L"
  60.    retval := '0,'+if(fld_data,'1','0')+CRLF+;
  61.                   SQ+if(fld_data,'TRUE','FALSE')+SQ+CRLF
  62. elseif fld_type = "N"
  63.    retval := '0,'+ltrim(trim(str(fld_data)))+CRLF+SQ+'V'+SQ+CRLF
  64. elseif type("fld_data")="D"
  65.    retval := '1,0'+CRLF+SQ+dtoc(fld_data)+SQ+CRLF
  66. endif
  67. return retval
  68.  
  69. // end of file CHP2419.PRG
  70.