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

Fonte: www.activedelphi.com.br

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

Fonte: www.activedelphi.com.br

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;

Obter o MAC das placas de redes

Fonte: www.activedelphi.com.br

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

Fonte: www.activedelphi.com.br

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)

Fonte: www.activedelphi.com.br

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

Data por Extenso

Fonte: www.activedelphi.com.br

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

Fonte: www.activedelphi.com.br

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:\

Progresso de Transferência FTP com idFTP

Fonte: www.activedelphi.com.br

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;

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

Fonte: www.activedelphi.com.br

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

O artigo completo você pode visualizar no link: 

https://docs.google.com/fileview?id=0B0YypBtQL4eAYzA2NDRmYjQtN2MzZS00NzMzLWFjYTktYjBkMTY0ZTI3ZDVh&hl=pt_BR

Criando um gerador de senhas

Fonte: www.activedelphi.com.br

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!

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

Relatório em PDF usando o Delphi 2006

Fonte: www.activedelphi.com.br

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"

Validando endereços de e-mail

Fonte: www.activedelphi.com.br

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.

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'

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;

Desenvolvendo um Navegador

Fonte: www.activedelphi.com.br

istemas que não permitem ao usuário utilizar outros programas do computador enquanto estão sendo usados, e este precisa consultar algo na web, por exemplo
Obs.: É bom lembrar que sempre vale a pena salvar o projeto várias vezes durante o seu desenvolvimento.

Primeiro vamos criar a interface do navegador.

Inicie um novo projeto no delphi e altere as seguintes propriedades do formulário:
Caption: Navegador
Name: frmNavega
Width: 770

Insira um panel presente na guia Standard, alterando as propriedades:
Caption: apague todo o seu conteúdo
Align: AlTop

Insira no panel dois BitBtn presente na guia Addtional, e da mesma forma altere as suas seguintes propriedades:
BitBtn 1
Caption: apague todo o seu conteúdo
Name: btVoltar
Height: 25
Left: 8
Top: 8
Width: 33
Glyph: esta propriedade define a imagem de exibição do bitbtn. Geralmente ao instalar o delphi, ele copia uma serie de imagens para utilizarmos em nossas aplicações. Provavelmente elas estão instaladas no diretório: C:\Arquivos de programas\Arquivos comuns\Borland Shared\Images\Buttons. Neste exemplo, utilizaremos duas imagens presente nesta pasta, para isto selecione o botão [...]. Será exibida a caixa Picture Editor. Nela, clique em load e acesse a pasta Buttons do diretório acima. Nesta pasta selecione o item ARROW1L.

BitBtn 2
Caption: apague todo o seu conteúdo
Name: btAvancar (na propriedade name, não use caracteres de pontuação como o ‘ç’, o ‘´’)
Height: 25
Left: 48
Top: 8
Width: 33
Glyph: na mesma pasta usada para o botão anterior, selecione o item ARROW1R.

Insira no panel uma edit
Name: Endereco
Height: 21
Left: 88
Top: 10
Width: 505
Text: apague o seu conteúdo.

Insira mais dois BitBtn:
BitBtn 3
Caption: Parar
Name: btParar
Height: 25
Left: 600
Top: 8
Width: 75
Kind: esta propriedade tem uma função parecida com a Glyph, porém possui imagens pré-definidas. Selecione o item bkAbort.

BitBtn 4
Caption: Atualizar
Name: btAtualizar
Height: 25
Left: 680
Top: 8
Width: 75
Kind: bkRetry

Obs.: Ao utilizar a propriedade kind, o Delphi automaticamente altera o caption do BitBtn para o valor padrão do kind.

Por ultimo insira no form um componente WebBrowser, presente na guia Internet:
Align: alClient
Name: WebAgora vamos começar a codificar nosso navegador.

Primeiro, dê um duplo clique sobre o botão voltar e insira o seguinte código no evento:

  Web.GoBack;
Faça o mesmo para o botão avançar, só que agora com o código:

  Web.GoForward;
Para o botão parar:

  Web.Stop;
E para o botão atualizar:

  Web.Refresh;
No evento onTitleChange do componente web, insira o código:

  Caption := Text + ' - Navegador';
Esta linha define que, toda vez que o título da página for alterado, a propriedade caption do formulário será igual à propriedade text do componente web, mais ' - Navegador'.

No evento onDownloadComplete do componente web insira o código:

  Endereco.Text := web.LocationURL;
Este código faz com que o valor da edit endereco assuma o endereço da página atual. Caso não for usado, ao utilizar os botões voltar e avançar o endereço continuaria o mesmo do site que estava aberto.

No evento onkeyPress da edit endereco insira o código:

  if Key = #13 then
  begin
    Key := #0;
    web.Navigate(Endereco.Text);
  end;
Neste bloco de comandos verificamos se a variável Key possui valor igual a “#13” (código do ENTER). Em caso afirmativo, mudamos seu valor para “#0” a fim de evitar um bip desagradável e informamos à aplicação que o endereço de navegação está na propriedade text da edit endereco.

Obs.: O componente WebBrowser utiliza a mesma estrutura do internet explorer.

Retornando o Idioma Padrão do Sistema Operacional

Fonte: www.activedelphi.com.br

Você já precisou saber qual o idioma padrão do Windows em que seu programa está sendo executado? Se ainda não precisou, provavelmente precisará e esta dica vai lhe ajudar

function IdiomaPadrao: string;
var
  WinLanguage: array [0..50] of char;
begin
  VerLanguageName(GetSystemDefaultLangID, WinLanguage, 50);
  Result := StrPas(WinLanguage);
end;

Esta simples função faz chamada à respectiva função na API do Windows que retorna o idioma padrão configurado no computador. Para testá-la, basta colocar esta função na sua unit e no evento onClick de um botão, por exemplo, fazer:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Showmessage( IdiomaPadrao );
end;

Login Integrado ao Active Directory

Fonte: www.activedelphi.com.br

O Active Directory é um serviço da Microsoft, lançado no Windows 2000, que utiliza o protocolo LDAP para armazenar informações de usuários em uma determinada rede. Com ele, o administrador de redes tem todas as informações necessárias para controlar cada usuário da rede, como: nome, login e senha, bem como a criação de políticas de grupos de usuários.

Atualmente, há uma grande necessidade de se ter um login unificado dentro de uma organização, para que o usuário não tenha que ficar "decorando" login e senha de cada sistema e para que os desenvolvedores e o suporte técnico ganhem tempo, uma vez que não haverá mais tantos cadastros espalhados pela empresa. Sendo assim, vamos demonstrar neste artigo como integrar o login de sua aplicação no Active Directory.

Configure os componentes da seguinte forma:

Componente	Nome	Valor
TLabel	lblLogin	LOGIN
TLabel	lblUsuario	Usuário:
TLabel	lblSenha	Senha:
TEdit	edtUsuario
TEdit	edtSenha
TButton	btnLogin	Entrar

Primeiramente, vamos criar um novo projeto: File/New/VCL Forms Application - Delphi. Neste exemplo, criei uma tela básica de Login, como segue:

Configure os componentes da seguinte forma:

O Active Directory Service Interfaces (ADSI) nos dá uma interface COM para interagirmos com o Active Directory, portanto, vamos adicionar a unit ActiveX na uses list para utilizarmos esta interface.

Para que possamos validar o login e a senha do usuário, necessitamos utilizar uma interface requerida em objetos ADSI para capturar algumas propriedades e um método para comparar estas informações com os objetos do Active Directory. Para tanto, adicionemos em nossa aplicação as units ActiveDs_Tlb e Adshlp, as quais se encontram no final deste artigo, juntamente com o código fonte deste projeto-exemplo, não se esquecendo de adicioná-las também à aplicação.

Configure o evento onClick do btnLogin, como segue:

procedure TfrmLogin.btnLoginClick(Sender: TObject);
var
  adObject: IADs;
begin
  ///Inicialização do COM
  CoInitialize(nil);
  try
    ADsOpenObject('://',
                  LowerCase(edtUsuario.Text),
                  edtSenha.Text,
                  ADS_SECURE_AUTHENTICATION,
                  IADs,
                  adObject);
    ShowMessage('Login válido!');
  except
    on e: EOleException do
    begin
      if Pos('Falha de logon', e.Message) > 0 then
        ShowMessage('Login inválido!')
      else
        ShowMessage(e.Message);
    end;
  end;
  CoUninitialize;
end;
Como podemos ver, inicializamos o COM e depois utilizamos um método para comparação de nosso login e senha com os objetos do Active Directory. Neste método, passamos o provider WinNT ou LDAP, o nome do domínio da rede que estamos conectados, o login e senha que o usuário digitou, a forma de autenticação ao Active Directory, a interface e um objeto IADs que criamos localmente. Se houver erro nesta comparação, significa que o login e senha digitados não foram encontrados em nenhum objeto do Active Directory ou há algum problema na comunicação ou conectividade da rede.


Clique aqui para baixar o código fonte do exemplo (323 KB)