Olivier Hamou France Membre Simple # 0000000017 enregistré le 13/10/2004 http://www.planitron.com Hamou Olivier 94100 Saint Maur des fossés de la société PLANITRON Fiche personnelle
* DATE MODIF : 25.04.09 par olivier hamou * J'ai modifié le code afin que cette function * puisse comprendre les types de données autre que le caractère
* variable pris en charge dans le cursor ou votre table :
*
DO CASE CASE m.cVARTYPE $ "N-Y-B-F-I" REPLACE &structure[i,1] WITH VAL(accum_text) CASE m.cVARTYPE $ "C-M-Q-V-W" REPLACE &structure[i,1] WITH alltr(accum_text) CASE m.cVARTYPE $ "D" REPLACE &structure[i,1] WITH ctod(accum_text) CASE m.cVARTYPE $ "T" REPLACE &structure[i,1] WITH ctot(accum_text) ENDCASE
Code source :
*************************************************** * Append data from any delimited ASCII file into * a predefined FoxPro database file. The intent * is to read in memo field data, but the program * will also address files with varying delimiters. * This program assumes that the target database * file is currently in use, used exclusively, and * in the current work area. * * DATE MODIF : 25.04.09 par olivier hamou * J'ai modifié le code afin que cette function * puisse comprendre les types de données autre que le caractère *************************************************** Function AppendData PARAMETERS text_file, char_delimiter, field_delimiter
*************************************************** * Create an array of database structure. * Determine number of records in array for FOR * loop counting. ***************************************************
=AFIELDS(structure)
rows = ALEN(structure,1)
*************************************************** * Attempt to open text file with low-level handle. * If the test is successful, continue; otherwise, * report reason for failure. ***************************************************
file_handle = FOPEN(text_file) IF file_handle < 0 DO errhand WITHFERROR() RETURN.F. ENDIF
*************************************************** * Begin DO WHILE loop and continue until end of * file marker is reached in text file. *************************************************** DOWHILE !FEOF(file_handle) APPENDBLANK FOR i = 1 TO rows && Messagebox(structure[i,2]) && ANCIEN CODE MICROSOFT &&IF structure[i,2] $ "N-Y-B-F-I" && =readnum("",0) &&ELSE && =readchar("",0) &&ENDIF && modifié par olivier
=readchar("",0,structure[i,2]) ENDFOR ENDDO
=FCLOSE(file_handle)
*************************************************** * Read numeric field data into corresponding * field in database. ************************************************ FUNCTION readnum PARAMETERS accum_text, count_comma DOWHILE count_comma < 1 single = FREAD(file_handle,1) IFsingle = field_delimiter ORsingle = CHR(13) single = ""
count_comma = count_comma + 1 IF count_comma < 1 AND i > rows
=FSEEK(file_handle,1,1) ENDIF ELSE
accum_text = accum_text + single ENDIF ENDDO Messagebox(accum_text) REPLACE &structure[i,1]WITHVAL(accum_text)
accum_text = "" RETURN
*************************************************** * Read all field types in as character except * numeric fields. *************************************************** FUNCTION readchar PARAMETERS accum_text, count_quotes ,cVARTYPE DOWHILE count_quotes < 2 AND !FEOF(file_handle) single = FREAD(file_handle,1) IFsingle = char_delimiter single = ""
count_quotes = count_quotes + 1 IF count_quotes >= 2
x=FREAD(file_handle,1) IF x = CHR(13)
=FSEEK(file_handle,1,1) ENDIF ENDIF ELSE
accum_text = accum_text + single ENDIF ENDDO &&messagebox(structure[i,1]+" "+accum_text) DOCASE CASE m.cVARTYPE $ "N-Y-B-F-I" REPLACE (structure[i,1]) WITHVAL(accum_text) CASE m.cVARTYPE $ "C-M-Q-V-W" REPLACE (structure[i,1]) WITH alltr(accum_text) CASE m.cVARTYPE $ "D" REPLACE (structure[i,1]) WITHctod(accum_text) CASE m.cVARTYPE $ "T" REPLACE (structure[i,1]) WITHctot(accum_text) ENDCASE
accum_text = "" RETURN *************************************************** * Error handling routine *************************************************** FUNCTION errhand PARAMETERSerror DOCASE CASEerror = 2
reason = "File not found" CASEerror = 4
reason = "Too many files open" CASEerror = 5
reason = "File access denied" CASEerror = 6
reason = "Invalid file handle given" CASEerror = 8
reason = "Out of memory" CASEerror = 25
reason = "Seek error (can't seek before start of file)" CASEerror = 29
reason = "Disk is full" CASEerror = 31
reason = "Error opening file" ENDCASE WAITWINDOW"Cannot open file: "+reason EndFunc