Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Conexión con bases de datos (https://www.clubdelphi.com/foros/forumdisplay.php?f=2)
-   -   Guardar un DBGrid como archivo *.dbf (https://www.clubdelphi.com/foros/showthread.php?t=57504)

richisaurio 18-06-2008 00:33:53

Guardar un DBGrid como archivo *.dbf
 
Hola, envio un enorme saludo a todos los participantes del foro.
El motivo del hilo es el siguiente, estoy haciendo un conversor de archivos de xls a dbf, ya conseguí recuperar el archivo xls ( de Excel ) a un DBGrid, pero el problema que tengo es como voy a guardarlo como un archivo con extension .dbf, mi objetivo final es que este archivo pueda ser abierto por una aplicación de Fox. Y por tanto es necesario que la estructura del archivo sea la adecuada.
Espero puedan ayudarme GRACIAS XD

Neftali [Germán.Estévez] 18-06-2008 08:51:09

No se si has utilizado ADO para abrir el fichero de Excel en el DBGrid (si no lo has hecho míratelo o busca en la ayuda, porque es una buena forma de hacerlo). De la misma forma puedes utilizar también ADO pra grabar o conectar a tablas DBF.
Así que lo más sencillo sería tener dos conexiones ADO, una con la cadena de conexión a Excel, similar a esta:
Código:

Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\MyExcel.xls;Extended Properties="Excel 8.0;HDR=Yes;IMEX=1";
Y la otra conexión apuntando a la tabla DBF, similar a esta:
Código:

Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\folder;Extended Properties=dBASE IV;User ID=Admin;Password=;
A partir de ahí se trata de hacer un bucle que lea de una y grabe en otra.

richisaurio 18-06-2008 09:53:57

Una pregunta mas
 
Muchas gracias por responder, una pregunta mas .............
Cómo podría crear una nueva tabla .dbf utilizando la conexion ADO ????
Y como podría migrar los datos de xls a la tabla recien creada ??? GRX.

Neftali [Germán.Estévez] 18-06-2008 11:11:03

Puedes crear la tabla utilizando una SQL. Si configuras la conexión tal y como te he comentado antes, una SQL como esta te creará la tabla en el directorio configurado en la conexión:

Código Delphi [-]
var
  SQl:string;
begin
  // Crear la tabla
  SQL := 'CREATE TABLE MYTABLE (NAME CHAR(30),Passwd CHAR(10),TEL integer,JOB CHAR(100))';
  ADOQ.SQL.Clear;
  ADOQ.SQL.Add(SQL);
  ADOQ.ExecSQL;

richisaurio 18-06-2008 11:31:12

Datos que voy a obtener de Excel
 
Otra pregunta mas porfavor
Mmmm me imagine que era mas complicado :confused:. Estuve toda la madrugad con eso.
Necesito hacer una consulta a los datos que tengo de excel y que ya estan cargados en un ADODataSet, la consulta la hacía de la siguiente manera:
Código:

    cadena:='select * from c:\base\ACTUA.xls';        // Esta linea esta bien ????
            ADOQuery1.Active:=False;
            ADOQuery1.SQL.Text :=cadena;
            ADOQuery1.Active := True;

y me da un eOLeException"Error en el objeto Parameter,el objeto esta mal definido, se proporciono informacion icompleta o hay una incoherencia".
Luego de hacer esa consulta, pensaba ya insertarlo en el archivo dbf. pero no funciona

poliburro 18-06-2008 14:24:49

Cita:

Empezado por richisaurio (Mensaje 294247)
Otra pregunta mas porfavor
Mmmm me imagine que era mas complicado . Estuve toda la madrugad con eso.

Pues no, con ADO la vida es más sencilla :P.

La consulta es de la siguiente manera:

Código SQL [-]
 
Select * From [Hoja1$]

Donde [Hoja1$] es el identificador de la hoja dentro del libro cuyos datos deseas consultar.

Recuerda que el libro lo configuraste en la conexión, por lo tanto la consulta es sobre las hojas.

Saludos.

cloayza 18-06-2008 17:12:46

Codigo para crear estructuras DBF
 
Aqui tienes un codigo para crear tu mismo las estructuras de tus archivos dbf, mediante un pequeno trozo de codigo que encontre un dia en la web...

Saludos desde
Concepcion-Chile

Código Delphi [-]
unit MakeDBF;

{
                       MakeDBF unit for Delphi
                             Version 1.10
           Copyright 1995-97 Absolute Computer Consulting,
                         All Rights Reserved.

  Description:
  ------------

   This unit is designed to create a .DBF file header.  It will
   create a table with any number of fields.  It is designed to
   create a dBase IV tables.

  Written by:
  -----------

  Mark Klaamas, Absolute Computer Consulting
  13 Apollo Court
  Halifax, Nova Scotia
  Canada

  Usage:
  ------

    var
      DBF : tCreateDBF;
    begin
      DBF := tCreateDBF.Create;

      try
        with DBF do
        begin

          (* Add fields to the database *)
          AddField('test1', 'C', 10, 0);
          AddField('test2', 'C', 20, 0);
          AddField('test3', 'N', 4, 0);
          AddField('test4', 'N', 6, 2);
          AddField('test5', 'D', 8, 0);
          AddField('test6', 'L', 1, 0);

          (* set the table name *)
          FileName := 'test.dbf';

          (* create the table file. *)
          if not WriteTable then
            MessageDlg('Error occured', mtError, [mbOk], 0);

        end;
      finally
        DBF.Free;
      end;

   end;


  Disclaimer and License:
  -----------------------

    This unit and the associated files can be freely used and
    distributed in commercial and private environments, provided this
    notice is not modified in any way without my expressed written
    consent.  The MakeDBF unit is released as is.  No warranty is
    implied and we are not responsible for any problems that might
    arise from the use of this unit.  You use this unit
    entirely at your own risk.

    Bugs (a.k.a. undocumented features)

    If you find any, please let us know, and we will attempt to fix
    them.  Note that bugs often depend on glitches in the system.
    Sometimes it helps to re-boot and try again...

    Feel free to contact us if you have any questions, comments or
    suggestions at klaamasm@tuns.ca

  Revision History:


  09 Feb 1997:   (v1.10) Finally getting around to fully supporting the
                 full range of field types that dBase allows.

  20 July 1995:  (v1.01) Forced field names to uppercase.  This is to be
                 consistant with FoxPro naming for fields.  Forced a date
                 field to have a length of 8.  Only Numeric fields can
                 be assigned decimal places.

                 Fixed WriteTable routine to correctly detect if the file
                 was created correctly or not.

  11 July 1995:  (v1.00) First release.  Memos will not be supported
                 unless there are requests :)

                 Supports following field types: Character, Numeric,
                 Logical, Date.  More will be added on request. }

interface

{ --------------------------------------------------------------------------- }

uses
  SysUtils, Classes;

{ --------------------------------------------------------------------------- }

TYPE

  tCreateDBF = class(tObject)
  private
    fFileName : STRING;
    dbfType   : BYTE;                  { database type                        }
    LangID    : BYTE;                  { Language Driver ID                   }
    Update    : array[0..2] of byte;   { date last updated.                   }
    Rec1Pos   : WORD;                  { position of record 1                 }
    RecLen    : WORD;                  { length of record including delete flg}
    SubRecs   : tList;                 { list of sub records (fields/columns) }
    isMemo    : boolean;               { flag to tell us if there is a memo.  }
    fMemoSize : word;
  public
    constructor Create;
    destructor  Free;
    procedure   AddField(Name : string; fldtype : char; fldsize : byte; dec : byte);
    procedure   UpdateTable;
    function    WriteTable : boolean;
    procedure   ClearAll;

    property    FileName   : string read fFileName write fFileName;
    property    LanguageID : byte   read LangID    write LangID;
    property    MemoSize   : word   read fMemoSize write fMemoSize;
  end;

  {
    Define a sub-record (aka database field/column) class.  Make it a
    class instead of a record so we can add it to a tList without
    doing pointer magic.  It will also make it easier to dispose of
    memory since a tObject "knows" how to dispose of itself.
  }

  tDBFSubRec = class(tObject)
  public
    Name      : array[0..10] of char;  { Field name                           }
    FldType   : char;                  { Field type                           }
    FldDisp   : longint;               { Field displacement in record.        }
    FldLen    : byte;                  { Size of field.                       }
    FldDec    : byte;                  { Number of decimal places.            }
    resv      : array[0..13] of char;  { reserved.                            }
  END;

{ --------------------------------------------------------------------------- }

implementation

{ --------------------------------------------------------------------------- }

const
  ValidTypes = 'BCDFGLMN';             { Character, Numeric, Logical, Date    }

{ --------------------------------------------------------------------------- }

constructor tCreateDBF.Create;
const
  D : pChar = #95#12#28;               { fake an update date.                 }
begin
  fFileName := '';
  dbfType   := 3;                      { FoxPro / dBase 4 table, no memos.    }
  LangID    := $19;                    { magic number ? :)                    }
  StrCopy(pChar(@update), D);          { set false update date ;)             }
  SubRecs   := tList.Create;           { create a new instance of a tList.    }

  isMemo    := FALSE;
  fMemoSize := 1024;

end; { constructor tCreateDBF.Create }

{ --------------------------------------------------------------------------- }

destructor tCreateDBF.Free;
begin

  SubRecs.Free;                        { Delete the SubRecs and Free Memory.  }

end; { destructor tCreateDBF.Free }

{ --------------------------------------------------------------------------- }

procedure tCreateDBF.AddField(Name : string; fldtype : char; fldsize : byte; dec : byte);
var
  TmpSubRec : tDBFSubRec;
begin

                                       { validate the field type.             }
  fldtype := UpCase(fldtype);

  if pos(fldtype, ValidTypes) = 0 then
    raise Exception.Create('MAKEDBF:  Invalid field type!');

  TmpSubRec := tDBFSubRec.Create;      { create a new field instance.         }

  Name := UpperCase(Name);             { convert field name to UPPERCASE      }
  Move(Name[1], TmpSubRec.Name, Length(Name));
  TmpSubRec.FldType := fldtype;

  with TmpSubRec do
  begin
    FldDisp := 0;                      { ******  updated later.               }
    FldLen  := fldSize;
    FldDec  := 0;

    case fldType of
      'D':           FldLen := 8;
      'M', 'G', 'B': begin
                       FldLen := 10;
                       isMemo := TRUE;
                     end;
      'F', 'N'     : FldDec := Dec;
    end;

    fillchar(resv, sizeof(resv), #0);
  end;

  SubRecs.Add(TmpSubRec);              { add new field to the list.           }

end; { procedure tCreateDBF.AddField }

{ --------------------------------------------------------------------------- }

procedure tCreateDBF.UpdateTable;
var
  x       : integer;
  NumFld  : word;
  RecSize : word;
  TmpFld  : tDBFSubRec;
begin

  { Update the table type }
  if isMemo then
    dbfType := $8B
  else
    dbfType := $03;

  RecSize := 0;                        { account for the delete flag in size  }
  NumFld := SubRecs.Count;

  Rec1Pos := 32 + (32*NumFld) + 1;     { record 1 start position              }

  for x := 0 to (NumFld - 1) do
  begin

    TmpFld := SubRecs.Items[x];

    with TmpFld do
    begin
      FldDisp := RecSize + 1;          { update field displacement in record. }
      RecSize := RecSize + FldLen;
    end;

  end; { for }

  RecSize := RecSize + 1;              { account for the delete flag.         }
  RecLen  := RecSize;                  { set the record length.               }

end; { procedure tCreateDBF.UpdateTable }

{ --------------------------------------------------------------------------- }

function tCreateDBF.WriteTable : boolean;
var
  OutFile  : file;
  x        : word;
  TmpFld   : tDBFSubRec;
  HeadEnd  : char;
  buf      : array[0..31] of char;
  memoBuf  : pChar;
  TmpStr   : string;
begin
  UpdateTable;
  WriteTable := TRUE;
  AssignFile(OutFile, fFileName);

  {$I-}
  if IOResult <> 0 then ;              { clear IOResult                       }
  {

    We need to clear the IOresult because if there was an IOResult that was
    set before we called this method it would cause this method to fail even
    if it worked!

    A little know fact that I didn't know about: according to the manual

    "If an I/O error occurs and I/O-checking is off ( (*$I-*) ), all subsequent
    I/O operations are ignored until a call is made to IOResult. Calling
    IOResult clears the internal error flag."

    However, from testing, if a previous procedure sets IOResult, this procedure
    will run, and work, but still report the IOResult from the previous
    procedure.

  }
  ReWrite(OutFile, 1);

  FillChar(Buf, sizeof(Buf), #0);
  { Setup the memory buffer to resemble the 32 byte dbf header. }
  Move(dbfType, Buf[0], sizeof(dbfType));
  Move(Update, Buf[1], sizeof(Update));
  Move(Rec1Pos, Buf[8], sizeof(Rec1Pos));
  Move(RecLen, Buf[10], sizeof(RecLen));
  Move(LangID, Buf[29], sizeof(LangID));
  BlockWrite(OutFile, Buf, sizeof(Buf));

  for x := 0 to (SubRecs.Count - 1) do
  begin
    TmpFld := SubRecs.Items[x];
    BlockWrite(OutFile, TmpFld.Name,    sizeof(TmpFld.Name));
    BlockWrite(OutFile, TmpFld.FldType, sizeof(TmpFld.FldType));
    BlockWrite(OutFile, TmpFld.FldDisp, sizeof(TmpFld.FldDisp));
    BlockWrite(OutFile, TmpFld.FldLen,  sizeof(TmpFld.FldLen));
    BlockWrite(OutFile, TmpFld.FldDec,  sizeof(TmpFld.FldDec));
    BlockWrite(OutFile, TmpFld.resv,    sizeof(TmpFld.resv));
  end; { for }

  HeadEnd := #13;
  BlockWrite(OutFile, HeadEnd, 1);
  CloseFile(OutFile);

  if isMemo then begin
    { Write out the header for the memo file. }
    AssignFile(OutFile, ChangeFileExt(fFileName, '.DBT'));
    ReWrite(OutFile, 1);

    GetMem(memoBuf, fMemoSize);
    FillChar(memoBuf^, fMemoSize, #0);

    memoBuf[0]   := #01;               { Next free block in memo file.        }
    memoBuf[$12] := #02;               { MAGIC?                               }
    memoBuf[$13] := #01;               { MAGIC?                               }
    memoBuf[$14] := chr(lo(fMemoSize));{ LOW  byte of BLOCK SIZE               }
    memoBuf[$15] := chr(hi(fMemoSize));{ HIGH byte of BLOCK SIZE              }

    { We need the table name. }
    TmpStr := ExtractFileName(fFileName);
    TmpStr := Copy(TmpStr, 1, Length(TmpStr) - 4);
    Move(TmpStr[1], memoBuf[$08], length(TmpStr));

    BlockWrite(OutFile, memoBuf^, fMemoSize);

    FreeMem(memoBuf, fMemoSize);
    CloseFile(OutFile);

  end;

  if IOResult <> 0 then WriteTable := FALSE;
  {I+}
end; { function tCreateDBF.WriteTable : boolean }

{ --------------------------------------------------------------------------- }

procedure tCreateDBF.ClearAll;
begin

  SubRecs.Free;                        { Delete the SubRecs and Free Memory.  }
  SubRecs := tList.Create;

end; { procedure tCreateDBF.ClearAll }

{ --------------------------------------------------------------------------- }

end.

poliburro 18-06-2008 20:16:29

:eek: vaya ese si es un buen aporte.

thelibmx 06-03-2010 00:29:06

Crear Tablas .dbf
 
:confused:

Se que ya tiene tiempo este hilo pero podrian explicar un poco el funcionamiento del codigo, es decir se pega en un .pas y se agrega al proyecto o se pone dentro del codigo de nuestra aplicacion y se manda llamar con las funciones ahi expuestas o como es que esa unit se agrega al delphi, tengo mas o menos una idea pero igual y ayudaria a otros a poder utilizar el codigo y ami por supuesto :D

juanlaplata 06-03-2010 13:00:03

al ver la estructura, diria yo que es un .pas , lo que tendrias q hacer es copiar el codigo en por ejemplo notepad, guardar como .pas y luego añadirla a tu proyecto desde delphi. recien ahi puedes usarla desde cualquier form con solo agregar "MakeDBF " al uses .

Cañones 06-03-2010 13:23:56

Con el mismo Office podes guardar tu xls en formato dbf.

Saludos.

thelibmx 08-03-2010 21:49:54

Cita:

Empezado por juanlaplata (Mensaje 355823)
al ver la estructura, diria yo que es un .pas , lo que tendrias q hacer es copiar el codigo en por ejemplo notepad, guardar como .pas y luego añadirla a tu proyecto desde delphi. recien ahi puedes usarla desde cualquier form con solo agregar "MakeDBF " al uses .

Excelente corre de lujo, funciona bien como comentaste, mas o menos tenia la idea jeje en fin ya quedo mas claro gracias juanplata, y tambien a cloayza por encontrar este excelente codigo +10 jaja ( ah no aqui no funciona asi)...:D

vroa74 25-01-2013 16:18:30

De casualidad alguien tiene, algun ejemplo de como se una MAkeDBF ????

cloayza 25-01-2013 17:53:32

Te recopio parte de la unidad de mi post anterior, aquí esta la forma de uso.

Código Delphi [-]
Usage:
  ------

    var
      DBF : tCreateDBF;
    begin
      DBF := tCreateDBF.Create;

      try
        with DBF do
        begin

          (* Add fields to the database *)
          AddField('test1', 'C', 10, 0);
          AddField('test2', 'C', 20, 0);
          AddField('test3', 'N', 4, 0);
          AddField('test4', 'N', 6, 2);
          AddField('test5', 'D', 8, 0);
          AddField('test6', 'L', 1, 0);

          (* set the table name *)
          FileName := 'test.dbf';

          (* create the table file. *)
          if not WriteTable then
            MessageDlg('Error occured', mtError, [mbOk], 0);

        end;
      finally
        DBF.Free;
      end;

   end;

Saludos cordiales


La franja horaria es GMT +2. Ahora son las 08:59:23.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi