Ver Mensaje Individual
  #10  
Antiguo 01-08-2008
[coso] coso is offline
Miembro Premium
 
Registrado: may 2008
Ubicación: Girona
Posts: 1.678
Reputación: 0
coso Va por buen camino
TAdoQuery.loadfromfile, pero solo carga XML. Tuve algo parecido...te lo muestro, y tu lo adaptas a tus necesidades...

Código Delphi [-]
procedure T_lectura.Interpretar_Families;
var
        buffer  : string;
        buf_tmp : PChar;
        codi_fam : integer;
        codi_gam,
        desc_fam : string;
        error_fam : boolean;
        k : cardinal;
        i : cardinal;
        tim : T_Timer;
begin
       _errors.Memo1.Clear;
       _errors.Memo1.Lines.Add('Inici d´interpretació de families.');
       _errors.Memo1.Lines.Add('_________________________________');

       error_fam := false;
// MemoFitxer.LoadFromFile(nombre_archivo);
       k := MemoFitxer.Lines.Count-1; // Nova linia amb EOF


       tim := T_Timer.Create(self);
       tim.Inicia(k,'Interpretació de families.');
       _lfam.Desactivar;

       // Obrim i borrem tota tFAM.

       dm.qFAM.Active := false;
       dm.qFAM.SQL.Text := 'delete from FAMILIES where id < 10000';
       dm.qFAM.ExecSQL;
       dm.qFAM.SQL.Text := 'select * from FAMILIES order by id asc';
       dm.qFAM.Active := true;;

       // Preparem variables.

       getmem(buf_tmp,115);

       i := 0;
       buf_tmp^ := chr(0);

       // Inici lectura del richedit

       codi_fam := -1;

       while (i < k) do
       begin
                Application.ProcessMessages;
                if tim.Abortat then break;

                buffer := MemoFitxer.Lines[0];

                Label4.Caption := inttostr(i);
                Update;
                MemoFitxer.Lines.Delete(0);

                // Carreguem les variables.

                strLcopy(buf_tmp,PChar(buffer),4);
                try
                codi_fam := strtoint(buf_tmp);
                except
                error_fam := true;
                _errors.Memo1.Lines.Add('línia ' + inttostr(i) + ': ' + 'No s''ha pogut interpretar ' + buf_tmp);
                continue;
                end;

                strLcopy(buf_tmp,PChar(buffer) + 4,35);
                desc_fam := buf_tmp;

                strLcopy(buf_tmp,PChar(buffer) + 39,2);
                codi_gam := buf_tmp;

                inc(i);
                tim.Seguent; // Augmentem curr_elem del timer.

                // insertem el nou registre.

                try
                dm.qFAM.Append;
                dm.qFAM.Fieldvalues['id'] := codi_fam;
                dm.qFAM.Fieldvalues['DESCR'] := _trim(desc_fam);
                dm.qFAM.Fieldvalues['id_linia'] := codi_gam;
                dm.qFAM.Post;
                except
                error_fam := true;
                _errors.Memo1.Lines.Add('línia ' + inttostr(i) +': ' +  'Error insertant ' + desc_fam + ' amb codi ' + inttostr(codi_fam));
                end;
       end;

       // Finalitzem finestra del timer.

       tim.Finalitza;

       // En el cas de cancelació.

       if tim.abortat then
       begin
         MessageDLG('Interpretació abortada',mtError,[mbOk],0);
         _errors.Memo1.Lines.Add('Interpretació abortada');
       end;
       tim.Destroy;

       // Tractament dels errors.

       if error_fam then
       begin
        MessageDLG('Hi han hagut errors d''interpretació.',mtInformation,[mbOk],0);
        _errors.Show;
       end;

       WindowState := wsNormal;

       _lfam.Activar;

       freemem(buf_tmp);
       Activada := false;
       close;
end;


aunque ponga memofitxer, es un richedit. Es curioso, pero me funcionaba mucho mas rapido que con un memo o un tstringlist.

Última edición por coso fecha: 01-08-2008 a las 19:42:19.
Responder Con Cita