terça-feira, 15 de março de 2011

Relatório agrupado no QuickReport com IBQuery


vamos aprender a criar relatórios agrupados com o QuickReport, utilizando apenas uma tabela. Este artigo é destinado a iniciantes em relatórios com QuickReport, e para quem utiliza componentes da palheta IBX (Interbase) para o acesso a dados.
Há muito tempo atrás, em alguma galáxia bem distante.....
O tal relacionamento de tabelas diz que para uma base de dados inteligente e eficiente, deve-se ter o mínimo de campos dentro das tabelas, ou seja, apenas os essenciais, para não pesar o sistema, isso é importantíssimo, tanto que todos nós quando criamos um programa de pedidos por exemplo, temos 4 tabelas essenciais contendo no mínimo esses campos:
Tabela Clientes:
  Cod_Cli
  Nm_Cliente
  Endereco

Tabela Produtos:
  Cod_Prod
  Descricao
  Vl_Unit
  Q_Estoque

Tabela Pedidos:
  Cod_Ped
  Cod_Cli
  Data
  Vl_Total

Tabela Itens_Pedido:
  Cod_Ped
  Cod_Cli
  Cod_Prod
  Nm_Produto
  Quant
  Vl_Itens
Veja, que a ligação entre elas são os campos de códigos (ID), a tabela clientes se relaciona com a tabela de pedidos que por sua vez se relaciona com a tabela itens de pedidos, a qual tem um campo que guarda o código do cliente e o código do produto. Isso é relacionamento de tabelas! Pergunta: pra que isso?
Para mostrar que, para se criar um relatório eficiente, é preciso primeiro saber quais campos se tem nas tabelas e quais você vai querer impressos em seus relatórios. Isso chama-se planejamento. Pode poupar grande tempo na hora de criar softwares. Antes de ir para linha de código, planeje o máximo possível. Também podemos criar uma tabela para guardar serviços faturados, clientes pré-cadastrados que executam serviços pagos no decorrer do mês, contendo apenas campos essenciais para consulta como:
COD_PEDIDO / CLIENTE / DATA / SERVICO / QUANT / VALOR
Ou seja, em uma mesma tabela, temos o nome completo do cliente, a data da compra, o tipo do produto, a quantidade e o subtotal do item. Claro que em uma tabela comum, temos até mais campos, como por exemplo um campo booleano que irá controlar se o acúmulo de serviços do cliente já foi pago ou não, e, o nome do cliente muitas vezes não se tem, o que se tem é apenas o código do cliente. Para facilitar esse exemplo, vamos considerar que na mesma tabela tenhamos estes campos. Em outro artigo estarei mostrando como montar um formulário Mestre/Detalhe com o relacionamento de 3 tabelas.
Agrupamento em apenas 1 tabela
Inicie um novo projeto no delphi, deixe o nome do form principal como Form1 mesmo, salve a Unit como Ureport e o projeto como Preport. Adicione um botão e um componente DateTimePicker da palheta Win32. Adicione também os seguintes componentes da palheta Interbase: 1 IBDatabase, 1 IBTransaction e IBQuery. Configure-os de acordo com a sua base de dados.
Obs.: Para mais detalhes sobre criação de base de dados no Interbase ou configuração dos componentes de conexão, veja meu artigo "Como Imprimir Etiquetas com o QuickReport".
Vamos partir para a criação do relatório propriamente dito – ATENÇÃO PARA OS DETALHES.
Vá em File/New/Other e escolha Report.
O delphi irá criar um novo formulário já com um componente QuickReport todo configurado. Configure o relatório com o nome de Qr1 (propriedade Name) e salve a Unit como UrelAG. Pronto, vamos começar a configurar nosso relatório.
Para testarmos o exemplo durante o desenvolvimento, antes de mais nada, adicione uma IBQuery da palheta Interbase no form do relatório (QR1) e configure as seguintes propriedades:
  DataBaseName: IBDatabase1
  SQL: Select * from ItensPedidos
  Active: true;
Lembre-se: se estiver usando algum DataModule, não esqueça de colocar no DatabaseName da Ibquery o endereço completo (exemplo: dm1.IBDataBase1). Caso não esteja aparecendo na propriedade DatabaseName da Ibquery o caminho do DataModule, basta ir à unit do relatório, e após a palavra implemention escreva a seguinte linha:
  Uses UmoduloDados;
Isso irá vincular a sua unit do relatório (UrelAG) ao Datamodule que contém todos os seus componentes de acesso a dados. Veja se o nome da unit do seu datamodule está igual a esse, senão, coloque o nome certo.
Na propriedade SQL da IBQuery, colocamos nada mais que uma simples declaração sql para trazer todos os campos da tabela ItensPedidos para o mesmo, assim, quando colocar algum Qrdbtext no relatório e posicionar o Dataset dele apontando para nossa Ibquery, poderá utilizar a propriedade DataField para indicar qual campo esse Qrdbtext irá representar. Mais à frente isso ficará mais claro.
Importante: No relatório, aponte a propriedade DATASET do RELATÓRIO para a Ibquery do relatório. Não esqueça disso, senão não irá funcionar.
Adicione um componente QrBand da palheta Qreport, altere a propriedade BandType para rbGroupFooter (Atenção, apartir daí o nome da QRBand vai aparecer como GroupFooter, não se espante, estou apenas alertando para que não haja confusão), e adicione um QRLabel.
Adicione um QrGroup e na sua propriedade FooterBand coloque QRBand1, na propriedade Expression coloque IBQUERY1.CLIENTE. Isso fará a ligação dos grupos, o sistema saberá que o campo cliente é que vai fazer o agrupamento, esse é o segredo!
Coloque dentro do QrGroup, um QRDBtext; aponte sua propriedade dataset para a Ibquery e DataField para CLIENTE. Para ficar melhor destacado, altere na propriedade Font do QRDBtext, o tamanho e estilo da fonte (Negrito).
Adicione um QrSubdetail, e dentro dele, 4 qrdbtext, apontando o dataset para a ibquery, e a propriedade dataField de cada uma deles para os campos DATA, SERVICO, QUANT e VALOR, respectivamente. Arrume-os um ao lado do outro como preferir.
Nesse momento, seu relatório já está agrupando todos os itens através dos clientes. Para testar, apenas dê um preview no relatório e verá todos os clientes com seus respectivos itens abaixo. Lembre-se: para funcionar a Ibquery do relatório deve estar com a propriedade Active igual a True. O resultado será algo mais ou menos assim:
CLIENTE 1
  12/04/2006 CAMISA 1  25,00
  13/04/2006 BOLSA  1  12,00
  14/04/2006 CALÇA  3 120,00

CLIENTE 2
  13/04/2006 BOLSA  2  24,00
  14/04/2006 CALÇA  2  80,00
Para testar isso em RunTime (tempo de execução), vc precisará mudar o dataset de TODOS OS COMPONENTES (QrBand, QrGroup, QuickReport, QRDBText´s) que estão aqui para uma query externa, alguma query que esteja em algum form ou em datamodule. Em nosso caso será a Ibquery1 do Form1. Para isso, mude todos os datasets de todos os componentes contidos no Qr1 para Form1.Ibquery1.
Na propriedade Expression do componente QrGroup, não precisa colocar Form1.Ibquery1.CLIENTE. Apenas deixe IBQuery1.CLIENTE. O componente irá procurar no sistema todo, a primeira query que ele encontrar com esse nome e já irá agrupar. Por isso recomendo usar uma Ibquery somente para isso, com um nome específico, tipo IBQueryItensPed. Isso evitará maiores transtornos futuros. No botão que fará a consulta digite o seguinte comando:
var
  C : string;
begin
  C:='Select * from ItensFiados Order By Cliente';
  IBQuery1.SQL.Clear;
  IBQuery1.SQL.Add(C);
  IBQuery1.Open;
  if IBQuery1.EOF = False Then
  Begin
    qr1.preview;
  end;
end;
Note que usei uma variável string típica para guardar a declaração, e depois enviar tudo para a propriedade SQL da Ibquery, que se encontra no form principal, e não na Ibquery que está no Report (Qr1). Pode-se colocar qualquer coisa na variável como uma consulta por dia, mês ou período, é só deixar a imaginação fluir. Exemplo:
  C := 'Select * from ItensFiados where (Data = '+
       #39 + DatetoStr(Dt1.Date) + #39 + ') ' +
       ' Order By Cliente';
Digite uma data no DateTimePicker do form que já contenha registros na tabela e pronto, ele irá buscar através do dia. Claro que o campo data da tabela ItensFiados é do tipo Date, não se esqueça disso!
Bom, aí já temos nosso agrupamento por cliente. Ele irá mostrar todos os clientes que fizeram compras e os respectivos produtos que cada um comprou, ordenado pelo cliente, mas falta alguma coisa:
Um subtotal de cada cliente e um total ao final da folha
Muitos me disseram para usar o componente Qrexpr da palheta Qreport. Lí sobre ele no forum aqui do próprio site mas vou falar que eu tentei, fiz de tudo para ele fazer o cálculo e não funcionou. Apenas consegui fazê-lo funcionar em modo de criação (preview do QuickReport dentro do delphi). Então, um amigo, Danilo Tielles (danilotielles@hotmail.com), me ajudou com uma dica muito legal, e por isso os créditos são todos para ele:
Declare duas variáveis públicas no relatório (Qr1).
  public
    vlsub, vltot: double;
Essas variáveis servirão para guardar os valores encontrados, lembre-se: estamos trabalhando com valores (dinheiro, moeda), então usamos as variáveis do tipo double. Pode-se usar qualquer tipo de variável, não se prenda apenas a esse exemplo.
No relatório, de um duplo clique e irá aparecer a tela de configurações do report. Procure pela opção Sumary e marque seu checkbox. Será adicionado ao relatório uma nova banda chamada Sumary. Adicione um QrLabel a esta banda que ficará com o nome de Qrlabel2. Agora vamos aos comandos:
Iremos programar as propriedades BeforePrint das bandas conforme abaixo, siga atentamente a ordem:
procedure TQR1.PageHeaderBand1BeforePrint(Sender: TQRCustomBand;
  var PrintBand: Boolean);
begin
  vltot:=0;
end;

procedure TQR1.QRGroup1BeforePrint(Sender: TQRCustomBand;
  var PrintBand: Boolean);
begin
  vlsub:= 0;
end;

procedure TQR1.QRSubDetail1BeforePrint(Sender: TQRCustomBand;
  var PrintBand: Boolean);
begin
  vlsub:= vlsub+StrtoFloat(Form1.IBQuery1.fieldbyname('Valor').AsString);
  vltot:= vltot+StrtoFloat(Form1.IBQuery1.fieldbyname('Valor').AsString);
end;

procedure TQR1.QRBand1BeforePrint(Sender: TQRCustomBand;
  var PrintBand: Boolean);
begin
  qrlabel1.Caption:= 'Total do Cliente: '+FormatFloat('R$ #,##0.00', vlsub);
  qrlabel2.Caption:= 'Total: '+FormatFloat('R$ #,##0.00', vltot);
end;
Explicação rápida:
Em primeiro, zeramos a variável VlTotal, porque ela irá mostrar o total no final da folha, e precisamos zerar ela somente uma vez, quando iniciamos o relatório;
Em segundo, zeramos a variável VlSub, pois a cada agrupamento, deve ser zerado o campo VAOR, para começar a somar de novo, senão ele irá acumular os valores de todos os clientes consecutivamente, ou seja, ele irá somar os ítens do primeiro com os do segundo cliente e assim por diante.
Em terceiro, dizemos para as variáveis quais campos ela deverá somar. Nesse caso será o campo VALOR da tabela ItensPedidos, e como o QrSubdetail se repete conforme acha alguma informação na tabela, ele irá somar até o final dos itens de cada cliente.
O quarto e último não precisa de muitos esclarecimentos. Ele irá exibir o valor das variáveis no formato moeda nos QrLabel´s.

sábado, 12 de março de 2011

Extraindo Dia, Mês e Ano de uma base Access (mdb)


Para quem não conhece, a função EXTRACT no firebird, por exemplo, consegue extrair de um campo Date, Time ou TimeStamp um valor único, como Dia, Mês ou Ano de uma data ou até Horas, Minutos e Segundos de uma Hora. No Access, o comando é um pouco diferente.

Veja abaixo um exemplo de como se listar os aniversariantes do Mês:
var
vMES: Integer;
begin
vMES := 11; //Fixo para Teste -> StrToInt(ComboBox1.Text);
with ADOQuery1 do
begin
Close;
sql.Clear;
Sql.Add('SELECT ALUNOS.DataNascAluno, ALUNOS.NomeAluno, ' +
'ALUNOS.EnderecoAluno, ALUNOS.BairroAluno, ' +
'ALUNOS.CidadeAluno, ALUNOS.CEPAluno FROM ALUNOS ');
Sql.Add('WHERE (Month([DataNascAluno]) = :MES) ');
Sql.Add('ORDER BY NomeAluno');
Parameters.ParamByName('MES').Value := vMES;
Open;
end;
end;

Para extrair Dia e Ano, respectivamente, use Day([Nome_Campo]) e Year([Nome_Campo]).

Vale lembrar que o valor retornado corresponde à configuração de data e hora do computador, ou seja, se estiver no formato dd/mm/yyyy (4 dígitos no ano) e a SQL utilizada for ..WHERE ( YEAR([DATA_NASC]) = 85), nenhum registro será encontrado, a menos que troque o 85 por 1985.

Dias úteis em um intervalo de datas


Veja nesta dica uma pequena função para nos retornar quantos dias úteis existem entre duas datas. A função percorre todos os dias do intervalo, para contar quantos dias existem que não sejam sábados ou domingos.

Segue a função:
Function Dias_Uteis(DataI, DataF: TDateTime): Integer;
var Contador: Integer;
begin
if DataI > DataF then
begin
result := 0;
exit;
end;

Contador := 0;
while (DataI <= DataF) do
begin
if ((DayOfWeek(DataI) <> 1) and (DayOfWeek(DataI) <> 7)) then
Inc(Contador);
DataI := DataI + 1
end;
    result := Contador;

quarta-feira, 9 de março de 2011

Obter o MAC das placas de redes


Muitos desenvolvedores tem a necessidade de implementar rotinas de segurança, principalmente visando o controle de acessos por IP´s e outros endereços físicos que garantam maior proteção aos seus softwares.
Uma das alternativas utilizadas é a implementação de funções que obtenham o número físico de periféricos para implementar em rotinas específicas, travas de segurança, como HD´s, Placa Mãe, etc..

A obtenção do MAC das placas de redes pode ser uma boa opção para se criar uma rotina de segurança, tanto a nível de travas, quanto ao número de licenças dos softwares por máquinas ou usuários.

O MAC atribuído as placas de redes, são códigos únicos gravados nas próprias placas, possuindo o código do fabricante e suas variantes, fazendo com que para cada placa de rede, tem-se um MAC diferente.

Abaixo apresento um função que pega o número do MAC, e, que posterior possa ser gravado num banco de dados, registro, etc. Para validar o periférico a cada acesso ao sistema:

function MacAddress: string;
var
  Lib: Cardinal; 
  Func: function(GUID: PGUID): Longint; stdcall;
  GUID1, GUID2: TGUID;
begin
  Result := '';
  Lib := LoadLibrary('rpcrt4.dll');
  if Lib <> 0 then
  begin
    @Func := GetProcAddress(Lib, 'UuidCreateSequential');
    if Assigned(Func) then
begin
      if (Func(@GUID1) = 0) and
     (Func(@GUID2) = 0) and
         (GUID1.D4[2] = GUID2.D4[2]) and
         (GUID1.D4[3] = GUID2.D4[3]) and
         (GUID1.D4[4] = GUID2.D4[4]) and
         (GUID1.D4[5] = GUID2.D4[5]) and
         (GUID1.D4[6] = GUID2.D4[6]) and
         (GUID1.D4[7] = GUID2.D4[7]) then
      begin
        Result := IntToHex(GUID1.D4[2], 2) + '-' +
          IntToHex(GUID1.D4[3], 2) + '-' +
          IntToHex(GUID1.D4[4], 2) + '-' +
          IntToHex(GUID1.D4[5], 2) + '-' +
          IntToHex(GUID1.D4[6], 2) + '-' +
          IntToHex(GUID1.D4[7], 2);
      end;
    end;
  end;
end;

CheckBox em Grids


Conheceremos uma maneira muito fácil e simples para colocar um CheckBox em um StringGrid ou DBGrid.
Para fazer este exemplo vamos precisar de um StringGrid e um ImageList.

Bom antes que muito perguntem o porque do ImageList vou explicar: Podemos utilizar o canvas para desenhar um CheckBox no Grid, porém com o ImageList podemos variar a imagem do CheckBox como quisermos!

É bem simples. Faça o desenho do seu CheckBox como quiser (uma imagem do checkBox checado e a outra não), e coloque as duas no ImageList.

Vamos trabalhar em cima da propriedade OnDrawCell, que é a responsável por desenhar cada célula do grid.

Neste evento temos as variaveis ARow (Linha), Acol (Coluna) e Rect (área de cada célula identificada por ARow e Acol).

Neste exemplo eu coloquei o "index 0" do ImageList com a imagem checada e o "index 1" como não checada.

Veja o código abaixo: se a Coluna(ACol) for igual a 1 ,ou seja, a segunda coluna, e Linha (ARow) maior que "0" (não sendo o titulo), então ele testa se nesta célula tem o texto ' .' (que eu em particular escolhi, para representar o valor verdadeiro). Então ele desenha o CheckBox já "Checado", e caso esteja vazia a celula (''), desenha o checkBox não checado!.

As variáveis Rect.Left e Rect.Top representam o lugar onde o checkbox será desenhado dentro da celula.

procedure TForm1.GridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  R: TRect;
begin
  if (Acol = 1) and (ARow > 0) then
    if Grid.Cells[ACol,ARow] = ' .' then
      ImageList1.Draw(Grid.Canvas, Rect.Left+4, Rect.Top+4, 0)
    else
      if Grid.Cells[ACol,ARow] = '' then
        ImageList1.Draw(Grid.Canvas, Rect.Left+4, Rect.Top+4, 1);
end;

Nota Fiscal Eletrônica (segunda geração)


Olá amigos desenvolvedores! Quem trabalha com NFe já deve ter sofrido ou está sofrendo com a "Segunda Geração" do projeto. A verdade é que as mudanças, apesar de complicar a vida dos programadores, tornaram o projeto mais seguro. Nesse artigo pretendo apontar quais foram estas principais mudanças.
As novas regras visam impedir a emissão de notas fiscais com erro de preenchimento ou em situação não prevista na legislação, apesar de gerar um certo transtorno para nós programadores, na questão de suporte claro.

Mudanças de acordo com o CRT (Código de Regime Tributário):

1 - Simples Nacional
2 - Simples Nacional - excesso de sublimite da receita bruta
3 - Regime Normal

Acredito que a regra que deve ter maior impacto para os usuário é a regra que exige o uso do CSOSN no caso do emissor ser optante pelo Simples Nacional (CRT=1). Os emissores do Simples Nacional (CRT=1) devem informar o CSOSN ao invés do CST:

NOTA EXPLICATIVA:
O Código de Situação da Operação no Simples Nacional - CSOSN será usado na Nota Fiscal Eletrônica exclusivamente quando o Código de Regime Tributário - CRT for igual a "1", e substituirá os códigos da Tabela B - Tributação pelo ICMS do Anexo Código de Situação Tributária - CST do Convênio s/nº de 15 de dezembro de 1970.

Quando o CRT=1, informar o Código de Situação da Operação - Simples Nacional (CSOSN)
101 - Tributada pelo Simples Nacional com permissão de crédito;
102 - Tributada pelo Simples Nacional sem permissão de crédito;
103 - Isenção do ICMS no Simples Nacional para faixa de receita bruta;
201 - Tributada pelo Simples Nacional com permissão de crédito e com cobrança do ICMS por substituição tributária;
202 - Tributada pelo Simples Nacional sem permissão de crédito e com cobrança do ICMS por substituição tributária;
203 - Isenção do ICMS no Simples Nacional para faixa de receita bruta e com cobrança do ICMS por substituição tributária;
300 - Imune;
400 - Não tributada pelo Simples Nacional;
500 - ICMS cobrado anteriormente por substituição tributária (substituído) ou por antecipação;
900 - Outros.

Exemplo de XML para CRT=1 e CSOSN = 101 (equivalente ao CST=00)

 
    0
    101
    1.00
    10.00
 

De forma geral, as novas regras podem ser lidas através da NT 2010/009 - divulga as situações de "uso indevido" do Ambiente de Autorização da NF-e e as novas regras de validação para reduzir o "uso indevido":

Alguns usuários poderão ter as suas NF-e rejeitadas quando a SEFAZ implementar as regras de validação em ambiente de produção e devem verificar se devem corrigir as suas aplicações.

Seguem abaixo algumas alterações críticas:

1. Especifica layout padrão de DANFE a ser seguido por todos os contribuintes.
2. Obrigatoriedade de inclusão do Código de Regime Tributário (CRT).
3. O DANFE (Documento Auxiliar de Nota Fiscal Eletrônica) utilizado para acompanhar a mercadoria em trânsito deve ser impresso em uma única via.
4. O emissor e o destinatário deverão armazenar a NF-e em arquivo digital pelo prazo estabelecido na legislação tributária, mesmo que fora da empresa. O arquivo deve ser apresentado quando solicitado em operações de fiscalização.
5. Após a concessão da Autorização de Uso da NF-e o emissor poderá corrigir erros em campos específicos da NF-e, por meio de Carta de Correção Eletrônica (CC-e), transmitida à administração tributária do Estado do emissor. A previsão é de que a CC-e esteja disponível ainda este ano.
6. Não será permitida a reutilização, em contingência, de número de NF-e transmitida com tipo de emissão "Normal".
7. Alterado o endereçamento dos web services, que agora são outros, para a versão 2.0.
8. Alterações no Código Fiscal de Operações e Prestações com relação às entradas de mercadorias a serem utilizadas nas prestações de serviços sujeitas ao ICMS e ao ISSQN.
9. Os contribuintes deverão também, incluir, quando for o caso, o Código de Situação da Operação no Simples Nacional (CSOSN). Este campo (campo CRT (C21) da tag enderEmit) foi adicionado na versão 2.0.
10. Obrigatoriedade de utilização da NF-e pelo critério do CNAE (Classificação Nacional de Atividades Econômicas)

Leia mais sobre o assunto das regras de validação no manual:
http://www.nfe.fazenda.gov.br/PORTAL/docs/NT2010.010_RegrasValidacao.pdf

segunda-feira, 7 de março de 2011

Data por Extenso


Vamos aprender como escrever uma data por extenso? Criaremos uma function que receberá uma data como parâmetro e retornará uma string, contendo a data já por escrito

  function {[classe].}DtPorExtenso(dt: TDateTime): string;

Para controle dos dias da semana vamos criar um array:

  var
    Semana: array [1..7] of string;

O mesmo para os meses:

    Mes: array [1..12] of string;

Vamos precisar também de variáveis para receber os parâmetros de data que a função nativa DecodeDate irá retornar. Estas variáveis devem ser do tipo Word:

    Dia, Mes, Ano: Word;

Após declarar as variáveis, vamos iniciar o bloco de instruções. Primeiramente, vamos carregar as array's Semana e Mes.

begin
  Semana[1] := 'Domingo';
  Semana[2] := 'Segunda';
  Semana[3] := 'Terça';
  Semana[4] := 'Quarta';
  Semana[5] := 'Quinta';
  Semana[6] := 'Sexta';
  Semana[7] := 'Sábado';
 
  Mes[1] := 'Janeiro';
  Mes[2] := 'Fevereiro';
  Mes[3] := 'Março';
  Mes[4] := 'Abril';
  Mes[5] := 'Maio';
  Mes[6] := 'Junho';
  Mes[7] := 'Julho';
  Mes[8] := 'Agosto';
  Mes[9] := 'Setembro';
  Mes[10] := 'Outubro';
  Mes[11] := 'Novembro';
  Mes[12] := 'Dezembro';

Após carregarmos os array's, vamos obter o dia, mês e ano da data recebida pela função:

  DecodeDate(dt, Ano, Mes, Dia);

Agora podemos formar a string de data por extenso:

  result := Semana[ DayOfWeek(dt) ] + ', ' +
            IntToStr(Dia) + ' de ' +
            Mes[Mes] + ' de ' +
            IntToStr(Ano);

Reparem que utilizei a função DayOfWeek para obter o id do dia da semana, que é utilizado como índice do array Semana.

Backup com MySQL e Delphi


Mesmo que saibamos tudo sobre o MySQL Server 5.0, comandos, sintaxe, recursos entre outras coisas, tudo ficará perdido se um vírus ou outra praga digital invadir o computador e acabar com os nossos dados. Por isso é bom fazer backups da base de dados

O MySQL Server 5.0 tem um recurso chamado mysqldump, que ajuda a fazer backups da base de dados, mas, o problema é que tudo por meio de linhas de comando, o que um usuário final (na maioria dos casos) não saberá fazer.
Para contornar essa barreira, podemos utilizar os arquivos bat, automatizando o processo de backup, ou melhor, do mysqldump! Veja um exemplo:
  cd C:\Arquivos de programas\MySQL\MySQL Server 5.0\bin
  mysqldump nome_da_base_de_dados > caminho_onde_ficara_salvo_o_bakup
  -u Nome_do_usuario_do_mysql -p senha_do_mysql -x -e -a -v 
  exit

Essa é a sintaxe do comando que deve conter o arquivo bat, e pronto!
Para executar o bat de uma aplicação em Delphi, use a seguinte linha de comando:
  WinExec(Pchar('Caminho onde esta salvo o arquivo bat'), SW_SHOWNORMAL);


Segue um link para baixar um pequeno programa que fiz para demonstrar como fazer a conexão com MySQL Server 5.0 e com o exemplo de arquivo bat para o backup: exemplo_backup_mysql.zip

Um lembrete: para compilar o exemplo, copie-o para o seu C:\

quinta-feira, 3 de março de 2011

Progresso de Transferência FTP com idFTP


Andei procurando muito pela web algum exemplo de como medir o progresso da transferência de um arquivo através do componente idFtp, no Delphi 6. Depois de muito procurar e nada encontrar, um pequeno exemplo que não funcionava muito bem me fez pensar um pouco e me levou, após alguns testes, a um medidor de progresso funcional, feito com um gauge.
Para fazer um exemplo, coloque um componente idFTP, um ListBox e um Button no seu formulário. Configure o seu componente de conexão de acordo com os dados do ftp que irá se conectar e declare uma variável global chamada bytesToTransfer

var
  Form1: TForm1;
  bytesToTransfer: integer;
em seguida, faremos a conexão e o download de todos os arquivos .exe que estiverem no ftp. No exemplo, o código foi implementado no evento onClick do botão:

procedure TForm1.Button1Click(Sender: TObject);
var
  indice: integer;
begin
  try
    //efetua a conexão ao FTP
    if IdFTP1.Connected then
      IdFTP1.Disconnect;
    IdFTP1.Connect();

    //lista todos os arquivos do tipo .exe do ftp no ListBox1
    IdFTP1.List(ListBox1.Items,'*.exe',false);

    //se não houverem arquivos, aborta
    if ListBox1.Items.Count = 0 then
      Abort;

    //para cada ítem do ListBox1
    for indice:=0 to ListBox1.Items.Count -1 do
    begin
      try
        //marca o ítem selecionado
        ListBox1.Selected[indice] := true;
        //captura o tamanho do arquivo para a varíavel global
        bytesToTransfer := IdFTP1.Size(ListBox1.Items.Strings[indice]);
        //inicia a transferência do arquivo
        IdFTP1.Get(ListBox1.Items.Strings[indice],
          '' + ListBox1.Items.Strings[indice],true);
      except
        on e:exception do
          showmessage(e.Message);
      end;
    end;

  finally
    //desconecta
    IdFTP1.Disconnect;
  end;
end;
No eventoWorkBegin do idFTP, que é disparado no momento em que o Download do arquivo é iniciado, faça:

procedure TForm1.IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
   const AWorkCountMax: Integer);
begin
  //limpa a barra de progresso
  Gauge1.Progress := 0;
  //define o tamanho máximo para o Gauge
  if AWorkCountMax > 0 then
    Gauge1.MaxValue := AWorkCountMax
  else
    Gauge1.MaxValue := bytesToTransfer;
end;
E finalmente, a cada conjunto de bytes trazidos pelo componente, incrementamos o Gauge. Isso é feito no evento Work do idFTP:

procedure TForm1.IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode;
   const AWorkCount: Integer);
begin
  //incrementa o Gauge
  Gauge1.Progress := AWorkCount;
end;

quarta-feira, 2 de março de 2011

Técnicas de depuração em Delphi e Prevenção de Bug


Muitas vezes pegamos um sistema legado de outro programador para realizarmos implementação de novas funcionalidades ou corrigir eventuais "bugs". Neste caso você vai precisar depurá-lo para encontrar os "bugs". O Delphi oferece ótimas ferramentas de depuração e quando você sabe como usá-las, você vai economizar muito tempo para corrigir o "bug" e chegar no resultado desejado
Neste caso quero indicar um tutorial que encontrei e ajudou quando o assunto era depuração de programas.
Aqui está o conteúdo:

Project options - antes que você possa começar a utilizar as ferramentas depurador do Delphi, você tem que certificar-se de todas as configurações necessárias são definidas opções depurador .

Breakpoints - Quando pressionar a tecla F5 ou clicando na barra esquerda do seu editor você pode adicionar uma linha vermelha para a sua fonte. Esta linha de origem terão um ponto de interrupção. Ao executar o programa, a execução irá parar quando ele passa a linha de origem. Agora você pode seguir em sua origem, usando algumas teclas de função.

Call stack - a janela Call Stack exibe as chamadas de função que o trouxe para a sua localização atual no programa e os argumentos passados para cada chamada de função.

Local variables - essa janela vai mostrar todas as variáveis locais e o seu valor atual no atual função ou procedimento.

Watches - você adicionar um Watches para controlar os valores das variáveis do programa ou expressões como você passar por cima ou em código de rastreamento.

Idéias para criar os seus próprios recursos de depuração Prevenção Bug Try-Finally Gotchas Try-Except Gotchas

Criando um gerador de senhas


Veja nesta dica um código simples mas bastante útil, que gera senhas aleatórias podendo conter somente numeros, somente letras ou letras e números. O autor também aborda um pouco do comando try..except. Confira!
Primeiramente, vamos ao tutorial: insira em um form um Edit, abaixo dele um RadioGroup e depois outro Edit. Nesse RadioGroup, procure pela propriedade Items no Object Inspector e adicione o seguinte:

Somente números Somente letras Letras e números

Após isso, adicione dois Buttons. No primeiro mude a propriedade Caption para "Gerar" e o segundo "Limpar". No OnClick do botao "Gerar" coloque o seguinte código:

procedure TForm1.Button1Click(Sender: TObject);
const
  letras = 'abcdefghijklmnopqrstuvxwyzABCDEFGHIJKLMNOPQRSTUVXWYZ';
  numeros = '1234567890';
  letrasnumeros = letras + numeros;
var
  i: integer;
begin
  try
    Edit2.Clear;
    for i := 1 to StrToInt(Edit1.Text) do
    begin
      if RadioGroup1.ItemIndex = 0 then
        Edit2.Text := Edit2.Text + numeros[random(length(numeros)) + 1]
      else if RadioGroup1.ItemIndex = 1 then
        Edit2.Text := Edit2.Text + letras[random(length(letras)) + 1]
      else if RadioGroup1.ItemIndex = 2 then
        Edit2.Text := Edit2.Text + letrasnumeros[random(length(letrasnumeros)) + 1];
    end;
  except
    showmessage('Insira somente números no primeiro Edit');
  end;
end;
Explicando

Criamos uma variavel i, do tipo inteira, que irá receber a quantidade de caracteres que o usuário quiser para a sua senha. Por isso convertemos o valor do Edit1.Text de String para Inteiro (StrToInt) dentro do for. Criamos também três constantes, adicionando a cada uma respectivamente as letras, números ou as duas juntas.

O comando "Try" funciona da seguinte maneira: falamos para o Delphi tentar executar esse código e, caso ele não conseguir, podemos utilizar o Except para apresentar, por exemplo, algumas mensagens de erro do que pôde acontecer. No exemplo, deve ser informado no Edit1 a quantidade de caracteres da senha e, caso a pessoa coloque letras ao invés de números, a função StrToInt não conseguirá ser executada. Com o Except, conseguimos informar ao usuário este problema e tiramos a mensagem de erro que o delphi emitiria, em inglês.

No segundo botão, coloque apenas:

procedure TForm1.Button2Click(Sender: TObject);
begin
  Edit2.Clear;
end;
Após isso efetue a seguinte alteração no seu Delphi : em Tool>Options, procure por Language Execeptions e desmarque "Notify on Language Execeptions". Isto fará com que o compilador do Delphi não interrompa o programa com as mensagens do depurador e deixe a mensagem ir diretamente ao programa.

Nesse momento, compile e rode sua aplicação, informe um número no primeiro edit, selecione um método de geração e veja a senha gerada no segundo edit. É o nosso código em funcionamento!

Pesquisa fonética no MySQL

Fonte: www.activedelphi.com.br

Olá pessoal! Há algum tempo atrás precisei fazer uma consulta por fonema em meu banco de dados e não achei muita coisa na internet, mas descobri que o MySQL a partir da versão 3 acrescentou uma função chamada soundex, que outros bancos até já utilizam, como o Oracle, por exemplo. Nesta dica mostrarei uma consulta simples, que pode ser implementada em qualquer linguagem de programação, pois é um código SQL.
Primeiramente vamos criar um banco no mysql:

shell>mysql –useuusario –psuasenha
mysql>create database fonema;
Query OK, 1 row affected (0.01 sec)
Agora vamos selecionar para uso o banco que acabamos de criar:

mysql>use fonema;
Database changed
Criando nossa tabela de teste:

mysql>create table fonetica (
cod INTEGER NOT NULL AUTO_INCREMENT,
nome VARCHAR(60) NOT NULL,
PRIMARY KEY (cod)
)
ENGINE = InnoDB;
Query OK, 0 rows affected (0.08 sec)
Vamos inserir alguns dados nesta tabela. No comando abaixo, dois nomes somente:

mysql>insert into fonetica (nome) values (“JAIME ADRIANO”),(“JAYME ADRIANO”);
Query OK, 2 rows affected (0.09 sec)
Records: 2 Duplicates: 0 Warnings: 0
Agora vamos a nossa consulta:

mysql>select * from fonetica where SOUNDEX(nome) like
    ->CONCAT(SOUNDEX(“JAIME ADRIANO”),”%”);
+-----+---------------+
 cod    nome
+-----+---------------+
 6      JAIME ADRIANO
 7      JAYME ADRIANO
+-----+---------------+
2 rows in set (0.00 sec)
Perceba que o banco retornou Jaime com i e com y, que foneticamente são pronunciados da mesma forma. Faça um teste ao contrario, colocando o nome JAYME na consulta, com y, e verá que ele também retornará os dois nomes com a mesma fonética.

Espero ter ajudado e daí por diante é com vocês! Façam as implementações e melhorias e postem aqui para ajudar outras pessoas. Esta dica foi extraida do meu blog, achei interessante postar aqui!

segunda-feira, 28 de fevereiro de 2011

Mudar a letra da unidade usando WMI e Delphi

Fonte: www.activedelphi.com.br

Veja nesta dica uma aplicação console com o código fonte de exemplo para se alterar a letra de unidade de disco (volume) através do WMI. A chave é usar a classe Win32_Volume e alterar a propriedade DriverLetter. Esta propriedade é de leitura e escrita, sendo assim, podemos atualiza-la diretamente e então chamar o método Put_ do objeto SWbemObject.
Para rodar o programa e fazer os testes, solicite no Delphi uma nova "Console Application", apague todo o seu conteúdo e coloque o código abaixo:

program ChangeVolumeLetter_WMI;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils,
  ActiveX,
  ComObj;
 
procedure  ChangeDriveLetter(OldDrive, NewDrive:Char);
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery(
    Format('SELECT * FROM Win32_Volume Where DriveLetter=%s',
           [QuotedStr(OldDrive+':')]),
    'WQL',0);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  if oEnum.Next(1, FWbemObject, iValue) = 0 then
  begin
    //Define a nova letra
    FWbemObject.DriveLetter:=NewDrive+':';
    //Aplica as mudanças
    FWbemObject.Put_();
  end;
end;
 
begin
 try
    CoInitialize(nil);
    try
      //Mudará a letra da unidade E para Z
      ChangeDriveLetter('E','Z');
      Readln;
    finally
      CoUninitialize;
    end;
 except
    on E:Exception do
    begin
        Writeln(E.Classname, ':', E.Message);
        Readln;
    end;
  end;
end.
Aí é só rodar e conferir a letra da unidade modificada, neste exemplo, alterando a unidade E para Z.

Algumas explicações na internet (em inglês):

WMI - Windows Management Instrumentation
Win32_Volume
Método Put_
SWbemObject

sexta-feira, 25 de fevereiro de 2011

Relatório em PDF usando o Delphi 2006


Olá pessoal! Essa dica é pra quem quer exportar seus relatório feitos no QuickReport para arquivos PDF, usando o Delphi 2006 ou superior.
Segue abaixo o código utilizado:
procedure TQRStandardPreview.btnExportarClick(Sender: TObject);
var
  PDFFilt : TQRPDFDocumentFilter;
  FileExt, dir : string;
  I : integer;
begin
  dir := ExtractFilePath( Application.ExeName );
  FileExt := QRPreview.QRPrinter.Title;
  FileExt := FileExt + '.pdf';
  PDFFilt := TQRPDFDocumentFilter.Create( FileExt );
  try
    PDFFilt.AddFontMap( 'WebDings:ZapfDingBats' );
    PDFFilt.TextOnTop := true;
    PDFFilt.LeftMargin := 0;
    PDFFilt.TopMargin := 0;
    PDFFilt.CompressionOn := False;
    PDFFilt.Concatenating := True;
    QRPreview.QRPrinter.ExportToFilter( PDFFilt );
    PDFFilt.EndConcat;
  finally
    PDFFilt.Free;
  end;
end;
Lembrando que devemos acrenscentar na seção uses a unit "QRPDFFilt"

quarta-feira, 23 de fevereiro de 2011

Validando endereços de e-mail


Veja nesta dica uma função que apresenta como validar um endereço de e-mail, evitando que sejam informados dados incorretos nos cadastros.

Segue a implementação:

function ValidaEmail(sEmail: string): boolean;
const
  // Caracteres válidos
  ATOM_CHARS = [#33..#255] - ['(', ')', '<', '>', \@\, ',', ';', ':',
                              '\', '/', '"', '.', '[', ']', #127];

  // Caracteres válidos em uma cadeia
  QUOTED_STRING_CHARS = [#0..#255] - ['"', #13, '\'];

  // Caracteres válidos em um subdominio
  LETTERS = ['A'..'Z', 'a'..'z'];
  LETTERS_DIGITS = ['0'..'9', 'A'..'Z', 'a'..'z'];
  SUBDOMAIN_CHARS = ['-', '0'..'9', 'A'..'Z', 'a'..'z'];

type
  States = (STATE_BEGIN, STATE_ATOM, STATE_QTEXT, STATE_QCHAR,
    STATE_QUOTE, STATE_LOCAL_PERIOD, STATE_EXPECTING_SUBDOMAIN,
    STATE_SUBDOMAIN, STATE_HYPHEN);
var
  State: States;
  i, n, iSubdomains: integer;
  c: char;
begin
  State := STATE_BEGIN;
  n := Length(sEmail);
  i := 1;
  iSubdomains := 1;
  while (i <= n) do
  begin
    c := sEmail[i];
    case State of
      STATE_BEGIN:
        if c in atom_chars then
          State := STATE_ATOM
        else if c = '"' then
          State := STATE_QTEXT
        else
          break;
      STATE_ATOM:
        if c = \@\ then
          State := STATE_EXPECTING_SUBDOMAIN
        else if c = '.' then
          State := STATE_LOCAL_PERIOD
        else if not (c in atom_chars) then
          break;
      STATE_QTEXT:
        if c = '\' then
          State := STATE_QCHAR
        else if c = '"' then
          State := STATE_QUOTE
        else if not (c in quoted_string_chars) then
          break;
      STATE_QCHAR:
        State := STATE_QTEXT;
      STATE_QUOTE:
        if c = \@\ then
          State := STATE_EXPECTING_SUBDOMAIN
        else if c = '.' then
          State := STATE_LOCAL_PERIOD
        else
          break;
      STATE_LOCAL_PERIOD:
        if c in atom_chars then
          State := STATE_ATOM
        else if c = '"' then
          State := STATE_QTEXT
        else
          break;
      STATE_EXPECTING_SUBDOMAIN:
        if c in letters then
          State := STATE_SUBDOMAIN
        else
          break;
      STATE_SUBDOMAIN:
        if c = '.' then
        begin
          Inc(iSubdomains);
          State := STATE_EXPECTING_SUBDOMAIN
        end
        else if c = '-' then
          State := STATE_HYPHEN
        else if not (c in letters_digits) then
          break;
      STATE_HYPHEN:
        if c in letters_digits then
          State := STATE_SUBDOMAIN
        else if c <> '-' then
          break;
    end;
    Inc(i);
  end;

  if i <= n then
    Result := False
  else
    Result := (State = STATE_SUBDOMAIN) and (iSubdomains >= 2);

  //se sEmail esta vazio retorna true
  if sEmail = '' then
    Result := true;
end;

Para testar, adicione a um novo formulário um Edit e um Button, programando no evento onClick deste último:

procedure TForm1.Button1Click(Sender: TObject);
begin
  if ValidaEmail(Edit1.Text) then
    ShowMessage('Ok! E-mail válido!')
  else
    ShowMessage('E-mail inválido!');
end;

Agora rode o programa e faça os testes digitando vários endereços de e-mail do Edit1 e clicando sobre o botão.

terça-feira, 22 de fevereiro de 2011

Automação de Queries

Fonte: www.activedelphi.com.br

Desenvolvendo um sistema para uma clínica escola de psicologia, identifiquei que, apesar de o sistema estar bem avançado, estava cheio de códigos de manipulação de query repetidos, e por isso resolvi mudar esta situação. A solução, você confere abaixo
Os códigos eram todos parecidos, como abaixo:

  with dm.query do
  begin
    close;
    sql.Clear;
    sql.Add('select * from tabela where campo = valor');
    open;
  end;

Então fiz uma procedure que com uma linha faz tudo isso:

class procedure Tdm.qrcon(componente: Tadoquery; tabela, campo, valor: string; 
  operacao: integer);
begin
  case operacao of
    //seleciona tudo
    1: with componente do
      begin
        close;
        sql.Clear;
        sql.Add('select * from ' + tabela);
        open;
      end;
    2: with componente do
      begin
        close;
        sql.Clear;
        sql.Add('select * from ' + tabela + ' where ' + campo + 
                ' = ' + quotedstr(valor));
        open;
      end;
    3: with componente do
       begin
        close;
        sql.Clear;
        sql.Add('delete from ' + tabela + ' where ' + campo + ' = ' + valor);
        execsql;
       end;
  else
    MessageBox(0, 'Erro de parametro de consulta.' + #13#10 + 
                  '          Contate o CPD.', 
                  'Erro de parametro de consulta.', MB_ICONSTOP or MB_OK);
  end;
end;

Converter Minutos Para Horas

Fonte: www.activedelphi.com.br


Veja nesta dica uma simples função que retorna a quantidade de horas a partir de uma quantidade de minutos.

function MinutosEmHoras(Minutos: Integer): String;
var
  HoraDecimal, HH, MM: String;
begin
  if Minutos > 1440  then
    Minutos := Minutos - 1440;
  HoraDecimal := FormatFloat( '00.00', Minutos / 60 );
  HH := Copy( HoraDecimal, 1 , 2 );
  if Copy( HoraDecimal, 4, 5 )[1] = '0' then
    MM := '0' + IntToStr( Round( ( StrToInt( Copy( HoraDecimal, 4, 5 ) ) * 60 ) /100 ) )
  else
    MM := IntToStr( Round( ( StrToInt( Copy( HoraDecimal, 4, 5 ) ) * 60 ) /100 ) );
  Result :=  HH+ ':' + MM ;
end;

Para utilizá-la, faça:

  ShowMessage( MinutosEmHoras(480) );
  //retornará: '08:00'

segunda-feira, 21 de fevereiro de 2011

Abrindo arquivos com os aplicativos associados e tratando exceções

Fonte: www.activedelphi.com.br


Você já deve ter ouvido falar no comando ShellExecute da unit ShellApi, certo? Se não ouviu, conheça-o agora. Para quem já conhece e o utiliza, costuma tratar os possíveis retornos desta função? Não? Então veja nesta dica como fazer o tratamento!


// Esta procedure requer a unit ShellApi declarada na cláusula Uses da unit.
// Declare a procedure na cláusula private da unit e coloque-a após a cláusula
// implementation, assim: procedure Tform1.ExecFile(F: String);
// use-a assim: ExecFile('c:\windows\Ladrilhos.bmp')
procedure ExecFile(F: String);
var
  r: String;
begin
  case ShellExecute(Handle, nil, PChar(F), nil, nil, SW_SHOWNORMAL) of
    ERROR_FILE_NOT_FOUND:   r := 'O arquivo especificado não foi encontrado ' +
                                 'ou não existe!';
    ERROR_PATH_NOT_FOUND:   r := 'O Caminho é inválido ou não existe!';

    ERROR_BAD_FORMAT:       r := 'O Aplicativo está corrompido ou não é um ' +
                                 'Aplicativo Win32 valido!';
    SE_ERR_ACCESSDENIED:    r := 'O sistema negou acesso a este arquivo por ' +
                                 'algum motivo desconhecido!';
    SE_ERR_ASSOCINCOMPLETE: r := 'Este arquivo tem uma associação inválida ' +
                                 'ou incompleta a ele!';
    SE_ERR_DDEBUSY:         r := 'A transação DDE não pode ser efetuada por ' +
                                 'já haver outra Transação DDE em andamento';
    SE_ERR_DDEFAIL:         r := 'Não foi possível efetuar a transação DDE!';

    SE_ERR_DDETIMEOUT:      r := 'A transação DDE não pode ser efetuada ' +
                                 'porque o tempo requerido expirou!';
    SE_ERR_DLLNOTFOUND:     r := 'Uma Biblioteca DLL necessária ao ' +
                                 'aplicativo associado não foi encontrada!';
    SE_ERR_NOASSOC:         r := 'Este arquivo não tem nenhum aplicativo ' +
                                 'associado à ele!';
    SE_ERR_OOM:             r := 'memória insuficiente para prosseguir com' +
                                 'esta operação!';
    SE_ERR_SHARE:           r := 'Ocorreu uma violação de compartilhamento ' +
                                 'ao efetuar esta operação!';
  else
    exit;
  end;
 
  ShowMessage(r);
end;
Este comando também pode ser utilizado para abrir páginas da Web com o navegador padrão, passando no lugar do caminho do arquivo, um endereço de um site iniciado com "http://", ex:


  ExecFile('http://www.activedelphi.com.br')

Convertendo BMP em JPG

Fonte: www.activedelphi.com.br

Esta dica mostra uma função que converte um arquivo BMP em um arquivo JPG, mostrando também como fazer a compacatação do arquivo ajustando o nível de qualidade da imagem. Primeiro, vamos adicionar a unit JPEG ao uses do formulário.
Agora, façamos a seguinte função:

function BmpToJpg(cImage: String): Boolean;
var
  MyJPEG: TJPEGImage;
  MyBMP : TBitmap;
begin
  Result := False;
  if fileExists(cImage + '.bmp') then
  begin
    MyBMP := TBitmap.Create;
    with MyBMP do
      try
        LoadFromFile(cImage + '.bmp');
        MyJPEG := TJPEGImage.Create;
        with MyJPEG do
        begin
          Assign(MyBMP);
          //"Descomente" e ajuste as linhas abaixo para compactar a imagem, o que
          //poderá perder qualidade mas ajudará a diminuir o tamanho do arquivo
          //CompressionQuality := 75; //min. 1 - max. 100
          //Compress;
          SaveToFile(cImage + '.jpeg');
          Free;
          Result := True;
        end;
      finally
        Free;
      end;
  end;
end;
E para testar, supondo que haja um arquivo chamado ImagemTeste.BMP no diretório raiz C:\, basta fazer:

procedure TForm1.Button1Click(Sender: TObject);
begin
  BmpToJpg('C:\ImagemTeste');
end;