terça-feira, 12 de abril de 2011

20 motivos para você adotar o Firebird em sua empresa!

1 DBA não requerido

O Firebird é feito idealmente para desenvolvedores de aplicações que querem um banco de dados realmente encaixado. A pequena footprint e pouca necessidade de manutenção (O DBA não é requerido) do Firebird te dão a tranquilidade de que seus clientes mal notarão que ele está lá.

2 Alta performance tanto em aplicações críticas como em aplicações menores

O Firebird provê uma funcionalidade de alta performance que suporta operações críticas de negócios em áreas como comércio de mercadorias (ações, apólices), farmacêutica, aerospacial e gerenciamento de rede, enquanto se mantém com preço acessível (IB6 ser;a free) e fácil de usar para desenvolvedores de aplicações menores.

3 Versioning

O servidor Firebird é construído em uma arquitetura multi-geracional(MGA). O MGA provê um dispositivo versionig único que assegura alta disponibilidade para usuários que suportam decisões (support-decision). Servidores de banco de dados suportam tradicionalmente o modelo de interação de banco de dados On-Line Transaction Procesing (OLTP), caracterizado por um grande volume de transações simples e curtas. Enquanto o dispositivo versioning do Firebird suporta essas transações curtas, do tipo OLTP, o Firebird supera a competição em aplicações reais porque também gerencia ao mesmo tempo transações de longa duração do tipo support-decision.

4 Arquitetura SuperServer

A arquitetura SuperServer aumenta a performance e otimiza o uso de recursos de sistemas, especialmente por um grande número de usuários. Isto te permite ter mais clientes no seu servidor, e ainda aumentar a velocidade de suas repostas. Este é um servidor multi-threaded compartilhado, que provê a melhor performance já vista.

5 Instalação em minutos

O Firebird é instalado facilmente com um único comando. Ele tem uma pequena footprint, então você não precisa se preocupar em ter bastante espaço livre em disco e não precisará estabelecr centenas de parâmetros de sintonia. O Firebird foi preparado para requerer pouca manutenção, portanto ele otimiza suas transações pra você.

6 Sinalizadores de Eventos

Sinalizadores de eventos tornam possível a existência de um banco de dados ativo, avisando automaticamente as "partes interessadas" quando certas mudanças acontecem. Tudo isso é feito sem polling constante no banco de dados, portanto isto não limita os recursos do sitema.

7 Funções Definidas pelo Usuário (UDFs)

UDFs provêem meios de aumentar as capacidades analíticas do Firebird através da criação de funções habituais de negócios. UDFs são um código reutilizável e asseguram a integridade e confiabilidade dos dados. Da mesma maneira, UDFs podem ser usadas para chmar aplicações externas ao banco de dados

8 BLOBs - Binary Large Objects

O Firebird estabeleceu o padrão industrial com o lançamento de seu primeiro produto em 1986, quando armazenou som, imagem, gráficos e informações binárias diretamente no banco de dados usando os seus tipos de dados BLOB.

9 Arrays Multidimensionais

O Firebird também suporta os arrays multidimensionais usados extensivamente em aplicações financeiras e científicas. Armazenando arrays multidimensionais com até 16 dimensões em um único campo no banco de dados o Firebird simplifica o design da aplicação e aumenta a performance..

10 Banco de dados distribuídos para flexibilidade da aplicação

Quando você precisar mover a sua solução desktop de banco de dados para uma configuração client/server ou aumentar as suas aplicações de grupo de trabalho para servir a um ou mais departamentos, o Firebird é ideal, pois é feito para ambientes de banco de dados distribuídos.

11 Junção de múltiplos bancos de dados

O Firebird é um verdadeiro servidor de bancos de dados distribuídos SQL que permite que cada query do sistema de banco de dados retorne a informação para qualquer outro servidor Firebird

12 Commit em duas fases

O Firebird também gerencia transações com servidores múltiplos de maneira rápida e fácil. Ele inclui o processamento de transações com commit em duas fases, o que assegura que as atualizações sejam feitas sem intervenção da aplicação. Toda vez que uma transação abrange dois ou mais servidores de banco de dados o Firebird primeiro investiga os servidores participantes para assegurar de que eles estejam em atividade e rodando, então envia o comando commit para completar a transação.

13 Recuperação distribuída de Commit em duas fases

O Firebird leva o processo de commit em duas fases um passo além. Ele foi o primeiro produto de banco de dados a prover recuperação distribuída para um commit em duas fases. Isto assegura a recuperação completa sem o risco de um único ponto de falha, pois a coordenação da submissão é distribuída entre todos os servidores, reduzindo assim a necessidade de administração dos dados. No evento em que a transação não possa ser submetida em todos os servidores, a transação inteira é automaticamente tolled back em todos os servidores.

14 ANSI SQL-92

Para soluções em aplicações de missão crítica, o Firebird oferece total compatibilidade com SQL-92.

15 Sistema de travamento otimista

O Firebird utiliza tecnologia de travamento otimista para proporcionar grande taxa de uso de operações de banco de dados para clientes. O Firebird implementa travamentos a nível de linha reais para restringir mudanças somente nos registros do banco de dados que um cliente modifica. Diferente de travamentos a nível de página, que restringe qualquer dado arbitrário que estiver armazenado fisicamente próximo no banco de dados. Travamentos a nível de linha permitem múltiplos clientes atualizarem dados em uma mesma tabela sem conflito, resultando em menor serialização das operações de bancos de dados.

16 Usuários de peso

Vejam quem está utilizando o Firebird: NASA,Motorola, Nokia, MCI, Northen Telecom, Philadelphia Stock Exchange, Bear Stearns, First National Bank of Chicago, Money Store, US Army, NASA, Boeing, IBM (Brasil).

17 Flexibilidade de plataformas Windows, Linux, Unix, Solaris, NetWare...

Você escolhe qual usar,não ficando obrigado a certos sistemas operacionais.

18 Internet Explorer?

Você sabia que para o SQL Server 7 funcionar você precisa do Internet Explorer instalado em sua máquina?.

19 Firebird 6 tem distribuição livre

A versão 6 do Firebird é open-source e free, o que significa que o custo de seu projeto cairá! Consequentemente seus clientes ficarão bem satisfeitos.

20 O Firebird pode crescer com você Com produtos Firebird,

você não tem somente uma melhor performance nas mais populares plataformas UNIX e Windows, mas também uma melhor performance adaptada às necessidades de sua empresa. O Firebird é uma família de produtos que atravessa o espectro de um único usuário e servidores de pequenos grupos até grandes negócios. Com o recém-adicionado InterClient JDBC, você também tem a flexibilidade que precisa. Então, enquanto você cresce o Firebird pode crescer com você.

segunda-feira, 11 de abril de 2011

Alterando a cor de fundo de um hint

Basta colocar o código abaixo no evento OnCreate de um form, ou em qualquer outro objeto que você desejar.

Application.HintColor := clAqua; 

Aí está "clAqua" mas pode ser a cor de você quiser, só precisa saber os nomes das cores em delphi.

Ou se não, basta você colocar um dialogo (ColorDialog) de cores, e coloque o código abaixo, para você ver que você poderá escolher a cor do fundo do hint em tempo real.

procedure TForm1.Button1Click(Sender: TObject);
begin
  If colordialog1.Execute then begin 
     Application.HintColor := colordialog1.Color;  {opera a cor que      você optou no dialogo}
  end;
end;
end.

Conectado banco firebird pelo arquivo ini

Dica de como se conectar no banco interbase ou firebird, através de configurações de um arquivo ini.

var
vArqIni:TIniFile;
Caminho:string;
begin
   Caminho:='C:Automacao ComercialBancoAUTOMACAO.FDB';
   DataModulo.conexao.Close;
   if not( fileexists(extractfilepath(ParamStr(0))+'Automacao.ini') ) then begin
      ShowMessage('Arquivo de Configurações do Banco de Dados Não Encontrado!');
      vArqIni := TIniFile.Create(extractfilepath(ParamStr(0))+'Automacao.ini');
      try
        conexao.ConnectionName:='BANCO';
        vArqIni.WriteString('BANCO','database',Caminho);
        conexao.Params.Values['DataBase'] :=Caminho;
      finally
        vArqIni.Free;
      end;
   end;

   try
     vArqIni := TIniFile.Create(extractfilepath(ParamStr(0))+'Automacao.ini');
     conexao.ConnectionName:='BANCO';
     Caminho :=vArqIni.ReadString('BANCO','database',Caminho);
     conexao.Params.Values['DataBase'] :=Caminho;
   finally
     vArqIni.Free;
   end;

   try
     DataModulo.conexao.Connected:=True;
     DataModulo.VChamada:=0;
     DataModulo.spsusuarios.Close;
     DataModulo.spsusuarios.Open;
     DataModulo.UserControl.Execute;
   except
     Application.MessageBox( 'Não foi possivel se conectar com o banco de dados.' + #13 +
     'verifique se o arquivo de configuração está configurado, ' + #13 +
     'ou se o servidor firebird está instalado em seu sistema.' + #13 +
     'Verifique tambem se o Usuario secundario esta cadastrado.' + #13 +
     'Entre em contato com suporte para esclarecer qualquer dúvida.',
     'Error Interno', mb_ok + mb_IconError );

   Application.Terminate;
end;

Testa conectividade com internet

Essa Rotina verifica se o computador está conectado a internet usando a API do Windows. Para usar essa funcionalidade, é preciso declarar a uses WinInet.

var
flags : DWORD;
begin

   if not InternetGetConnectedState(@flags, 0) then
      MessageBox(handle, 'Você não está conectado a internet! ', mb_Ok + mb_IconWarning);
   
end;

Adicionar SQL em rotina Delphi

Atenção pessoal que está iniciando na programação Delphi com Interbase ou Outro banco. Para adicionar consulta tipo:

DataModule.Tabela.SQL.add('Texto '+variavel+'Texto'+variavel)
Onde a variável é alfa tem que ser feito conforme a seguir:
DataModule.Tabela.SQL.add('Select * from Table '''+variavel+'''Texto'''+variavel)
Perceberam as tres aspas? Muita gente já arrancou os cabelos antes de descobrir isso.

sábado, 9 de abril de 2011

Nomes dos arquivos que estão sendo executados:

É comum e até relativamente fácil encontrarmos rotinas para listar todas as janelas abertas. Mas muitas vezes não é apenas o caption das janelas que queremos listar e sim o nome do arquivo executável.

Veja então uma rotina que cria uma lista de strings com esses nomes:

uses TLHelp32; // não esqueça de incluir esta unit
procedure ListProcess(List: TStrings);
var
  ProcEntry: TProcessEntry32;
  Hnd: THandle;
  Fnd: Boolean;
begin
  List.Clear;
  Hnd := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
  if Hnd <> -1 then
  begin
  ProcEntry.dwSize := SizeOf(TProcessEntry32);
  Fnd := Process32First(Hnd, ProcEntry);
  while Fnd do
  begin
  List.Add(ProcEntry.szExeFile);
  Fnd := Process32Next(Hnd, ProcEntry);
  end;
  CloseHandle(Hnd);
  end;
end;
E para utilizar esta rotina é muito simples, veja:
procedure TForm1.Button1Click(Sender: TObject);
begin
  ListProcess(ListBox1.Items);
end;

Programar meu aplicativo para abrir arquivos a partir do Windows Explorer

Inclua na seção uses: Registry

Problema:
Criei um editor de textos no Delphi. Agora gostaria que o Windows Explorer usasse este editor para abrir arquivos com a extensão .dpg e .dan. Como fazer?

Solução:
Para fazer isto será necessária a criação de algumas chaves no Registro do Windows. O exemplo abaixo cria todas as chaves necessárias.

- Coloque um TButton e no evento OnClick dele coloque o código abaixo:

procedure TForm1.Button1Click(Sender: TObject);
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
  Reg.RootKey := HKEY_CLASSES_ROOT;
  Reg.LazyWrite := false;
  { Define o nome interno (ArquivoDaniel) e uma legenda que aparecerá no Windows Explorer (Arquivo do Daniel) }
  Reg.OpenKey('ArquivoDaniel', true);
  Reg.WriteString('', 'Arquivo do Daniel');
  Reg.CloseKey;
{ Define o comando a ser executado quando abrir um arquivo pelo Windows Explorer (NomeDoExe %1). O símbolo %1 indica que o arquivo a ser aberto será passado como primeiro parâmetro para o aplicativo - ParamStr(1). }
  Reg.OpenKey('ArquivoDaniel\shell\open\command', true);
  Reg.WriteString('', ParamStr(0) + ' %1'); { NomeDoExe %1 }
  Reg.CloseKey;
  { Define o ícone a ser usado no Windows Explorer:
  0 - primeiro ícone do EXE
  1 - segundo ícone do EXE, etc }
  Reg.OpenKey('ArquivoDaniel\DefaultIcon', true);
  Reg.WriteString('', ParamStr(0) + ',0'); { 0 = primeiro ícone }
  Reg.CloseKey;
  { Define as extensões de arquivos que serão abertos pelo meu aplicativo }
  { *.dpg }
  Reg.OpenKey('.dpg', true);
  Reg.WriteString('', 'ArquivoDaniel');
  Reg.CloseKey;
  { *.dan }
  Reg.OpenKey('.dan', true);
  Reg.WriteString('', 'ArquivoDaniel');
  Reg.CloseKey;
  finally
  Reg.Free;
  end;
end;
- Coloque um TMemo;

- No evento OnShow do Form coloque o código abaixo:

procedure TForm1.FormShow(Sender: TObject);
begin
  { Se o primeiro parâmetro for um nome de arquivo existente... }
  if FileExists(ParamStr(1)) then
  { Carrega o conteúdo do arquivo no memo }
  Memo1.Lines.LoadFromFile(ParamStr(1));
end;
*** Para testar ***

- Execute este programa;

- Clique no botão para criar as chaves no Registro do Windows;

- Feche o programa;

- Crie alguns arquivos com as extensões .dpg e .dan;

- Vá ao Windows Explorer e procure pelos arquivos criados;

- Experimente dar um duplo-clique sobre qualquer dos arquivos com uma das extensões acima.

Observações

Existem outros recursos que poderão ser configurados. Porém, para começar, este já é um bom exemplo.  

terça-feira, 5 de abril de 2011

Formatando a visualização do tamanho de um arquivo

Fonte: www.activedelphi.com.br

Quando se trabalha com arquivos no Delphi pode ser necessário exibir o tamanho de um arquivo, como é feito no Explorer, onde o valor não é mostrado em bytes, mas sim de acordo com o seu tamanho atual. Para a maioria, "45.678.123 Bytes" é confuso, mas "43,56 MB" não!
A seguir, temos uma função chamada FormatByteSize, que converte um valor em bytes para uma String que representa o número expressado em Bytes, Kilobytes Megabytes ou Gigabytes, dependendo do seu tamanho:

//Formata o tamanho de um arquivo
function FormatByteSize(const bytes: Longint): string;
const
  B = 1; //byte
  KB = 1024 * B; //kilobyte
  MB = 1024 * KB; //megabyte
  GB = 1024 * MB; //gigabyte
begin
  if bytes > GB then
    result := FormatFloat('#.## GB', bytes / GB)
  else
    if bytes > MB then
      result := FormatFloat('#.## MB', bytes / MB)
    else
      if bytes > KB then
        result := FormatFloat('#.## KB', bytes / KB)
      else
        result := FormatFloat('#.## bytes', bytes) ;
end;
Para usá-la, basta fazer no evento onClick de um button, por exemplo:

procedure TForm1.Button1Click(Sender: TObject);
var
  TamanhoEmBytes: Longint;
begin
  with TFileStream.Create(
    'C:\Windows\System32\calc.exe',
    fmOpenRead or fmShareExclusive)
  do try
    TamanhoEmBytes := Size;
  finally
    Free;
  end;

  ShowMessage( FormatByteSize(TamanhoEmBytes) );
end;

domingo, 3 de abril de 2011

Verificando as impressoras pela rede e sabendo se elas estão online


Como verificar quais são as impressoras da rede e se elas estão On-line Com essa dica eu ajudei no fórum esta semana o Ronaldo, mas creio que como artigo, devo conseguir ajudar mais. Em vários projetos, saber se a impressão será efetuada com sucesso, e se a impressora estiver em rede e o computador que ela estiver ligada estiver sendo reiniciado, por exemplo, ou houver algum problema com a rede, talvez seja melhor dar um aviso ao usuário e esperar que ele regularize a situação antes de efetuar a impressão...
Com esta rotina abaixo, você consegue efetivamente tanto em Windows 98 quanto em Xp, obter uma resposta confiável da impressora. 

function VerImpressoraONLINE: Cardinal;
var
  hPrinter  : THandle;
  pInfo:  PPrinterInfo2;
  bytesNeeded: DWORD;
begin
  hprinter := GetCurrentPrinterHandle;
  try
    Winspool.GetPrinter( hPrinter, 2, Nil, 0, @bytesNeeded );
    pInfo := AllocMem( bytesNeeded );
    try
      Winspool.GetPrinter( hPrinter, 2, pInfo, bytesNeeded, @bytesNeeded );
       Result := pInfo^.Status;
    finally
      FreeMem( pInfo );
    end;
  finally
    ClosePrinter( hPrinter );
  end;
end;


se o resultado for > 0 então a impressora tem algum tipo de problema.
If VerImpressoraONLINE > 0
   then ShowMessage('A Impressora está OFFLINE, impressão ficará no aguardo' + #13 +  'Chame o Suporte Técnico para verificar a Impressora' );
 Para verificar quais são as impressoras da sua rede, teste da seguinte forma:
 var  ts : TStrings;
      J, K, I : Integer;
begin
    TS := Printer.Printers;
    K := Printer.PrinterIndex;
           J := -1;
           For I := 0 to TS.Count -1
               do If uppercase(copy(TS.Strings[I],1,7)) = 'EPSON'
                     then J := I;
           If J = -1
              then begin
                     ShowMessage('Impressora do estoque não configurada');
                     Exit;
              end
              else begin
                     Printer.PrinterIndex := J;
                     If VerImpressoraONLINE > 0
                        then ShowMessage('A Impressora EPSON está OFFLINE, impressão ficará no aguardo' + #13 +  'Chame o Suporte Técnico para verificar a Impressora' );
           end;

Como Consultar entre Datas no Delphi/Interbase.


Bom, estou aqui novamente para esclarecer algumas coisas sobre o artigo que escrevi anteriormente, após o artigo “Como Trabalhar com Data e Moeda no Delphi/Interbase”, recebi vários email´s e conheci muitas pessoas no MSN, por isso estou aqui novamente para dar mais uma pequena contribuição à comunidade Delphi e lembrando que é para iniciantes, programadores avançados talvez achem até sem importância para eles mas para mim foi crucial e deve ser também para outras pessoas.
Eu sei que esse assunto é no mínimo chato, mas mesmo assim vamos lá. Dessa vez vou abordar apenas datas que dão uma grande dor de cabeça no Interbase, acabo de desenvolver dois programas, um de controle de membros e colaboradores de uma Igreja e o outro para Tabelionato de Notas, apesar de serem completamente diferentes, consegui ao desenvolver os dois tirar muitas dúvidas sobre datas, por exemplo, Cartórios de Notas, todas as autenticações e demais atos que são feitos são recolhidos para o Estado (SecFaz, IPESP, etc.) e isso gera uma guia conhecida como GARE, que o cartório é obrigado a preencher diariamente, e para isso é preciso contar todos os atos realizados no dia, pegar o valor correspondente e multiplicar, além disso, escrever todo o conteúdo no campo de descrição da guia.

Com o software que eu desenvolvi, isso ficou muito fácil, pois todos esses dados estão em apenas uma tabela, é só dar um select, jogar os valores encontrados em campos pré-definidos (tipo EditQAut.text, EditvlAut.text) ou também em variáveis do tipo double fazendo as contas usando as velhas equações de 1º e 2º grau, aí é só pegar os dados encontrados e jogados nos edits correspondentes e mandar escrever em um campo qualquer:


Exemplo:


Na tabela DIARIO, existem os campos: Q_Aut Integer, Vl_Aut Numeric(9,2) e Data Date: (o campo “Q_aut”, serve para guardar a quantidade total de autenticações realizadas no dia; o campo “Vl_Aut”, para guardar a multiplicação dessas autenticações pelo preço unitário, que por sua vez é armazenado em uma outra tabela que chamei de CUSTAS, mas não vem ao caso, e o campo Data para guardar o dia que foi realizado as autenticações).

Em tempo: esses valores são encontrados previamente pelo cliente através de cálculos e opções fornecidas pelo software, entenda que estamos trabalhando já com o valor final, e não unitário tipo PDV que registra um-a-um, é como se já se tivesse fechado o caixa e estivesse querendo gerar um relatório com os dados finais.

Primeiro passo, dar um select para saber os dados do dia:


Var

C:string;
begin
C:=('select * from Diario where (Data = '#39+editdata.text+#39')');
IBQuery1.SQL.clear;
IBQuery1.sql.add(c);
IBQuery1.Open;
while IBQuery1.Eof = false do
begin
EditQAut.text:= IBQuery1.fieldbyname('Q_Aut').AsString;
EditVlAut.text:= IBQuery1.fieldbyname('Vl_Aut').AsString;
end;
end;

A declaração da variável “C: string” poderia ser de modo global, para não se repetir esse comando, dessa forma, o programa iria exibir nos edits em questão os valores contidos na tabela DIARIO. Aí logo após eu precisei escrever esses dados por extenso em um memo chamado “Mdescricao” e ficou desta forma:


MDescricao.text:= 'Hoje tiveram '+EditQAut.text+' Autenticações, que no total somou R$ '+EditvlAut.text;


Resolvi meu primeiro problema facilmente, bem simples, pois esta tudo na tabela chamada DIARIO, a Data, a Quantidade total do dia e o Valor Total, o “X” da questão foi quando me disseram que a guia que é gerada para instituição chamada IPESP não é diária, é semanal. Putz, como fazer um select entre duas datas e ainda por cima somando quantidades inteiras e valores monetários?????. Lí um e-mail que me fizeram essa mesma pergunta só que utilizando Acces, já havia lido vários artigos e dicas pela net e percebi que a resposta já estava lá, apenas precisava ser mais bem trabalhada, então achei uma solução:


Primeiro eu tinha que informar o dia inicial e o dia final, pois não encontrei funções para que o Interbase descobrisse isso pra mim, então adicionei ao form dois Maskedit´s (EditDataInicial.text e EditDataFinal.text), que serviram para informar no caso a Segunda-Feira e Sexta-Feira respectivamente, isso se não tiver feriado é claro, a partir daí criei um select com aquela função SUM, que serve para somar valores direto na base de dados, não esquecendo também de criar duas variáveis do tipo Tdate para armazenar as datas no formato americano ( D_inicial, D_Final).


Var

D_Inicial, D_Final : Tdate;
begin
{Guardar as datas nas variáveis}
D_Inicial:= StrtoDate(EditDataInicial.text);
D_Final:= StrtoDate(EditDataFinal.text);
{formatar para o formato americano}
ShorDateFormat:= ‘mm/dd/aaaa’;
{jogar as datas de volta nos Maskedits já formatadas}
EditDataInicial.text:= DatetoStr(D_Inicial);
EditDataFinal.text:= DatetoStr(D_Final);

C:=('select Sum(Q_Aut) AS Tot_Aut from Diario where (data >= '#39+EditDataInicial.Text+#39') and (data <= '#39+EditDataFinal.Text+#39')');

IBQuery1.SQL.clear;
IBQuery1.sql.add(c);
IBQuery1.Open;
while IBQuery1.Eof = false do
begin
EditTotal.text:= IBQuery1.fieldbyname('Tot_Aut').AsString;
{retornar para o formato brasileiro}
ShorDateFormat:= ‘dd/mm/aaaa’;
{joga o valor das datas novamente nos edits só que no formato dd/mm/aaaa}
EditDataInicial.text:= DatetoStr(D_Inicial);
EditDataFinal.text:= DatetoStr(D_Final);
end;
end;

Assim descobri a quantidade total de autenticações da semana, para descobrir a soma dos valores é só mudar o campo “Q_Aut” por “Vl_Aut”, assim ele irá somar os valores e não as quantidades. Claro que tudo isso pode ser feito em apenas um Select com declarações compostas utilizando aquela opção de Select-dentro-de-Select (SubSelect), aí é só quebrar a cabeça e resolver. Existem outras formas de fazer isso tudo que eu fiz diminuindo consideravelmente à quantidade de linhas de comandos, mas expliquei desse jeito passo-a-passo para entendermos melhor como funciona o Interbase com relação a datas.


Explicando o código:


Primeiro eu declarei duas variáveis do tipo “Tdate” [D_Inicial, D_Final] para armazenar as datas informadas nos MaskEdits [EditDataInicial.text e EditDataFinal.text], o que acontece, quando digitamos 13/12/2004 e 17/12/2004 respectivamente, isso é de Segunda a Sexta, ele vai pegar e alterar 13/12/2004 e 17/12/2004 por 12/13/2004 e 12/17/2004 respectivamente e jogar de volta no Maskedit, ai ele faz a comparação na base de dados já no formato que o Interbase entende mm/dd/aaaa (Mês/Dia/Ano), após isso é feito o select somando a quantidade encontrada [SUM(Q_Aut)] verificando as datas e retornando somente os registros que forem maiores ou iguais que 12/13/2004 e menores ou igual que 12/17/2004 [where (Data >= '#39+EditDataInicial.text+#39') and (Data <= '#39+EditDataFinal.text+#39'], assim ele vai verificar todos e trazer para os edits indicados, após isso, mudei novamente o formato da data para o formato brasileiro [ShorDateFormat:= ‘dd/mm/aaaa’] e mandei jogar os valores das respectivas datas nos Maskedits de novo, aí ele desfaz 12/13/2004 e 12/17/2004 por 13/12/2004 e 17/12/2004 respectivamente, ou seja, assim o delphi faz todo o trabalho de conversão para você sem maiores preocupações com o formato que foi digitado Dia/Mês/Ano, ou seja, o cliente digita Dia/Mês/Ano, o programa muda para Mês/Dia/Ano, faz todo o trabalho de recuperação dos dados e depois muda de novo para Dia/Mês/Ano.

Alguns devem pensar, pô.....engraçado, o cara do artigo fala que o formato da data é alterada pelo Interbase mas quando eu abro o IBConsole e dou um select * from Nome_da_Tabela, a data [campo do tipo Tdate] vem no formato dd/mm/aaaa, e não como ele diz que é...... Simples, é que ao fazer esse select no IBConsole, o Interbase verifica as configurações regionais do Windows e já retorna no formato correto, só que se você colocar um dbgrid no seu aplicativo para testar e der o mesmo select, irá ver que a data virá invertida, da forma que eu estou dizendo.

sábado, 2 de abril de 2011

Destacando título da coluna ativa no DBGrid


Alterar as cores do título de um DBGrid em tempo execução dará mais vida ao seu programa e trará uma aparência mais profissional ao sistema. Para que última coluna clicada tenha o título com um estilo diferente, faça no evento onTitleClick do DBGrid:

procedure TForm1.DBGrid1TitleClick(Column: TColumn);
var
  i: integer;
begin
  //para todas as colunas
  for i:=0 to DBGrid1.Columns.count-1 do
  begin
    DBGrid1.Columns[i].Title.Color := clBtnFace; //fundo padrão
    DBGrid1.Columns[i].Title.Font.Color := clBlack; //texto preto
    DBGrid1.Columns[i].Title.Font.Style := []; //sem efeito
  end;

  //para a coluna atual
  Column.Title.color := ClYellow; //fundo amarelo
  Column.Title.Font.Color := clRed; //texto vermelho
  Column.Title.Font.Style := [fsBold, fsItalic]; //negrito e itálico
end;

sexta-feira, 1 de abril de 2011

Formatando a visualização do tamanho de um arquivo

Fonte: www.activedelphi.com.br

Quando se trabalha com arquivos no Delphi pode ser necessário exibir o tamanho de um arquivo, como é feito no Explorer, onde o valor não é mostrado em bytes, mas sim de acordo com o seu tamanho atual. Para a maioria, "45.678.123 Bytes" é confuso, mas "43,56 MB" não!
A seguir, temos uma função chamada FormatByteSize, que converte um valor em bytes para uma String que representa o número expressado em Bytes, Kilobytes Megabytes ou Gigabytes, dependendo do seu tamanho:

//Formata o tamanho de um arquivo
function FormatByteSize(const bytes: Longint): string;
const
  B = 1; //byte
  KB = 1024 * B; //kilobyte
  MB = 1024 * KB; //megabyte
  GB = 1024 * MB; //gigabyte
begin
  if bytes > GB then
    result := FormatFloat('#.## GB', bytes / GB)
  else
    if bytes > MB then
      result := FormatFloat('#.## MB', bytes / MB)
    else
      if bytes > KB then
        result := FormatFloat('#.## KB', bytes / KB)
      else
        result := FormatFloat('#.## bytes', bytes) ;
end;
Para usá-la, basta fazer no evento onClick de um button, por exemplo:

procedure TForm1.Button1Click(Sender: TObject);
var
  TamanhoEmBytes: Longint;
begin
  with TFileStream.Create(
    'C:\Windows\System32\calc.exe',
    fmOpenRead or fmShareExclusive)
  do try
    TamanhoEmBytes := Size;
  finally
    Free;
  end;

  ShowMessage( FormatByteSize(TamanhoEmBytes) );
end;

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

Ajustando a Data e a Hora do Computador

Fonte: www.activedelphi.com.br


Esta dica apresenta uma função simples, porém útil, para ajustar a data e a hora do sistema operacional. Ela foi postada pelo membro Rubem Rocha, na lista de discussão lista-delphi (link no final da dica). Fiz os testes e agora compartilho com vocês.
Segue o código da função:


function SetComputerDateTime(ADateTime: TDateTime): boolean;
const
  SE_SYSTEMTIME_NAME = 'SeSystemtimePrivilege';
var
  hToken: THandle;
  ReturnLength: DWORD;
  tkp, PrevTokenPriv: TTokenPrivileges;
  luid: TLargeInteger;
  dSysTime: TSystemTime;
begin
  Result := False;
  if Win32Platform = VER_PLATFORM_WIN32_NT then
    if OpenProcessToken(GetCurrentProcess,
      TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
    try
      if not LookupPrivilegeValue(nil, SE_SYSTEMTIME_NAME, luid) then
        Exit;

      tkp.PrivilegeCount := 1;
      tkp.Privileges[0].luid := luid;
      tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

      if not AdjustTokenPrivileges(hToken, False, tkp,
        SizeOf(TTOKENPRIVILEGES), PrevTokenPriv, ReturnLength) then
        Exit;

      if GetLastError <> ERROR_SUCCESS then
      begin
        raise Exception.Create(SysErrorMessage(GetLastError));
        Exit;
      end;
    finally
      CloseHandle(hToken);
    end;

  DateTimeToSystemTime(ADateTime, dSysTime);
  Result := SetLocalTime(dSysTime);
  if Result then
    PostMessage(HWND_BROADCAST, WM_TIMECHANGE, 0, 0);
end;
Para testá-la, faça no onClick de um Button, por exemplo, o seguinte código:


procedure TForm1.Button1Click(Sender: TObject);
var
  Correta, Nova: TDateTime;
begin
  Correta := Now; //recupera a hora correta
  Nova := StrToDateTime('01/01/2011 12:34:56'); //gera uma nova data qualquer
  SetComputerDateTime(Nova); //altera a data
  ShowMessage('Clique em OK para voltar a data correta!'); //alerta o usuário
  SetComputerDateTime(Correta); //volta a data correta
end;

segunda-feira, 21 de março de 2011

De Enum para String e de String para Enum


Há algum tempo atrás precisei criar um enumerado e depois carregar este enumerado em um ComboBox. Toda vez que surgia essa necessidade eu criava o enum e criava um array de string com todas as opções do enum, aí com um loop no array eu populava o ComoboBox. Só que toda vez que precisava acrescentar um nova opção no enum eu tinha que atualizar o array.

Isso começou me incomodar! Foi aí que lembrei que quando desenvolvemos componentes e criamos uma property do tipo de um enum na seção published, o Delphi exibe esse enum no ObjectInspector com um ComboBox, e ele faz isso automaticamente! Aí pensei: “isso deve ser possível” já que o Delphi faz. Então entrei em contato com um amigo meu muito fera em Delphi, “Adriano Santos”, e ele conseguiu a solução que eu gostaria de publicar.

Vamos lá, vou dar o exemplo referente a minha necessidade na época que estava desenvolvendo uma comunicação com uma balança através da porta COM.

Criando o enum:

type
  TPorta = (COM1, COM2, COM3, COM4, COM5, COM6, COM7, COM8, COM9);

Criando a property do tipo do enum:

  private
    FPort: TPort;
  public
    property Port: TPort read FPort write FPort;
  end;

Criando um método que vai popular uma lista do Tipo TStrings, assim, com esse método posso popular objetos como: TComboBox, TMemo, TListBox ou até mesmo uma variável do Tipo TStrings. Primeiro deve ser declarado na seção uses a unit: TypInfo.

class procedure TSerialComunication.PopulateListPort(AList: TStrings);
var
  i: Integer;
Begin
  for i := Ord(Low(TPort)) to Ord(High(TPort)) do
    AList.Add(GetEnumName(TypeInfo(TPort), i));
end;

Agora basta chamar o método e popular o ComboBox:

procedure TfrmPrincipal.btnPopulatePortClick(Sender: TObject);
Begin
  TSerialComunication.PopulateListPort(cbbPort.Items);
end;

Essa foi a solução que meu amigão Adriano Santos meu passou, achei genial.

Agora imagina se precisar pegar um item do ComboBox que é uma string e passar pra uma variável do tipo do Enum? Antigamente eu usaria um case pra saber qual foi o item selecionado e passar a opção do enum correta, mas agora posso usar a mesma idéia e converter automaticamente enum para string ou vice-versa! Então criei dois overload de um método Convert:

class function TSerialComunication.Convert(const APort: string): TPort;
begin
  Result := TPort(GetEnumValue(TypeInfo(TPort), APort)) ;
end;

class function TSerialComunication.Convert(const APort: TPort): string;
begin
  Result := GetEnumName(TypeInfo(TPort), Integer(APort)) ;
end;

Agora ficou facil, basta chamar os métodos de conversão!

Convertendo o item do combobox para o enum:

procedure TfrmPrincipal.btnStringToEnumClick(Sender: TObject);
var
  vPort: TPort;
begin
  vPort := TSerialComunication.Convert(cbbPort.Text);
end;

Convertendo de Enum para uma string:

procedure TfrmPrincipal.btnEnumToStringClick(Sender: TObject);
var
  vPort: TPort;
begin
  vPort := COM1;
  ShowMessage(TSerialComunication.Convert(vPort));
end;

domingo, 20 de março de 2011

Justificação e Entre-linhas em RichEdit


A partir do RichEdit 3.0, é possível justificar parágrafo/texto em um RichEdit. Entretanto, no componente TRichEdit (ao menos até a versão 7), não há esta opção de alinhamento (existem apenas, taLeftJustify, taRightJustify e taCenter). Logo, temos que fazer uso de chamadas à API do Windows para que consigamos esta formatação.
Além do "Marcador de Texto", um outro recurso que pode ser aproveitado por quem utilizar TRichEdit em pequenos editores de texto é a variação do entre-linhas.

Abaixo, seguem duas funções para os recursos mencionados:

// AllText: True = todo o texto; False = parágrafo atual
procedure JustifyRichEdit(RichEdit :TRichEdit; AllText :Boolean);
const
  TO_ADVANCEDTYPOGRAPHY   = $1;
  EM_SETTYPOGRAPHYOPTIONS = (WM_USER + 202);
  EM_GETTYPOGRAPHYOPTIONS = (WM_USER + 203);
var
  ParaFormat :TParaFormat;
  SelStart,
  SelLength :Integer;
begin
  ParaFormat.cbSize := SizeOf(ParaFormat);
  if SendMessage(RichEdit.handle,
              EM_SETTYPOGRAPHYOPTIONS,
              TO_ADVANCEDTYPOGRAPHY,
              TO_ADVANCEDTYPOGRAPHY) = 1 then
  begin
    SelStart := RichEdit.SelStart;
    SelLength := RichEdit.SelLength;
    if AllText then
      RichEdit.SelectAll;
    ParaFormat.dwMask := PFM_ALIGNMENT;
    ParaFormat.wAlignment := PFA_JUSTIFY;
    SendMessage(RichEdit.handle, EM_SETPARAFORMAT, 0, LongInt(@ParaFormat));
    // Restaura seleção caso tenhamos mudado para All
    RichEdit.SelStart := SelStart;
    RichEdit.SelLength := SelLength;
  end;
end;


// Espaçamento: 0 = simples; 1 = 1,5; 2 = duplo
procedure LineSpaceRichEdit(RichEdit :TRichEdit; Espacamento :Integer; AllText :Boolean);
var
  ParaFormat :TParaFormat2;
begin
  if AllText then
    RichEdit.SelectAll;
  ParaFormat.cbSize := SizeOf(ParaFormat);
  ParaFormat.dwMask := PFM_LINESPACING or PFM_SPACEAFTER;
  ParaFormat.dyLineSpacing := Espacamento;
  ParaFormat.bLineSpacingRule := Espacamento;
  SendMessage(RichEdit.handle, EM_SETPARAFORMAT, 0, LongInt(@ParaFormat));
  // Restaura seleção caso tenhamos mudado para All
  RichEdit.SelStart := SelStart;
  RichEdit.SelLength := SelLength;
end;

Para usá-las, você possui 2 alternativas:

1) Todo o texto:

  JustifyRichEdit(RichEdit1, True); // justifica todo o texto
  LineSpaceRichEdit(RichEdit1, 2, True); // espaçamento duplo em todo o texto

2) Parâgrafo atual ou selecionado(s):

  JustifyRichEdit(RichEdit1, False); // justifica parágrafo(s)
  LineSpaceRichEdit(RichEdit1, 1, False); // espaçamento 1,5 no(s) paragrafo(s)

Obs: É necessário declarar a unit RichEdit na cláusula USES do seu form.

Criptografando Arquivos com Letras e Números


Esta dica vem para complementar a dica "Criptografia de Arquivos", onde o autor implementa uma camada a mais de criptografia utilizando o conceito de CRC (Cyclic Redundancy Check - Verificação Cíclica de Redundância).
Chega de se criptografar senhas com somente numeros! Tenho uma solução e é bem Simples!
Asseguir, criaremos um cálculo de CRC atravéz de String:

function StringCrc(const Data: string): longword;
const
  CRCtable: array[0..255] of DWORD = (
    $00000000, $77073096, $EE0E612C, $990951BA, $076DC419, $706AF48F, $E963A535,
    $9E6495A3, $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988, $09B64C2B, $7EB17CBD,
    $E7B82D07, $90BF1D91, $1DB71064, $6AB020F2, $F3B97148, $84BE41DE, $1ADAD47D,
    $6DDDE4EB, $F4D4B551, $83D385C7, $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
    $14015C4F, $63066CD9, $FA0F3D63, $8D080DF5, $3B6E20C8, $4C69105E, $D56041E4,
    $A2677172, $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B, $35B5A8FA, $42B2986C,
    $DBBBC9D6, $ACBCF940, $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59, $26D930AC,
    $51DE003A, $C8D75180, $BFD06116, $21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
    $2802B89E, $5F058808, $C60CD9B2, $B10BE924, $2F6F7C87, $58684C11, $C1611DAB,
    $B6662D3D, $76DC4190, $01DB7106, $98D220BC, $EFD5102A, $71B18589, $06B6B51F,
    $9FBFE4A5, $E8B8D433, $7807C9A2, $0F00F934, $9609A88E, $E10E9818, $7F6A0DBB,
    $086D3D2D, $91646C97, $E6635C01, $6B6B51F4, $1C6C6162, $856530D8, $F262004E,
    $6C0695ED, $1B01A57B, $8208F4C1, $F50FC457, $65B0D9C6, $12B7E950, $8BBEB8EA,
    $FCB9887C, $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65, $4DB26158, $3AB551CE,
    $A3BC0074, $D4BB30E2, $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB, $4369E96A,
    $346ED9FC, $AD678846, $DA60B8D0, $44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
    $5005713C, $270241AA, $BE0B1010, $C90C2086, $5768B525, $206F85B3, $B966D409,
    $CE61E49F, $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4, $59B33D17, $2EB40D81,
    $B7BD5C3B, $C0BA6CAD, $EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A, $EAD54739,
    $9DD277AF, $04DB2615, $73DC1683, $E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
    $E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1, $F00F9344, $8708A3D2, $1E01F268,
    $6906C2FE, $F762575D, $806567CB, $196C3671, $6E6B06E7, $FED41B76, $89D32BE0,
    $10DA7A5A, $67DD4ACC, $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5, $D6D6A3E8,
    $A1D1937E, $38D8C2C4, $4FDFF252, $D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
    $D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60, $DF60EFC3, $A867DF55, $316E8EEF,
    $4669BE79, $CB61B38C, $BC66831A, $256FD2A0, $5268E236, $CC0C7795, $BB0B4703,
    $220216B9, $5505262F, $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04, $C2D7FFA7,
    $B5D0CF31, $2CD99E8B, $5BDEAE1D, $9B64C2B0, $EC63F226, $756AA39C, $026D930A,
    $9C0906A9, $EB0E363F, $72076785, $05005713, $95BF4A82, $E2B87A14, $7BB12BAE,
    $0CB61B38, $92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21, $86D3D2D4, $F1D4E242,
    $68DDB3F8, $1FDA836E, $81BE16CD, $F6B9265B, $6FB077E1, $18B74777, $88085AE6,
    $FF0F6A70, $66063BCA, $11010B5C, $8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
    $A00AE278, $D70DD2EE, $4E048354, $3903B3C2, $A7672661, $D06016F7, $4969474D,
    $3E6E77DB, $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0, $A9BCAE53, $DEBB9EC5,
    $47B2CF7F, $30B5FFE9, $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6, $BAD03605,
    $CDD70693, $54DE5729, $23D967BF, $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
    $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);
var
  i: integer;
begin
  result := $FFFFFFFF;
  for i := 0 to length(Data) - 1 do
    result := (result shr 8) xor (CRCtable[byte(result) xor Ord(Data[i + 1])]);
  result := result xor $FFFFFFFF;
end;
Criaremos agora um codigo que criptografa textos atravéz de somente números:

function EnDecryptString(StrValue : String; Chave: Word) : String;
var
  I: Integer;
  OutValue : String;
begin
  OutValue := '';
  for I := 1 to Length(StrValue) do
    OutValue := OutValue + char(Not(ord(StrValue[I])-Chave));
  Result := OutValue;
end;
E finalmente, usaremos os dois:

procedure EndeCriptFile(FileName, Saida, Key: String);
var
  F: TFileStream;
  S: TStringStream;
  C: String;
begin
  F:=TFileStream.Create(FileName,FmOpenRead);
  S:=TStringStream.Create('');
  S.CopyFrom(F,F.Size);
  F.Free;
  C:=EnDecryptString(S.DataString, {*} StringCrc(Key) {*} ); //eis o X da questão
  S.free;
  S:=TStringStream.Create(C);
  F:=TFileStream.Create(Saida,FmCreate);
  F.CopyFrom(S,S.Size);
  S.Free;
  F.Free;
End;

Como gravar posição do form no registro do windows e recuperá-lo


Caros amigos delphianos, esta dica é muito útil para quem precisa gravar a posição do formulário no registro do windows e assim quando o usuário for abrir aquele mesmo form ele irá buscar esta informações no registro do windows e chamar o form do mesmo jeito que o usuário visualizou pela ultima vez
Basta inserir no FormShow do form a seguinte linha de código:
// Recupera a posição da janela no registro do windows
GetRegWindowState(Self, '\Software\Software Teste\Teste\Cadastro\Form\CadTabPreco');

E para gravar as informações insira esta linha de código no FormClose do form. 
// Grava a posição do form para posterior recuperação no "FormShow" 
SetRegWindowState(Self,'\Software\Software Teste\Teste\Cadastro\Form\CadTabPreco');

Observação: Self: é o próprio objeto form que está sendo executado.
'\Software\Software Teste\Teste\Cadastro\Form\CadTabPreco': Caminho no registro do windows aonde será gravada as informações.

Enter no Lugar do Tab até no Grid


Esta dica vem para complementar a publicada recentemente: "Transformando a tecla Enter em Tab". O código já é conhecido, e transformará o Enter no Tab mesmo o foco estando em um Grid e, caso em algum momento alguma coluna no grid estiver oculta, será ignorada e o foco irá para a próxima coluna visível.
Este código deve ser colocado no evento onKeyPress do form, lembrando de deixar a propriedade KeyPreview como True.

  if Key = #13 then // se foi enter
  begin
     if not (ActiveControl is TDBGrid) then
     begin
        Key := #0;   // suprime som
        Perform(WM_NEXTDLGCTL, 0, 0);
     end
     else if (ActiveControl is TDBGrid) then
        with TDBGrid(ActiveControl) do
        begin
           repeat
              if selectedindex < (fieldcount - 1) then
                 selectedindex := selectedindex + 1
              else
                 selectedindex := 0;
           until Columns[selectedindex].visible
        end;
  end;

Arrastando arquivos para a aplicação


Operações de arrastar são comuns em aplicações Win32. Quando trabalhamos com o Windows Explorer, podemos copiar, mover e até excluir arquivos utilizando o recurso "arrastar e soltar". A VCL do Delphi já possui implementação para trabalharmos com "Drag and Drop", mas para aceitar arquivos externos, temos de trabalhar com as mensagens da API do Windows.

Sabemos que o arrastar começa quando um objeto é movido com o botão do mouse pressionado e, ao largar o botão, acontece o soltar. Para um "objeto janela" (formulário do Delphi) ser capaz de aceitar um arquivo "soltado" do Windows, é necessário uma chamada ao método DragAcceptFiles. Depois, precisamos de um gerenciador para a mensagem WM_DROPFILES.

Para montar o exemplo, em uma nova aplicação, adicione ao uses a unit ShellApi. Acrescente ao form um Memo e no evento onCreate, faça:

procedure TForm1.FormCreate(Sender: TObject);
begin
  //informa ao SO que o form está pronto para receber o "soltar"
  DragAcceptFiles( Handle , True ) ;
end;

Em seguida, na seção private do forme, faça a seguinte declaração:

  private
    { Private declarations }
    procedure WMDROPFILES(var msg: TWMDropFiles); message WM_DROPFILES;

E por último, implemente este método, que fará o gerenciamento das mensagens WM_DROPFILES, conforme o código asseguir:

procedure TForm1.WMDROPFILES(var msg: TWMDropFiles);
const
  MAXFILENAME = 255;
var
  cnt, Qtde: integer;
  Nome: array [0..MAXFILENAME] of char;
begin
  //quantos arquivos estão sendo "soltados" na aplicação
  Qtde := DragQueryFile(msg.Drop, $FFFFFFFF, Nome, MAXFILENAME);

  //percorre a lista de arquivos
  for cnt := 0 to Qtde-1 do
  begin
    //recupera o nome
    DragQueryFile(msg.Drop, cnt, Nome, MAXFILENAME) ;

    //aqui, fazemos o que for necessário com o arquivo, onde neste caso
    //apenas adicionamos seu nome à primeira linha do Memo
    memo1.Lines.Insert(0, Nome) ;
  end;

  //libera a memória
  DragFinish(msg.Drop) ;
end;

sábado, 19 de março de 2011

Comunicando com outra aplicação


Essa dica explicando como enviar, ou pelo menos simular o envio, de certa mensagem a um aplicativo externo, como o MSN Messenger, ou qualquer outra aplicação que você gostaria que seu software comunicasse.

Alguns aplicativos são protegidos para não receber mensagens externas, e a maneira mais fácil de "burlar" essa proteção é fazendo com que o software imagine que o usuário que esta fazendo certo procedimento.

Então criaremos a seguinte função :

procedure ProcKey(K: Char);
var
  C: Char;
const
  ShiftKeys: array[1..18] of String = ('!',\@\, '#', '$', '%', '&', '*', '(', ')','_', '+', '{', '}', '|', '<', '>', ':', '?');
SKValues: array[1..18] of Char = ('1', '2', '3', '4', '5', '7', '8', '9', '0','-', '=', '[', ']', '\', ',', '.', ';', '/');
function SK: Boolean;
  var X: Integer;
  begin
    Result := True;
    for X := 1 to 18 do if ShiftKeys[X] = K then
    begin
      C := SKValues[X];
      exit;
    end;
    Result := False;
  end;
  begin
    if (K in ['a'..'z', '0'..'9', #32, '.', ',']) then keybd_event(VkKeyScan(UpCase(K)), 0, 0, 0)
    else if (K in ['A'..'Z']) then
    begin
      { Pressiona o shift }
      keybd_event(VK_SHIFT, 0, KEYEVENTF_EXTENDEDKEY or 0, 0);
      { Tecla a letra }
      keybd_event(VkKeyScan(UpCase(K)), 0, 0, 0);
      { Solta o shift }
      keybd_event(VK_SHIFT, $45, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0);
    end
    else if SK then
    begin
      { Pressiona o shift }
      keybd_event(VK_SHIFT, 0, KEYEVENTF_EXTENDEDKEY or 0, 0);
      { Tecla a letra }
      keybd_event(VkKeyScan(C), 0, 0, 0);
      { Solta o shift }
      keybd_event(VK_SHIFT, $45, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0);
    end;
  end;


  Esta função fica responsável pela simulação do pressionamento de alguma tecla, fazendo com que o controle ativo receba tal caractere.

  Para podermos digitar toda uma frase é só fazer um loop ... Por exemplo, temos uma constante Texto com o valor 'Artigo para aprendizado', e gostaríamos de que quando o usuário estiver visualizado uma janela que possua tal palavra em seu título, ele digite essa mensagem e tecle enter, no caso do MSN para que ela seja enviada, faríamos da seguinte maneira :


  var Texto : string;
    x: integer;
  begin
    Texto := edit1.Text;

    while True do
    begin
      if GetForegroundWindow = FindWindow(nil, '(co) Mauro (co)') then
      begin
        for X := 1 to Length(Texto) do ProcKey(Texto[X]);
        keybd_event(13, 0, 0, 0);
      end;
      Application.ProcessMessages;
    end;

  end;

  A rotina acima faz um loop na constante Texto ... quando a janela ativa for a janela que tiver o titulo igual a (co) Mauro (co), digitando os caracteres e mandando a mensagem com o pressionamento do enter.

quinta-feira, 17 de março de 2011

Captcha em Delphi


Esta é uma dica interessante principalmente para quem trabalha com webbroker. Se você não sabe do que estamos falando, leia este artigo sobre captcha, no wikipedia.

Para fazer este exemplo, crie uma nova aplicação e adicione ao formulário um componente TImage, um TEdit e um TButton. Configure a propriedade CharCase do TEdit para ecUpperCase.

No código fonte, vamos declarar a função que fará a geração do código e da imagem. Vá à seção public e faça:

  public
    { Public declarations }
    function GeraImagem(Img: TImage): string;

Em seguida, pressionando CTRL + SHIFT + C, fazemos a implementação da função:

function TForm1.GeraImagem(Img: TImage): string;
const
  f: array [0..4] of string = ('Courier New', 'Impact', 'Times New Roman',
                               'Verdana', 'Arial');
  s = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789';
  c: array [0..14] of TColor = (clAqua, clBlack, clBlue, clFuchsia, clGray,
                                clGreen, clLime, clMaroon, clNavy, clOlive,
                                clPurple, clRed, clSilver, clTeal, clYellow);
var
  i, x, y: integer;
  r: string;

begin
  randomize;
  Img.Width := 160;
  Img.Height := 60;
  for i := 0 to 3 do
    r := r + s[Random(length(s)-1)+1];

  with Img.Picture.Bitmap do
  begin
    width := Img.Width;
    Height := Img.Height;
    Canvas.Brush.Color := $00EFEFEF;
    Canvas.FillRect(Img.ClientRect);

    for i := 0 to 3 do
    begin
      Canvas.Font.Size := random(20) + 20;
      Canvas.Font.Name := f[High(f)];
      Canvas.Font.Color := c[random(High(c))];
      Canvas.TextOut(i*40,0, r[i+1]);
    end;

    for i := 0 to 2 do
    begin
      Canvas.Pen.Color := c[random(High(c))];
      Canvas.Pen.Width := 2;
      canvas.MoveTo(random(Width), 0);
      Canvas.LineTo(random(Width), Height);
      Canvas.Pen.Width := 1;
      x := random(Width-10);
      y := random(Height-10);
      Canvas.Rectangle(x, y, x+10, y+10);
    end;
  end;

  Result := r;
end;

Para testar, primeiro devemos adicionar uma variável global, conforme abaixo:

var
  Form1: TForm1;
  validapost: string;

Agora, no evento onClick do botão, fazemos a validação:

procedure TForm1.Button1Click(Sender: TObject);
begin
  if (Edit1.Text = validapost) then
    Application.MessageBox('Parabéns, muito bem!', 'Sucesso',
    MB_OK + MB_ICONINFORMATION)
  else
    Application.MessageBox('Ops! Você errou.', 'Falhou',
    MB_OK + MB_ICONWARNING);
  FormShow(self);
end;

E por último, o evento onShow do form, que chamará a função para gerar uma nova imagem:

procedure TForm1.FormShow(Sender: TObject);
begin
  Edit1.Clear;
  Edit1.SetFocus;
  validapost := GeraImagem(Image1);
end;

Agora é só rodar e brincar com seu captcha! Espero que tenham gostado!

Clique aqui para baixar o código fonte de exemplo. (206 KB)

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

Como instalar componentes

No delphi a três maneiras de instalar componentes. Existe a possibilidade de instalar componentes através de três tipos de extensões de arquivos: *.pas, *.dcu, *.dpk.

Explicando um por um:
1 - Para arquivos que necessitam de um Package (normalmente componentes que possuem somente o *.PAS), execute o Delphi e feche o projeto, acesse o menu 'Component' e clique na opção 'install component'. Na janela que se apresenta, acesse a aba ' Into New Packages', clique no botão 'Browse' ao lado da caixa de texto 'Unit File Name' abra o arquivo com extensão *.pas, dê ok e logo após 'Compile' e 'Install' e o arquivo criará uma aba na barra de componentes com um nome para a sua localização.

2 - Para instalar pacotes de componentes (Packages, arquivos com a extensão *.DPK), execute o Delphi e feche o projeto, acesse o menu 'File' e clique na opção 'Open', abra o arquivo que contém os componentes. Dê Ok e depois é só clicar en 'install'. Pronto seu pacote de componentes será instalado.

3 - Para arquivos com a extensão *.dcu, é um pouco mais complicado. Acesse o menu 'Component' e clique na opção 'install package'. Verifique se na lista 'Design packages' existe a opção 'Borland user component', se sim, clique no botão 'edit', abrirá uma caixa de mensagens, clique no botão 'yes'. Na janela que aparece clique no botão 'add', na janela que se abrirá clique no botão 'browse' da caixa de texto 'unit file name'. Na caixa de combinação 'files of type' escolha 'Delphi compiled unit(*.dcu)', depois na caixa de texto 'File name' direcione o arquivo a ser instalado, clique no botão 'open'. Clique no botão 'ok' na janela que aparece e clique no botão install. Pronto o seu componente será instalado.

Observação:
Se na lista 'Design packages' não tiver a opção 'Borland user component' você deverá primeiro instalar componentes que estão em arquivos com extensão *.pas.

Como fazer uma unit como biblioteca

COMO FAZER DCU PARA SERVIR COMO BIBLIOTECA DE FUNCOES E COMO FAZER PARA QUE OUTRO PROGRAMA ENXERGUE-AS.

PRIMEIRO:
PARA FAZER UMA UNIT DE FUNCOES, VOCÊ TEM QUE COMPILA-LA PARA GERAR A EXTENSÃO DCU. PARA FAZER COM QUE ELA VIRE UMA BIBLIOTECA DE FUNÇÕES ELA TEM QUE TER A EXTENSÃO DCU.

SEGUNDO:
VOCÊ NÃO VAI CONSEGUIR COMPILAR UMA UNIT SE ELA ESTIVER SOZINHA, ISTO PORQUE O DELPHI SÓ COMPILA PROJETOS E COMO UNIT NÃO É PROJETO A OPÇÃO DE COMPILAÇÃO NÃO ESTARÁ DISPONÍVEL. PORTANTO, ABRA UM PROJETO QUALQUER, OU MESMO CRIE UM ALEATORIO E ABRA UMA NOVA UNIT, É NESTA UNIT E NÃO A DO PROJETO QUE VOCÊ CRIARÁ TODAS AS SUAS FUNÇÕES. DEPOIS DISTO ENTÃO VOCÊ ABANDONA O FORM E SÓ VAI USAR A UNIT.

TERCEIRO:
QUANDO VOCÊ ABRIR A UNIT, ESTA VIRÁ SOMENTE COM O NOME, INTERFACE, IMPLEMENTATION E END..

EXEMPLO:
Unit unit1;
Interface
Implementation
End.

QUARTO:
PARA VOCÊ CRIAR UMA FUNÇÃO O PROCEDIMENTO É IGUAL Á UNIT COMUM, MAS PARA QUE ELA SEJA ENXERGADA POR OUTROS PROGRAMAS PRECISA SER DECLARADA ABAIXO DA INTERFACE E ABAIXO DE POSSIVEIS USES NECESSÁRIOS AS SUAS FUNÇÕES.

EXEMPLO DE UMA UNIT DE FUNÇÕES:

unit ufuncoes; //NOME DA UNIT

interface

uses // CLASSES NECESSÁRIAS ÁS FUNÇÕES ABAIXO, NAS SUAS TALVEZ PRECISE DE OUTRAS
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Dialogs, StdCtrls, Grids, DBGrids;

function data(vdata:string):boolean; // DECLARAÇÃO DAS FUNÇÕES OU PROCEDURES

procedure cor(grade:tdbgrid;color:tcolor); // PARA PODEREM SER ENXERGADAS POR OUTRAS UNITS.
// COLOQUE OS MESMOS CABEÇALHOS DA SUA FUNÇÀO

implementation // AQUI QUE VOCÊ VAI CRIAR AS SUAS FUNÇÕES, NÃO SE ESQUEÇA O QUE CRIAR AQUI, TERÁ QUE DECLARAR EM CIMA SENÃO NENHUMA OUTRA UNIT AS ENXERGARÁ.

function data(vdata:string):boolean;
begin
try
StrToDate(vdata);
data:=true;
except
MessageDlg('Data Inválida !!' , mtInformation, [mbOk], 0);
data:=false;
end;
end;

procedure cor(grade:tdbgrid;color:tcolor);
// muda a cor para preto para todas as colunas de qualquer dbgrid
var
i:integer;
numcampos:integer;
begin
numcampos:=grade.FieldCount;
{subtraio -1 aqui embaixo porque as colunas começam de zero}
for I := 0 to numcampos-1 do // COLOCA AS 23 COLUNAS COM COR PRETA
grade.columns[i].font.color:=color;
end;
end.
 
QUINTO:
PARA QUALQUER UNIT ENXERGAR ESTAS DUAS FUNÇÕES ACIMA, É NECESSÁRIO QUE VOCÊ COLOQUE ESTA UNIT NO DIRETORIO DO SEU PROGRAMA QUE VAI UTILIZÁ-LA E DEPOIS É SÓ COLOCÁ-LA NA USES DA UNIT QUE FARÁ O USO DAS MESMAS. APÓS ISTO É SÓ CHAMAR AS FUNÇÕES QUE NELA CONSTEM QUE FUNCIONARÃO PERFEITAMENTE, INCLUSIVE PODEM SER DEBUGADAS, O DEBUG ENTRARÁ NA UNIT DAS FUNÇÕES SE VOCÊ FOR TECLANDO F7.

Como usar a cláusula UNION em um Query

 O uso do componente TQuery gera muitas vantagens e economiza muitas linhas de programação. Mas muitas vezes nos deparamos com situações que parecem não ser resolvidas com sentenças SQL. Vejamos um exemplo:

Você possui 2 tabelas (VendasExternas e VendasInternas) e deseja fazer um resumo de todas as vendas de um vendedor chamado Marcos. Se você usar a sentença

SELECT Nome, Valor FROM VendasExternas, VendasInternas
WHERE Nome = 'Marcos'
você vai obter como resultado uma query com 4 campos (Nome, Valor, Nome_1 e Valor_1) e um resultado bem confuso para ser manipulado.

Para resolver o problema, você poderá usar a sentença

SELECT Nome, Valor FROM VendasExternas
WHERE Nome = 'Marcos'
UNION ALL
SELECT Nome, Valor FROM VendasInternas
WHERE Nome = 'Marcos'
A sentença acima pede para que sejam identificados as vendas de Marcos na tabela VendasExternas, as vendas de Marcos na tabela VendasInternas e que o resultado da primeira seja unido com o resultado da segunda produzindo uma query com apenas 2 colunas.

Bloco PL/SQL para inserção de dados

Criar um bloco pl/sql que insira um novo dep na tabela s_dept

- use a sequencia s_dept_id para o campo id da tabela
- solicite ao usuario o nome do dep
- insira valores nulos p/ o campo region_id

-> no banco de dados...
 
create or replace
procedure insere_departamento (v_nome char) is
v_id number;
begin
  SELECT sequenciaID.NEXTVAL INTO v_id FROM DUAL;
  insert into tabela (id,dep,region_id)
  values (v_id,v_nome,null);
end insere_departamento;

-> no delphi...

- coloque o objeto TStoredProc dentro do formulario que ira disparar esta procedure;
- no evento que voce quiser que dispare coloque o seguinte codigo:
 var
  v_nome : String[50];
  begin
{caso vc queira informar o nome do departamento atraves de uma caixa de dialogo}
  V_nome := inputbox('Informe o nome do departamento.','Depto:','');
  .Params[0].AsString := v_nome;
{caso vc queira buscar o nome atraves de um TEdit já preenchido}
  .Params[0].AsString := .Text;
  .ExecProc;
  end;

Para aqueles que utilizam FieldByName.


Isto é para ser mais um ponto de discussão entre nós, desenvolvedores Delphi.
Sempre fui fã do FieldByName(). Sempre achei que o código ficava muito mais claro com expressões do tipo FieldByName('nome_do_campo').asAlgumaCoisa do que Fields[indice].asAlguma coisa...
Há pouco tempo, em um projeto que estou trabalhando, um amigo do trabalho me pediu que evitasse a utilização de FieldByName e de imediato questionei o porquê de tal decisão. O mesmo me pediu para que eu desse uma olhada na implementação do FieldByName nos fontes da VCL do Delphi. Vou colar aqui função para vocês:
function TDataSet.FieldByName(const FieldName: string): TField;
begin
  Result := FindField(FieldName);
  if Result = nil then DatabaseErrorFmt(SFieldNotFound, [FieldName], Self);
end;


Bom, até agora nada. Mas vamos olhar como é implementado o método FindField:

function TDataSet.FindField(const FieldName: string): TField;
begin
  Result := FFields.FindField(FieldName);
  if (Result = nil) and ObjectView then
    Result := FieldList.Find(FieldName);
  if Result = nil then
    Result := FAggFields.FindField(FieldName);
end;


Até agora ainda não temos nada de concreto sobre o motivo da não utilização do FieldByName a mim solicitada. Sendo um pouco mais persistente, vamos ver o método FindField do objeto FFields que é do tipo TField:

function TFields.FindField(const FieldName: string): TField;
var
  I: Integer;
  begin
    for I := 0 to FList.Count - 1 do
    begin
      Result := FList.Items[I];
      if AnsiCompareText(Result.FFieldName, FieldName) = 0 then Exit;
    end;
    Result := nil;
end;


Agora sim podemos concluir alguma coisa. Observando o código à cima, vamos pensar na seguinte situação. Imaginem que temos um dataset com 60 campos e temos na posição 60 um campo valorado com o qual precisamos fazer uma soma do tipo:

valor := 0;
while not DataSet.Eof do
  begin
    Valor := valor + DataSet.FieldByName('campo_valorado').asCurrency;
    DataSet.Next;
end;


Se tivermos neste DataSet 100000 registros, teremos que passar pela linha de código


...

Valor := valor + DataSet.FieldByName('campo_valorado').asCurrency;
...

100000 vezes. Um processamento rasoável. Mas e o FieldByName? Observem que na implementação do método FindField da classe TField é utilizado um for de 0 até o número de campos para se encontrar o campo desejado e assim retornar o valor. Sendo, o nosso campo desejado, o campo de número 60, cada chamada de FieldByName - em nosso caso - ocasionaria um processamento de uma repetição 60 vezes até que o campo seja encontrado. Agora vamos fazer uma conta simples:


100000 registros x 60 vezes (FieldByname) = 6000000 instruções processadas.


Poxa, chegamos a um valor alto né.


Mas qual a solução? Fields[60]?


Vamos ver a implementação da classe TFields para ver como o mesmo processa a instrução Fields[indice]:

TFields = class(TObject)
private
FList: TList;
...
protected
...
function GetField(Index: Integer): TField;
...
public
...
property Fields[Index: Integer]: TField read GetField write SetField; default;
end;


Já podemos ver que Fields é uma property indexada. Opá, algo já nos mostra que isto pode ser mais rápido que a pesquisa com o for do método FieldByName mas vamos mais a fundo. Vamos dar uma olhadinha no método de acesso GetField:

if FSparseFields > 0 then
begin
  if Index >= FSparseFields then
    DatabaseError(SListIndexError, DataSet);
  Result := FList[0];
  Result.FOffset := Index;
end else
  Result := FList[Index];


Reparem quem em nosso caso, que apenas a linha Result := FList[Index]; será acionada utilizando um TList onde são armazenados os campos de um DataSet. E como será a implementação da propriedade que define os itens de um TList?

TList = class(TObject)
private
FList: PPointerList;
...
protected
function Get(Index: Integer): Pointer;
...
public
...
property Items[Index: Integer]: Pointer read Get write Put; default;
...
end;


Por fim chegamos ao método de acesso Get da property items da classe TList:

function TList.Get(Index: Integer): Pointer;
begin
  if (Index < 0) or (Index >= FCount) then
    Error(@SListIndexError, Index);
  Result := FList^[Index];
end;

Observem a diferença. Aqui se trabalha com Ponteiros para a localização do campo desejado. Sendo assim, o processamento desta instrução terá peso 1, mesmo que tenhamos 60 campos em nosso DataSet. Vamos voltar a conta que fizemos anteriormente:

100000 registros x 1 vez (Fields[indice]) = 100000 instruções processadas.


Olha que diferença entre executar 6000000 de instruções e 100000. Por isto digo, dentro de Loops envolvendo um campo de um DataSet com vários campos, pensem bem se vale a pena utilizar

valor := 0;
while not DataSet.Eof do
begin
  Valor := valor + DataSet.FieldByName('campo_valorado').asCurrency;
  DataSet.Next;
end;


ou

valor := 0;
while not DataSet.Eof do
begin
  Valor := valor + DataSet.Fields[60].asCurrency; //campo_valorado
  DataSet.Next;
end;


Querem algo para arrepiar os cabelos? Pensem em algo do tipo:

FieldByName('A').asInteger :=
((FieldByName('B').asInteger + FieldByName('C').asInteger)/ FieldByName('D').asInteger) * FieldByName('E')

Isto para 1000 registros, em um DataSet com 5 campos (algo bem pequeno) daria no pior caso:

1(A) x 2(B) x 3(C) x 4(D) x 5(E) x 100 = 120000 instruções processadas


Agora transportem esta situação para um DataSet com um pouco mais de campos e um pouco mais de registros. (Sai até um palavrão neste momento do pensamento de vocês, não sai?)


Observem que um comentário já torna o código mais claro. Não estou desaconselhando a utilização do FieldByName porém, temos que avaliar muito bem mesmo quando formos utilizar um simples método como este.