Table - criando e alterando estrutura

Top  Previous  Next

{

  Unit com funcoes e rotinas para CRIAR/ALTERAR estruturas de arquivos DBase

  para funcionar é necessário um componentes DQuery (TQuery com alguns recursos adicionais)

  e também as funções de ARotinas e ARotinas2

  Autor Irresponsável: Flávio Junior

 

  1º Release : 30 de maio de 2001

  Qualquer bug envie um email para vai@para.boston.com.br

 

        >\\\!/<

        !_"""_!

        (O) (o)

------ooo-----ooo------------------------------------------------------------------------}

 

unit DBRotinas;

 

interface

 

// fazem parte da AlterStru:

procedure InsereCampo(const Nome: string; const Tipo: char; const Tamanho, Decimais: Byte);

procedure LimpaCampos;

function AlterStru(const Alias, Tabela: string; LimpaMatriz: Boolean = True): Byte;

// outras rotinas para tabelas

function GetAliasPath(const Alias: string): string;

 

implementation

 

uses SysUtils, Classes, DBTables, ARotinasUnit, ARotinas2Unit, DQuery, AlterandoEstruturaUnit;

 

// Para pegar a estrutura de um DBF sem usar nenhuma unit, ou componente:

type

  TDBFColuna = record

    Nome    : string;

    Tipo    : char;

    Tamanho : Byte;

    Decimais: Byte;

  end;

 

  TDBFEstrutura = record

    Colunas         : array[1..200of TDBFColuna;

    NumeroCampos    : Byte;

    RecordCount     : Integer;

    TamanhoRegistros: Integer;

    Data            : TDateTime;

  end;

 

var

  DBFEstrutura: TDBFEstrutura; // este é o da tabela.

  UserCampos  : TDBFEstrutura; // este é o usuario que insere.

 

// Captura a estrutura de um DBF

function GetStru(const ArquivoDBF: string): Boolean;

var

  Header, J: Integer;

  Banco    : file of Char;

  // vars temp

  I : Longint;

  St: string;

  F : string[1];

  // funcoes internas

  // le do arquivo um ou mais NUMEROS

  function LeInt(const N: Integer): Longint;

  var

    C: Char;

    I: Integer;

    L: Int64;

  begin

    Result := 0;

    L      := 1;

    for I:= 1 to N do

    begin

      Read(Banco,C);

      Result:= Result + L * Ord(C);

      L:= L * 256;

    end;

  end;

  // le do arquivo um ou mais CHAR

  function LeChar(const N: Integer): string;

  var

    C: Char;

    I: Integer;

  begin

    Result:='';

    for I:= 1 to N do

    begin

      Read(Banco, C);

      Result:= Result + C;

    end;

  end;

begin

  Result := False;

  {$I-}

  AssignFile(Banco, ArquivoDBF);

  Reset(Banco);

  {$I+}

  if IOResult <> 0 then Exit;

  // o primeiro caracter do cabecalho é ignorado.

  F := LeChar(1);

  // pega data que foi criado a estrutura

  I := LeInt(1) - 100;  St := IntToStr(I);

  I := LeInt(1);        St := IntToStr(I) + '/' + St;

  I := LeInt(1);        St := IntToStr(I) + '/' + St;

  DBFEstrutura.Data := StrToDate(St);

  // Pega qtd registro, tamanho dos registros e numero de campos

  DBFEstrutura.RecordCount := LeInt(4);

  Header:= LeInt(2);

  DBFEstrutura.TamanhoRegistros := LeInt(2);

  St := LeChar(20);

  DBFEstrutura.NumeroCampos := Round((Header - 2) / 32) - 1;

  // pega dados dos campos

  with DBFEstrutura do

    for J:= 1 to DBFEstrutura.NumeroCampos do

    begin

      St := LeChar(11);

      if Pos(#0,St) > 0 then St := Copy(St, 1, Pos(#0,St)-1); // limpa sujeira

      Colunas[J].Nome := UpperCase(St);

      Read(Banco, DBFEstrutura.Colunas[J].Tipo );

      DBFEstrutura.Colunas[J].Tipo := Upcase(DBFEstrutura.Colunas[J].Tipo);

      St := LeChar(4);

      Colunas[J].Tamanho  := LeInt(1);

      Colunas[J].Decimais := LeInt(1);

      St := LeChar(14);

    end;

  CloseFile(Banco);

  Result := True;

end;

 

// Insere os campos na matriz da AlterStru

procedure InsereCampo(const Nome: string; const Tipo: char; const Tamanho, Decimais: Byte);

begin

  with UserCampos do

  begin

    Inc(NumeroCampos);

    Colunas[NumeroCampos].Nome    := UpperCase(Nome);

    Colunas[NumeroCampos].Tipo    := Upcase(Tipo);

    Colunas[NumeroCampos].Tamanho := Tamanho;

    Colunas[NumeroCampos].Decimais:= Decimais;

    // para o AlterStru comparar corretamente, se for do tipo DATE tem que ser tamanho 8!

    if Upcase(Tipo) = 'D' then

    begin

      Colunas[NumeroCampos].Tamanho := 8;

      Colunas[NumeroCampos].Decimais:= 0;

    end;

    if Upcase(Tipo) = 'C' then Colunas[NumeroCampos].Decimais:= 0;

  end;

end;

 

// zera a matriz de campos

procedure LimpaCampos;

begin

  UserCampos.NumeroCampos := 0;

end;

 

// Só para DBF:

// exemplo: AlterStru('Frente', 'Produtos') <--- não precisa da extensão da tabela (ele sempre põe DBF).

// retornos: ( 0 = ok, 1-2 = algo foi feito, >3 = erro!

//  0 = Nada feito, mas tudo ok.

//  1 = Tabela alterada;

//  2 = Tabela criada

//  3 = Erro no GetStru

//  4 = Erro ao criar tabela

//  5 = Erro na matriz usuário

//  6 = Não é possivel mudar tipos de campos

//  7 = Tamanho de campo invalido

function AlterStru(const Alias, Tabela: string; LimpaMatriz: Boolean = True): Byte;

var

  Arquivo, Pasta, Mensagem: string;

  S        : string;

  I, J     : Integer;               // usado em For's

  SaoIguais: Boolean;               // Define se as tabelas são iguais

  BMove    : TBatchMove;            // BatchMove usado para a conversao

  OTable, DTable: TTable;           // tables usadas para conversào O = Origem, D = Destino

 

  function CriaTabela: Byte; // foi colocado numa funcao por que era nessario chamar esta rotinas 2x

  var

    Query: TDQuery; // Usado para criar tabela

    I    : Integer;

  begin

    // monta o SQL:

    S := 'create table "' + ChangeFileExt(Tabela, '.dbf') + '" (';

    with UserCampos do

      for I := 1 to NumeroCampos do

      begin

        S := S + Colunas[I].Nome;

        case Colunas[I].Tipo of

          'C': S := S + ' char(' + IntToStr(Colunas[I].Tamanho) + '),';

          'N': S := S + ' decimal('+ IntToStr(Colunas[I].Tamanho) + ',' + IntToStr(Colunas[I].Decimais) + '),';

          'D': S := S + ' date,';

        end;

      end;

    Delete(S,Length(S),1);

    S := S + ')';

    // cria tabela via DQuery:

    Query := TDQuery.Create(nil);

    Query.DatabaseName := Alias;

    if Query.Execute(S) then Result := 2 else Result := 4;

    Query.Free;

  end;

begin

  Result := 0;

  if Pos('\',Alias) > 0 then Pasta := DirBarra(Alias) else Pasta := GetAliasPath( Alias );

  Arquivo  := ChangeFileExt(Tabela, '.dbf');

  Mensagem := 'Tabela: "' + Tabela + '"; Campo: "';

 

  S := '';

  // Verifica se todos os campos estão ok...

  for I := 1 to UserCampos.NumeroCampos do

  begin

    // tamanho não deve passar de 10 caracteres

    if Length(UserCampos.Colunas[I].Nome) > 10 then S := 'Nome do campo ultrapassa 10 caracteres';

    // se for CHAR deve tem tamanho minimo de 1

    if (UserCampos.Colunas[I].Tipo = 'C'and

       ((UserCampos.Colunas[I].Tamanho > 200or (UserCampos.Colunas[I].Tamanho < 1)) then S := 'Tamanho inválido';

    // se for DECIMAL deve tem tamanho minimo de 2

    if (UserCampos.Colunas[I].Tipo = 'N') then

    begin

      if (UserCampos.Colunas[I].Tamanho < 1) then S := 'Tamanho numérico inválido';

      if (UserCampos.Colunas[I].Decimais > 0) then

        if (UserCampos.Colunas[I].Tamanho - UserCampos.Colunas[I].Decimais) < 2 then S := 'Tamanho numérico inválido (decimais)';

    end;

    if S <> '' then

    begin

      msgErro(Mensagem + UserCampos.Colunas[I].Nome + '"'#13 + S);

      Result := 5;

      if LimpaMatriz then UserCampos.NumeroCampos := 0;

      Exit;

    end;

  end;

 

  // etapa 1 - se arquivo não existe, cria um novo baseado na extrutura

  if not FileExists( Pasta + Arquivo ) then

  begin

    Result := CriaTabela;

    if LimpaMatriz then UserCampos.NumeroCampos := 0;

    Exit;

  end;

 

  // etapa 2 - pega estrutura do arquivo para comparar com a matriz

  if not GetStru( Pasta + Arquivo ) then

  begin

    Result := 3;

    if LimpaMatriz then UserCampos.NumeroCampos := 0;

    Exit;

  end;

 

  // etapa 3 - compara o arquivo pré-existente com a matriz se igual cai fora

  SaoIguais := True;

  // se o numero de campos for igual, deve verificar se existe alguma diferenca

  // em ordem (uma mais pra cima ou pra baixo), ou tamanho do campo (maior ou menor)

  if UserCampos.NumeroCampos = DBFEstrutura.NumeroCampos then

    for I:= 1 to UserCampos.NumeroCampos do

    begin

      // caso 1 dos campos tenha nome, tamanho ou decimais diferentes da tabela original

      // vai ter que mudar a extrutura...

      if (UserCampos.Colunas[I].Nome     <> DBFEstrutura.Colunas[I].Nome    ) or

         (UserCampos.Colunas[I].Tamanho  <> DBFEstrutura.Colunas[I].Tamanho ) or

         (UserCampos.Colunas[I].Decimais <> DBFEstrutura.Colunas[I].Decimais) then

           SaoIguais := False; // Não faz um break aqui por causa o if abaixo que verifica se um outro campo alterou o tipo

 

      if (UserCampos.Colunas[I].Tipo <> DBFEstrutura.Colunas[I].Tipo) and (SaoIguais) then

      begin

        msgErro(Mensagem + UserCampos.Colunas[I].Nome + '"'#13 + 'Não é possivel alterar o tipo de campo');

        Result := 6;

        Break;

      end;

    end;

 

  if Result = 6 then

  begin

    if LimpaMatriz then UserCampos.NumeroCampos := 0;

    Exit// tabelas iguais mas o tipo foi alterado (C => D, D => N)

  end;

 

  // etapa 4 - se o numero de campos for diferente, OU, tabelas não possuem os mesmo campos... mudar estrutura!

  if (UserCampos.NumeroCampos <> DBFEstrutura.NumeroCampos) or (not SaoIguais) then

  begin

    // faz backups

    GerenciaBackup( Pasta, Arquivo );

    // cria tabela

    I := CriaTabela;

    if (I = 4or (I = 5) then // 4 = erro ao criar tabela, 5 = Erro na matriz

    begin

      if (I = 4) then msgErro('Erro ao criar tabela ' + Tabela);

      Result := I;

      if LimpaMatriz then UserCampos.NumeroCampos := 0;

      Exit;

    end;

    // cria tabelas para a transferencia de tecnologia

    OTable := TTable.Create(nil);  OTable.DatabaseName := Alias;  OTable.TableType := ttDbase;

    DTable := TTable.Create(nil);  DTable.DatabaseName := Alias;  DTable.TableType := ttDbase;

    OTable.TableName := ChangeFileExt(Tabela, '.000');            OTable.Active    := True;

    DTable.TableName := ChangeFileExt(Tabela, '.dbf');            DTable.Active    := True;

    // batch move

    BMove := TBatchMove.Create(nil);

    BMove.Source      := OTable;

    BMove.Destination := DTable;

    BMove.Mode        := batAppend;

    // carrega o Mappings com os campos que são iguais no origem e destino

    for I := 1 to DBFEstrutura.NumeroCampos do

      for J := 1 to UserCampos.NumeroCampos do

        if DBFEstrutura.Colunas[I].Nome = UserCampos.Colunas[J].Nome then BMove.Mappings.Add(DBFEstrutura.Colunas[I].Nome);

    // transfere...

    AlterandoEstruturaForm := TAlterandoEstruturaForm.Create(nil);

    with AlterandoEstruturaForm do

    begin

      Show;

      OrigemLabel.Caption  := UpperCase( OTable.TableName );

      DestinoLabel.Caption := UpperCase( DTable.TableName );

      DoEvents;

      BMove.Execute;

      // questao de visual...

      Delay(1000);

      if BMove.MovedCount > 0 Then

        RegistroLabel.Caption := FormatFloat('#,##',BMove.MovedCount) + ' registros.'

      else

        RegistroLabel.Caption := 'tabela vazia';

      Delay(1000);

    end;

    // free all objects

    Result := 1;

    AlterandoEstruturaForm.Free;

    BMove.Free;

    OTable.Free;

    DTable.Free;

  end;

  // zera a estrutura

  if LimpaMatriz then UserCampos.NumeroCampos := 0;

end;

 

//////////////////////////////////////// OUTRAS ROTINAS /////////////////////////////////

 

function GetAliasPath(const Alias: string): string;

var

  Params: TStringList;

begin

  Params := TStringList.Create;

  Session.GetAliasParams( Alias, Params);

  Result := DirBarra(Params.Values['PATH']);

  Params.Free;

end;

 

end.