Є & V

Delphi - The action must be retried

2014-12-03T09:42:00.000-02:00

Ao fazer uma requisição SOAP, onde o tamanho de uma string enviada na requisição é muito grande, é gerada uma exceção do tipo "The action must be retried". Isso ocorre devido ao tamanho do blocksize que no Delphi é limitado a 32kB por padrão.

Uma solução não muito elegante para contornar esse problema, é aumentar o tamanho da propriedade MaxSinglePostSize do HTTPRIO.HTTPWebNode quando o evento HTTPRIOBeforeExecute for chamado:

procedure TForm1.HTTPRIOTotvsBeforeExecute(const MethodName: string;

  var SOAPRequest: WideString);

begin

  HTTPRIO.HTTPWebNode.MaxSinglePostSize := 999999999;

end;

Dessa forma, é possível enviar uma string longa na requisição SOAP.

Como Evitar Pegar Vírus e Bloquear Propagandas na Internet

2013-09-06T13:18:00.001-03:00

Tanto no Firefox, como no Google Chorme, você consegue instalar extensões que melhoram o navegador, como tradutores, dicionários, etc.
Existe uma extensão para os dois navegadores que se chama AdBlock Plus.

Essa extensão, bloqueia janelas pop-ups que abrem sem você clicar em neças, além de que, bloqueia scripts que possam conter link para vírus e Malwares e também bloqueai a maioria das propagandas em todos sites que você possa acessar. Usando essa ferramenta, evita em 90% a chance de ter o pc contaminados por pragas virtuais.

Para quem usa Firefox é só abrir o link e clicar em Download.
https://addons.mozilla.org/en-US/android/addon/adblock-plus/?src=category

Para quem usa Chorme, abrir o link abaixo e clicar em "Adicionar para Chrome".
https://chrome.google.com/webstore/detail/adblock-plus/cfhdojbkjhnklbpkdaibdccddilifddbO AdBlock Plus está disponível também para o firefox mobile no Android, e funciona da mesma forma que o desktop.

Delphi + Zeos: Não foi possível conectar ao Oracle 11g

2013-08-28T13:52:00.002-03:00

Depois de perder meu HD, tive que reinstalar todo meu ambiente de desenvolvimento, e no meio dele estava o Oracle. Depois reinstalar todos os softwares, fui compilar um projeto e pra minha surpresa, o Delphi mostrava a seguinte mensagem de erro em tempo de execução:

None of Dynamic library can be found: OCI.dll

No começo pensei que fosse algo com a zeos library (componente de acesso a dados), mas ao executar o aplicativo pelo windows, nenhum erro era gerado e o sistema funcionava normalmente.

Explorando o ambiente, encontrei a solução:

Com o Delphi aberto, acesse o menu Tools > Options...

E em Options, acesse a opção Envirionment Variables:

Em User Overrides, clique na variable PATH e em Edit...

Uma caixa para edição da variavel de ambiente irá aparecer. Observe que o diretório de instalação do Oracle não consta entre os demais diretórios.

O que precisamos fazer é adicionar o diretório de instalação do Oracle, separando-os com ponto e virgula:

;C:\app\Oracle;C:\app\Oracle\product\11.2.0\dbhome_1;C:\app\Oracle\product\11.2.0\dbhome_1\BIN

Pronto! Agora basta salvar clicar em ok e Compilar o projeto :)

Como mudar o idioma do NetBeans

2012-11-13T09:30:00.004-02:00

O Inglês é a linguagem mais usada para se comunicar no mundo todo. Também é a linguagem natural da programação, a maioria das linguagens de programação, tem suas declarações escritas em inglês. Então porque usar uma IDE traduzida para o português? Na minha opinião isso só atrapalha. A maioria dos exemplos e tutoriais disponíveis na web, estão em inglês. É muito muito mais pratico pesquisar uma mensagem de erro em inglês do que em Português.

Bem, para alterar o idioma do NetBeans, vá até o diretório de instalação, e abra a pasta "etc":

Nesta pasta, vai constar três arquivos. Localize e abra o arquivo netbeans.conf. Dentro do arquivo, procure pela linha que começa com netbeans_default_options:

Ao final dessa linha acrescente:

-J-Duser.language=en -J-Duser.region=US

Ficando:

netbeans_default_options="-J-client -J-Xss2m -J-Xms32m -J-XX:PermSize=32m -J-Dapple.laf.useScreenMenuBar=true -J-Dapple.awt.graphics.UseQuartz=true -J-Dsun.java2d.noddraw=true -J-Dsun.zip.disableMemoryMapping=true -J-Duser.language=en -J-Duser.region=US"

Salve o arquivo e abra o NetBeans com o novo idioma:

Este mesmo método pode ser usado para mudar para outros idiomas.

Milestone 3 XT860:Rom Steel Droid 4.5

2012-05-28T09:17:00.001-03:00

Conhecendo a ROM

A Motorola já avisou que o Milestone 3 esta fora dos planos de atualização para o ICE CREAM Sandwich,então nos, infelizes proprietários, ficaremos chupando dedo.

Mas graças à comunidade - viva o software livre! - nos podemos usar as custom roms. E uma das melhores disponíveis para o Milestone 3 é a Steel Droid. Esta rom é baseada na rom original do Droid 3, por isso, ela vem com android 2.3.7 e com o MotoBlur.

A rom permite uma grande customização na aparência do telefone graças ao Go-Lancher EX.

Dentre os efeitos legais do lanucher, esta a opção de desbloquear o aparelho apenas sacudindo. Também são varias as opções de scroller do desktop, como formato cubo e cilíndrico.

A barra de notificação traz os atalhos para as principais funções do aparelho como desligar e ligar o wifi, o brilho, bluetooth e dados moveis. destaque para o medidor de bateria, um circulo animado que se movimenta quando o aparelho esta carregando.

Pontos Negativos

A rom também tem alguns pontos negativos, como a saída HDMI que não funcionou. E da mesma forma que a rom Eclipse, a Steel Droid não suporta o idioma português, apenas o Espanhol e o inglês. Mas você pode, minimizar isso com o aplicativo MoreLocale, mas ele só traduz parte do sistema :

Também não ha como configurar o layout do teclado físico, que segue o padrão americano.

Falta ainda alguns aplicativos do Google como o youtube, gtalk, music, car-driver que já vem por padrão em outras roms. O uso da bateria ficou um pouco abaixo da rom eclipse, mas não houve muita diferença.

Instalação:

Baixe os arquivo de instalação da rom e salve em algum lugar no telefone, de preferencia na raiz do cartão da memória interna ou externa. Faça o mesmo para instalar o Google apps,

Se você usa a rom original da Motorola, siga esses passos para habilitar o root, necessário para instalar o Safestrap 2.0. Caso você já possui uma custom rom instalada com um bootstrap, remova-o e instale Safestrap 2.0. O Safestrap 2.0 é cheio de recursos e permite que você troque de rom facilmente e alem de reconhecer o cartão externo, onde pode você pode colocar o zip de instalação da rom.

A primeira coisa a se fazer é o backup dos aplicativo para que você não perca as suas configurações. Para isso, use o Titanium Backup, um poderoso gerenciador de backups para o Android. Na internet existem vários tutoriais de como usar o app. Para fazer backup de sms, pode-se usar o aplicativo sms backup restore.

Logo apos os backups, e de ter instado o Safestrap 2.0, reinicie o aparelho. Quando surgir o menu do boot aperte menu no teclado do celular e navegue nas opções com as teclas de volume e confirme com a tecla de desligar.

O primeiro paso é ir no menu wipe data factory reset. Aperte o botão de desligar para entrar no menu e nas opções, selecione yes. Assim que terminar o processo, acesse a opção wipe data cache partition e também confirme com yes.

Nesse ponto, já é possível iniciar a instalação da rom. Vá no menu install zip from sdcard e Internal sd-card se você colocou na memória interna do telefone ou External sdcard se você colocou no cartão. navegue ate o diretório onde esta o zip da rom, selecione-a e confirme.

O Safestrap 2.0 começara a instalação. Se você quiser instalar Google apps repita o processo acima, escolhendo o arquivo zip que você baixou. Ao final desta etapa, clique em go back para voltar ao menu raiz e em seguida reebot para reinicializar o aparelho.

A instalação leva de 5 a 6 minutos. No final um dialogo lhe ajudara a configurar o aparelho.

A rom traz um app para rádio que não é compativel com o Milestone 3, mas você pode instalar o Moto FM Radio que funciona bem.

Para usar o 3G é preciso configurar a apn. Acesse Menu ->Settingns-> Wireless & Network-> Mobile Network->Accsess Point Names-> Menu -> New Apn e preencha os campos de acordo com sua operadora:

TIM Dados

Name = TIM Dados

APN = tim.br

Proxy = Não definido

Port = Não definido

Username = tim

Password = tim

Server = Não definido

MMSC = Não definido

MMS proxy = Não definido

MMS port = Não definido

MCC = 724

MNC = 02

APN type = default

TIM MMS

Name = TIM MMS

APN = tim.br

Proxy = Não definido

Port = Não definido

Username = tim

Password = tim

Server = Não definido

MMSC = http://mms.tim.br

MMS proxy = 200.179.66.242

MMS port = 8080

MCC = 724

MNC = 04

APN type = mms

Claro Dados

Name = Claro Dados

APN = claro.com.br

Proxy = Não definido

Port = Não definido

Username = claro

Password = claro

Server = Não definido

MMSC = Não definido

MMS proxy = Não definido

MMS port = Não definido

MCC = 724

MNC = 05

APN type = default

Claro MMS

Name = Claro Foto

APN = mms.claro.com.br

Proxy = Não definido

Port = Não definido

Username = claro

Password = claro

Server = Não definido

MMSC = http://mms.claro.com.br

MMS proxy = 200.169.126.10

MMS port = 8799

MCC = 724

MNC = 05

APN type = mms

OI Dados

Nome = Oi Dados

APN = gprs.oi.com.br

Proxy = Não definido

Porta = Não definido

Usuário = oi

Senha = oi

Servidor = Não definido

MMSC = Não definido

Proxy de MMS = Não definido

Porta MMS = Não definido

MCC = 724

MNC = 31

Tipo autenticação = Não definido

Tipo APN = default

OI MMS

Nome = Oi MMS

APN = mmsgprs.oi.com.br

Proxy = Não definido

Porta = Não definido

Usuário = oimms

Senha = oimms

Servidor = Não definido

MMSC = http://200.222.42.204:8002

Proxy de MMS = 192.168.10.50

Porta MMS = 3128

MCC = 724

MNC = 31

Tipo autenticação = Não definido

Tipo APN = mms

Vivo Dados

Nome = VIVO Internet

APN = zap.vivo.com.br

Proxy = Não definido

Porta = Não definido

Usuário = vivo

Senha = vivo

Servidor = Não definido

MMSC = Não definido

Proxy de MMS = Não definido

Porta MMS = Não definido

MCC = 724

MNC = 10

Tipo autenticação = pap ou chap

Tipo APN = default

Vivo MMS

Nome = VIVO MMS

APN = mms.vivo.com.br

Proxy = Não definido

Porta = Não definido

Usuário = vivo

Senha = vivo

Servidor = Não definido

MMSC = http://termnat.vivomms.com.br:8088/mms

Proxy de MMS = 200.142.130.104

Porta MMS = 80

MCC = 724

MNC = 10

Tipo autenticação = pap ou chap

Tipo APN = mms

Chegamos ao final. Fique a vontade para personalizar sua rom com as dezenas de opções oferecidas e não deixe de comentar o que achou. =)

Eclipse - Waiting for xdebug session

2012-05-03T13:59:00.001-03:00

Nada pior que instalar o Eclipse PDT e na hora de debugar peceber que o eclipse nunca comleta a requisição pelo xdebug. Isso pode ocorrer por configuração errada do debug, no eclipse ou no arquivo php.ini ou xdebug.ini.

Para tentar resolver tente o seguinte:

1) Verifique se o xdebug está instalado (você usar o phpinfo() para verificar)
2) Verifique se não está editando o arquivo php.ini errado (você usar o phpinfo() para verificar)
3) Reinicie o apache
4) verifique se está usando o executável correto do php no Eclipse
5) Verifique se o xdebug está com as configurações corretas no Eclipse (porta, executável php,server)
6) Verifique se o path para a lib ou dll do xdegub está correto no php.ini
7) verifique se a opção xdebug.remote_enable está ativa no php.ini

Como referencia para seu teste, pode usar este arquivo de configuração que funciona bem no windows com o wamp e no Linux:

zend_extension = "c:/wamp/bin/php/php5.3.10/zend_ext/php_xdebug-2.1.2-5.3-vc9.dll"

[xdebug]
xdebug.remote_enable = On
xdebug.profiler_enable = off
xdebug.profiler_enable_trigger = off
xdebug.profiler_output_name = cachegrind.out.%t.%p
xdebug.profiler_output_dir = "c:/wamp/tmp"

; General
xdebug.show_local_vars=On
xdebug.dump.SERVER=HTTP_HOST, SERVER_NAME
xdebug.dump_globals=On
xdebug.collect_params=4
xdebug.auto_trace=off
xdebug.collect_includes=on
xdebug.collect_return=off
xdebug.default_enable=on
xdebug.extended_info=1
xdebug.manual_url=http://www.php.net
xdebug.show_mem_delta=1
xdebug.max_nesting_level=100
xdebug.idekey=xdebug
xdebug.collect_params = On
xdebug.collect_vars = On
xdebug.dump_globals = On

; Trace options
xdebug.trace_format=0
xdebug.trace_output_dir=/tmp/xdebug/trace
xdebug.trace_options=0
xdebug.trace_output_name=tracelog

; mostra retornos GET do browser
xdebug.dump.GET=*
;mostra retornos do campos username e password
xdebug.dump.POST=username,password

Delphi - Exibindo diálogos no estilo jquery

2012-04-24T13:12:00.001-03:00

O jquery é um Framework Javascript que facilita o trabalho do desenvolvedor web. Uma dessas funcionalidades é a opção de exibir um dialogo modal em uma página web:

Graças a duas propriedades inseridas no Delphi 2006, nos podemos criar esse efeito nas nossas aplicações. São elas:AlphaBlend e AlphaBlendValue.

AlphaBlend define se a propriedade estará ativada e AlphaBlendValue define o nível de opacidade que se deseja usar.

Vamos criar uma aplicação de teste. Abra o Delphi e crie uma nova aplicação.
Agora adicione um novo formulário e
Ative a propriedade AlphaBlend e coloque 200 na propriedade AlphaBlendValue.
Mude a cor de fundo do formulário para clBlack.
Retire as bordas do formulário na propriedade BorderStyle colocando bsNone.
Em Positition coloque poOwnerFormCenter.
e WidowsState deixe como wsMaximized.

Adicione uma propriedade do tipo Form ao formulário:

type
  TFrmDestaque = class(TForm)
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
        Formulario: TForm;
  end;

No evento OnActivate digite o código:

procedure TFrmDestaque.FormActivate(Sender: TObject);
begin
 Formulario.ShowModal;
 PostMessage(Handle, WM_CLOSE, 0, 0);//Fecha o formulário
end;

Salve o formulário com o nome de FrmDestaque.

Crie um terceiro formulário como abaixo e salve como FrmDialogo:

Não esqueça de retirar os formulário da opção de autocreate do Delphi:

Agora no formulário principal adicione a função:

procedure DestacarForm(frmOwner ,frmDestaque :TForm );
var
  frmTransparente   : TFrmDestaque;
begin
   frmTransparente := TFrmDestaque.Create(nil);
   try
     frmTransparente.ClientHeight := frmOwner.ClientHeight;
     frmTransparente.ClientWidth := frmOwner.ClientWidth;
     frmTransparente.Formulario := frmDestaque;
     frmTransparente.ShowModal;
     frmTransparente.Formulario := nil;
   finally
     frmTransparente.Free;
   end;
end;

Coloque um botão e no Onclick chame a função destaque:

procedure TFrmPrincipal.btn1Click(Sender: TObject);
begin
  frmDialogo := TFrmDialogo.Create(self);
  try
     DestacarForm(Self,frmDialogo);
  finally
     frmDialogo.Free;
  end;
end;

Execute a aplicação e click no botão:

Agora é só chamar a função "DestacarForm" para qualquer formulário que você deseja destacar.

jQueryUI - Cahe Auto Complete com Jsonu

2012-04-05T10:14:00.000-03:00

A jQuery é um framework fantástico, utilizada por várias empresas no mundo e pelas gigantes da internet. E em complemento a jQuery, existe a biblioteca jQueryUI que possui widgets que facilitam o desenvolvimento de aplicações web. Um desses o widget é o "autocomplete" que ajuda o usuário dando sugestões de tags, termos entre outros.

O autocomplete pode ser alimentado por array de termos , uma página php,jsp,asp, etc ou por um webservise. O exemplo abaixo é uam modificação da documentação do jQueryUI.

Aqui ele faz uma requisição ajax ao geonames.org webservice que retorna um arquivo json. Esse arquivo é tratado e repassado ao widget. A cada consulta realizada ele armazena em cache, os termos retornados:

 


 
  
  jQueryUI - Auto Complete
  
  
  
  
  
  
   
   
   
   
   
   
  
  
  
 
   
  
   Digite o nome de uma cidade

ACBR Exibindo o MD5 No campo de Informações Complementares do Danfe

2012-03-09T11:01:00.000-03:00

Para Exibir o MD5 do PAF-ECF no campo de informações complementares do Danfe no componente ACBR é muito simples, basta informar na propriedade InfAdic da Nfe.

ACBrNFe1.NotasFiscais.Items[0].NFe.InfAdic.infAdFisco := MD5;

Veja no exemplo abaixo:

var

  Nfe: string;

begin

  Nfe := DirNFeXMLs + '\' + 
Numero  + '.xml';



  if not FileExists(Nfe) then

    raise Exception.Create('XML da Nota não encontrado');



  ACBrNFe1.NotasFiscais.Clear;

  ACBrNFe1.NotasFiscais.LoadFromFile(Nfe);

  if ACBrNFe1.NotasFiscais.Items[0].NFe.Ide.tpEmis = teDPEC then

  begin

    ACBrNFe1.WebServices.ConsultaDPEC.NFeChave := ACBrNFe1.NotasFiscais.Items[0].NFe.infNFe.ID;

    ACBrNFe1.WebServices.ConsultaDPEC.Executar;

    ACBrNFe1.DANFE.ProtocoloNFe := ACBrNFe1.WebServices.ConsultaDPEC.nRegDPEC + ' ' + DateTimeToStr(ACBrNFe1.WebServices.ConsultaDPEC.dhRegDPEC);

  end;

  ACBrNFe1.NotasFiscais.Items[0].NFe.InfAdic.infAdFisco := 
MD5 ;

  ACBrNFe1.NotasFiscais.Imprimir;



end;

E a impressão no Danfe:

Preparando o Mint/Ubuntu para desenvolver com Pyqt4

2012-02-26T11:09:00.001-03:00

Instalando o PyQt4 no Linux Mint/Ubuntu

Introdução

O PyQt4 é mais uma alternativa para desenvolver aplicações desktop com interface gráfica amigável ao usuário. Suporta Linux e outros sistemas Unix, bem como Mac OS X e Microsoft Windows.

O PyQt é desenvolvido por British firm Riverbank Computing e está disponível sob termos similares aos Qt 4,5. Isto significa uma variedade de licenças, incluindo GNU General Public License (GPL) e licença comercial, mas não o GNU Lesser General Public License (LGPL).

A melhor versão do Python atualmente para se trabalhar com PyQt4 é a 2.7 devido a algumas questões de compatibilidade, mas nada impede de se a usar uma versão acima desta.

Neste tutorial foi usado o Linux Mint 12 com Kde 4.8 rodando sobre o kernel 3.0.0-16-generic em um hardware com processador intel pentium(R) dual CPU @240 Ghz com 4 Gb DDR 3.

Instalando o Python 2.7

Geralmente as distribuições Linux já trazem o Python instalado por padrão, você pode verificar a versão do python com o comando:

evaldo@TUX ~ $ python -vV

Python 2.7.2+

Se você não possuir a versão 2.7 pode instala-la assim:

TUX evaldo # aptitude install python2.7

Instalando as dependências

Com o Python instado, agora precisamos instalar as dependias do PyQt4:

TUX evaldo # aptitude install python-pip python2.7-dev libxext-dev python-qt4 qt4-dev-tools build-essential qt4-designer qt4-dev-tools libqt4-dev ibXext

Instando o PyQt4

Vá no site http://www.riverbankcomputing.co.uk/software/pyqt/download e baixe a última versão do PyQt4 e do Sip. (SIP é uma ferramenta de software de código aberto usado para conectar programas de computador ou bibliotecas escritas em C ou C + + com a linguagem Python).

Descompacte os arquivos em algum diretório:

TUX python # tar -xvf PyQt-x11-gpl-4.9.1.tar.gz

TUX python # tar -xvf sip-4.13.2.tar.gz

Precisamos instalar primeiro o sip. Entre o diretório onde foi descompactado o arquivo:

TUX python # cd sip-4.13.2/

Se você tiver mais de uma versão do python instalada, especifique com qual versão quer compilar com o seguinte comando:

TUX sip-4.13.2 # python2.7 configure.py ; make ; make install

A instalação do sip é rápido pouco mais de 30~60 segundos dependendo do seu pc.

Após instalar o sip podemos instalar o PyQt4. Acesse o diretório onde descompactou o arquivo e execute o mesmo comando acima:

TUX sip-4.13.2 # cd ../PyQt-x11-gpl-4.9.1/

TUX sip-4.13.2 # python2.7 configure.py ; make ; make install

A instalação do PyQt4 leva em torno de 40 minutos então pode deixar rodando e ir tomar um café :)

Rodando um teste

Para comprovar que o PyQt4 foi instalado podemos rodar rodar um teste. Salve o codigo abaixo como teste.py:

  
#!/usr/bin/python

# teste.py

import sys
from PyQt4 import QtGui

app = QtGui.QApplication(sys.argv)

widget = QtGui.QWidget()
widget.resize(250, 150)
widget.setWindowTitle('simple')
widget.show()

sys.exit(app.exec_())

Agora execute:
evaldo@TUX ~ $ chmod +x teste.py
evaldo@TUX ~ $ ./teste.py

Resultado:

A documentação do PyQt4 pode ser encontrada aqui .

Rom Eclipse no Milestone 3/Droid 3 (XT860) - Parte 1

2012-01-30T13:22:00.001-02:00

Rom Eclipse no Milestone 3/Droid 3 (XT860)

Parte 1 - Conhecendo a Rom

Roms customizadas são o melhor do mundo Android, assim como as distribuições são no mundo linux, onde você é livre para escolher a distribuição que mais se adequá a você. Além do que, usando Roms customizadas você não precisa ficar esperando atualização de operadora e boa vontade dos fabricantes para usar una versão do Android mais atual. Nesse cenário a rom Eclipse é uma das melhores para se instalar. Combinando elegância e simplicidade com muita leveza, deixa o telefone mais agradável de usar:

Baseada no Android 2.3.4, o Eclipse roda muito bem no Motorola Miletone 3, apesar de não ser suportada oficialmente pelos desenvolvedores:

A versão do Android que veio no Milestone 3 que adquiri foi a 2.3.4 da Vivo. Nessa rom, lotada de aplicativos inúteis de operadora e com o motoblur, a bateria durava cerca de 14 hrs. Com o Eclipse está durando de 24 a 30 horas! (Usando o wifi cerca de 30 minutos por dia, rádio FM 1h30 e sem usar a internet móvel).

O Eclipse é simplesmente rápido, nem foi preciso fazer overclock no processador. Todos os aplicativos rodam bem no aparelho, inclusive a renderização de paginas web no navegador:

O Eclipse proporciona um acesso rápido e fácil aos controles do sistema ao disponibilizar os botões na barra de notificação. O que não acontece na rom oficial da Motorola. Basta deslizar a barra para baixo:

Também há um widget para a área de trabalho:

Uma das coisa que a valem a pena a instalação dessa rom é a galeria de imagens que tem efeitos muito legais:

O Eclipse também traz belos papeis de parede além dos papeis de pardes padrão do Android:

Alem dos aplicativos tradicionais do Android o eclipse traz instalado o Google Music e o Car Home

Uma coisa que talvez poderia ser um problema para alguns usuários Brasileiros é que o eclipse não suporta o idioma Português, apenas o Espanhol e o Inglês.

Podemos minimizar isso com o app MoreLocale, mas ele só traduz parte do sistema :

Gostou? Então baixe os arquivos necessários para instalar o Eclipse:
SuperOneClick v2.3.3: Habilita o Usuário Root no Android de maneira muito simples.
Fastboot package for UMTS XT860 Retail Brasil - Android 2.3.5 : O ClockworkMod será instalado sobre essa versão do Android.
RSD Lite 5.5 : Instala a rom no telefone
Eclipse 2.0 : Eclipse Rom
Bionic ClockworkMod Recovery/Bootstrap: Para fazer backup / restore e instalar ROMs
Moto FM Radio: Aplicativo para funcionar o rádio FM que não vem por padrão na rom

Faça o Download dos arquivos e no próximo post vamos iniciar a preparação. Todo o processo leva em torno de 30 minutos. Você ira precisar também de um cartão de memória, onde sera colocada a rom. Se seu Milestone não veio com cartão arranje um.

Rom Eclipse no Milestone 3/Droid 3 (XT860) - Parte 2

2012-01-30T13:20:00.001-02:00

Rom Eclipse no Milestone 3/Droid 3 (XT860)

Parte 2 - Habilitando o Root

Faça este hack por sua conta e responsabilidade, esteja ciente que fazendo isso você estará perdendo a garantia do seu aparelho. O processo funcionou muito bem para mim, mas pode não funcionar para você.

Antes de iniciar, talvez você queira fazer backup das suas apps para restaurar na nova rom. Isso é perfeitamente possível graças ao Titanium Backup! Existem dezenas de tutoriais pela web ensinado o procedimento. Mas antes é preciso habilitar o root no telefone.

Para o hack funcionar é preciso que o Motorola USB Driver esteja atualizado. Faça a atualização antes de continuar o processo.

O aplicativo SuperOneClick v2.3.3 faz todo o trabalho para nos. Para isso precisamos apenas habilitar a opção de o Usb Debugging no sistema. Acesse Menu -> Configurações -> Aplicativos -> Desenvolvimento e marque a opção Depuração USB.

Feito isso, conecte o telefone ao computador pelo cabo usb no modo de carregar a bateria - Nenhum, abra o SuperOneClick v2.3.3 e clique em root. O telefone vai reiniciar durante o processo:

Ao final responda sim as duas perguntas:

A parti daqui o root já está habilitado e você já pode instalar o Titanium Backup e realizar o backup da suas aplicações:

Na próxima estapa vamos prepara o ambiente para instalar o Eclipse.

Rom Eclipse no Milestone 3/Droid 3 (XT860) - Parte 3

2012-01-30T13:19:00.000-02:00

Rom Eclipse no Milestone 3/Droid 3 (XT860)

Parte 3 - Preparando o Ambiente

Não se esqueça de fazer backup dos seus arquivos no pc, pois eles podem ser perdidos! Verifique também a carga da bateria, se estiver abaixo de 60%, recarregue-a antes de iniciar o processo, pois o telefone vai precisar realizar algum processamento e isso consome energia.

O primeiro passo é plugar o telefone no cabo USB (No modo de carregar a bateria - Nenhum ) e conecta-lo ao pc (Esse hack foi feito no windows 7).

Com o telefone plugado, abra o RSD Lite. Ele irá reconhecer o telefone conectado:

Agora vamos instalar a rom Fastboot package for UMTS XT860 Retail Brasil - Android 2.3.5 que você baixou. Clique no botão ao lado do campo Filename e procure pelo arquivo. O nome padrão é p2b_solana_umts_solana_retail_br-user-2.3.5-5.5.1-112_SLU-39M-110926-release-keys-Brasil-BR.xml.zip.

Não descompacte este arquivo, prefira que o RSD Lite faça isso para você. Clique em Uncompress And Start Flashing para iniciar:

Ao terminar de enviar os arquivos o RSD Lite 5.5 vai reiniciar o telefone:

Neste momento, a rom começara a ser instalada. Isso leva em torno de 5~6 minutos:

Quando o telefone voltar ele já estará pronto para podermos continuar:

Se tudo ocorrer bem o RSD Lite 5.5 vai exibir a mensagem de Finished

Terminado essa parte, copie o Eclipse 2.0 para a raiz do cartão de memória:

Na próxima etapa vamos instalar o Bionic ClockworkMod Recovery/Bootstrap.

Rom Eclipse no Milestone 3/Droid 3 (XT860) - Parte 4

2012-01-30T13:17:00.002-02:00

Rom Eclipse no Milestone 3/Droid 3 (XT860)

Parte 4 - Bootstrap Recovery

Depois de instalar o Fastboot package for UMTS XT860 Retail Brasil - Android 2.3.5 precisamos habilitar o root para podermos instalar o Bootstrap Recovery .

Vamos usar o SuperOneClick v2.3.3 novamente. Precisamos apenas habilitar a opção de o Usb Debugging no sistema. Acesse Menu -> Configurações -> Aplicativos -> Desenvolvimento e marque a opção Depuração USB.

Feito isso, conecte o telefone ao computador pelo cabo usb no modo de carregar a bateria - Nenhum, abra o SuperOneClick v2.3.3 e clique em root. O telefone vai reiniciar durante o processo:

Ao final responda sim as duas perguntas:

A parti daqui o root já está habilitado e podemos instalar o Bootstrap Recovery :

Habilite a opção de instalar aplicativos de fontes desconhecidas: Acesse Menu -> Configurações -> Aplicativos.

Coloque o Bootstrap Recovery em algum lugar do seu cartão de memória (crie uma pasta app por exemplo ) e em seguida instale-o. Ao abrir o app instalado você vera seguinte tela.

Clique em "Boot Strap Recovery" e dê a permissão de root para o app executar:

Ao termino da execução uma mensagem de sucesso será exibida:

Na próxima etapavamos instalar o eclipse.

Rom Eclipse no Milestone 3/Droid 3 (XT860) - Parte 5

2012-01-30T13:16:00.000-02:00

Rom Eclipse no Milestone 3/Droid 3 (XT860)

Parte 5 - Instalando o Eclipse

Se você já tiver copiado o Eclipse 2.0 para a raiz do cartão de memória estaremos prontos para iniciar a instalação.
Novamente no Bootstrap Recovery, Clique em "Reboot Recovery":

O telefone irá reiniciar com a seguinte tela:

Usando as teclas de volume, escolha a opção “wipe data/factory reset” (espero que tenha feito backup, pois isso aga todos os arquivos no telefone) e aperte o botão de ligar/desligar para confirmar. Agora procure pelo “Yes” no meio dos "NO" e aperte o botão de ligar/desligar para confirmar.

Feito isso, vá até "go-back" e retorne ao menu anterior. Navegue até a opção “install zip from sdcard” depois em “choose zip from sdcard” e procure pela rom do Eclipse e aperte o botão de ligar/desligar para confirmar. Nesse momento a instalação do Eclipse vai começar, isso pode levar de 5~6 minutos.

Quanto terminar escolha a opção "power-off" para desligar o telefone. Assim que o telefone desligar, desconecte o cabo usb e em seguida segure ao mesmo tempo os dois botões de volume e ligue o aparelho. Você vai cair na tela de boot de telefone.

Com o botão de aumentar volume, escolha "Recovery Mode" e com o botão de diminuir volume, confirme:

O Telefone vai iniciar e parar aqui:

Aperte ao mesmo tempo os dois botões de volume para exibir o menu:

Selecione “wipe data/factory reset” e aguarde... Depois “reboot system now”

O telefone vai demorar um pouco para iniciar:

Se você visualizar a seguinte tela parabéns! O Eclipse esta instalado!

Agora toque no robozinho para iniciar a configuração do sistema! Uma assistente lhe ajudará no processo.

Na próxima etapa vamos para as configurações finais

Rom Eclipse no Milestone 3/Droid 3 (XT860) - Parte 6

2012-01-30T13:13:00.000-02:00

Rom Eclipse no Milestone 3/Droid 3 (XT860)

Parte 6 - Configurando o Eclipse

Depois do contato inicial com a rom é hora de configurar algumas coisas básicas e restuarar o backup dos apps.

O Eclipse já traz o root habilitado, então você pode restaurar seus backups sem problemas, basta instalar o Titanium Backup! Existem dezenas de tutoriais pela web ensinado o procedimento.

Para usar o rádio é preciso instalar o app Moto FM Radio. Coloque o apk em algum diretório e instale:

Para usar o 3G é preciso configurar as apn. Acesse Menu ->Settingns-> Wireless & Network-> Mobile Netowoek->Accsess Point Names-> Menu -> New Apn e preencha os campos de acordo com sua operadora:

TIM Dados

Name = TIM Dados

APN = tim.br

Proxy = Não definido

Port = Não definido

Username = tim

Password = tim

Server = Não definido

MMSC = Não definido

MMS proxy = Não definido

MMS port = Não definido

MCC = 724

MNC = 02

APN type = default

TIM MMS

Name = TIM MMS

APN = tim.br

Proxy = Não definido

Port = Não definido

Username = tim

Password = tim

Server = Não definido

MMSC = http://mms.tim.br

MMS proxy = 200.179.66.242

MMS port = 8080

MCC = 724

MNC = 04

APN type = mms

Claro Dados

Name = Claro Dados

APN = claro.com.br

Proxy = Não definido

Port = Não definido

Username = claro

Password = claro

Server = Não definido

MMSC = Não definido

MMS proxy = Não definido

MMS port = Não definido

MCC = 724

MNC = 05

APN type = default

Claro MMS

Name = Claro Foto

APN = mms.claro.com.br

Proxy = Não definido

Port = Não definido

Username = claro

Password = claro

Server = Não definido

MMSC = http://mms.claro.com.br

MMS proxy = 200.169.126.10

MMS port = 8799

MCC = 724

MNC = 05

APN type = mms

OI Dados

Nome = Oi Dados

APN = gprs.oi.com.br

Proxy = Não definido

Porta = Não definido

Usuário = oi

Senha = oi

Servidor = Não definido

MMSC = Não definido

Proxy de MMS = Não definido

Porta MMS = Não definido

MCC = 724

MNC = 31

Tipo autenticação = Não definido

Tipo APN = default

OI MMS

Nome = Oi MMS

APN = mmsgprs.oi.com.br

Proxy = Não definido

Porta = Não definido

Usuário = oimms

Senha = oimms

Servidor = Não definido

MMSC = http://200.222.42.204:8002

Proxy de MMS = 192.168.10.50

Porta MMS = 3128

MCC = 724

MNC = 31

Tipo autenticação = Não definido

Tipo APN = mms

Vivo Dados

Nome = VIVO Internet

APN = zap.vivo.com.br

Proxy = Não definido

Porta = Não definido

Usuário = vivo

Senha = vivo

Servidor = Não definido

MMSC = Não definido

Proxy de MMS = Não definido

Porta MMS = Não definido

MCC = 724

MNC = 10

Tipo autenticação = pap ou chap

Tipo APN = default

Vivo MMS

Nome = VIVO MMS

APN = mms.vivo.com.br

Proxy = Não definido

Porta = Não definido

Usuário = vivo

Senha = vivo

Servidor = Não definido

MMSC = http://termnat.vivomms.com.br:8088/mms

Proxy de MMS = 200.142.130.104

Porta MMS = 80

MCC = 724

MNC = 10

Tipo autenticação = pap ou chap

Tipo APN = mms

Então é isso! Você agora é livre! Não depende mais da Motorola para usar uma rom leve e bonita. Com o tempo você vera que vale a pena usar o Eclipse, você ganhará em performance e bateria além de aprender Inglês :).

Obrigado por ler este tutorial, deixe nos comentários a sua opinião sobre Eclipse.

Referencias:
http://droidbionicroot.com/droid-bionic-hacks/how-to-install-clockworkmod-recoverybootstrap-on-the-droid-bionic/
http://droidmodderx.com/bionic/234-2/
http://forum.xda-developers.com/showthread.php?t=1384676

Python: Download File from web

2011-09-21T11:36:00.004-03:00

Baixando um arquivo com pyhon de uma servidor web que requer controle por cookie.

Como exemplo vamos baixar o arquivo com todos os resultados da mega sena

'''
Created on 20/09/2011

@author: Evaldo
'''
import cookielib,urllib2,urllib

class Downloads(object):
    '''
    classdocs
    '''
 
    def FileFromUrl(self,url, localFileName = None):        
        ''' Realiza a requisição'''

        request = urllib2.Request( url)
        response = urllib2.urlopen( request )    
               
        ''' Salvar o arquivo'''
        output = open(localFileName,'wb')
        output.write(response.read())
        output.close()


    def __init__(self):
        '''
        Define o cookie para a conexao
        '''
        self._logged_in = False
        self._cookies = cookielib.CookieJar()
        self._opener = urllib2.build_opener(urllib2.HTTPCookieProcessor(self._cookies))
        urllib2.install_opener(self._opener)
      
if __name__ == '__main__':
    try:
        print 'Baixando' 
        d = Downloads()
        d.FileFromUrl('http://www1.caixa.gov.br/loterias/_arquivos/loterias/D_megase.zip','m.zip')
        print 'Concluido'
    except Exception as e:
        print 'Erro' , e

Se você precisar passar algum parâmetro no cookie pode faze-lo assim

'''
Created on 20/09/2011

@author: Evaldo
'''
import cookielib,urllib2,urllib

class Downloads(object):
    '''
    classdocs
    '''
 
    def FileFromUrl(self,url, localFileName = None):        
        
       '''Parametros do cookie'''
        post = urllib.urlencode({"security" : "false"})

        ''' Realiza a requisição''' 
        request = urllib2.Request( url, post)
response = urllib2.urlopen( request )    
               
        ''' Salvar o arquivo'''
        output = open(localFileName,'wb')
        output.write(response.read())
        output.close()


    def __init__(self):
        '''
        Define o cookie para a conexao
        '''
        self._logged_in = False
        self._cookies = cookielib.CookieJar()
        self._opener = urllib2.build_opener(urllib2.HTTPCookieProcessor(self._cookies))
        urllib2.install_opener(self._opener)
      
if __name__ == '__main__':
    try:
        print 'Baixando' 
        d = Downloads()
        d.FileFromUrl('http://www1.caixa.gov.br/loterias/_arquivos/loterias/D_megase.zip','m.zip')
        print 'Concluido'
    except Exception as e:
        print 'Erro' , e

Isso também resolve o erro gerado pela urllib2:

HTTP Error 302: The HTTP server returned a redirect error tha t would lead to an infinite loop.

Desenvolvimento de sistemas de Informação nas organizações

2011-08-26T18:54:00.002-03:00

INTRODUÇÃO

O mundo atual é totalmente dependente de sistemas de software em todos os ramos da sociedade. O funcionamento efetivo da economia e da política modernas estão intimamente ligados a nossa capacidade, enquanto desenvolvedores, de criar softwares de qualidade. O desenvolvimento de sistemas constitui a atividade de criação ou de modificação de uma sistemática de negócio já existente, que abrange desde a identificação de problemas ou oportunidades a serem solucionados até o aproveitamento da implementação e do refinamento da solução escolhida. Isto afeta todos os aspectos do desenvolvimento do projeto, utilizando modelos para os processos e metodologias de desenvolvimento.

A combinação de partes coordenadas, de modo que concorram para a realização de um conjunto de objetivos é um sistema.

Neste projeto, iremos apresentar algumas considerações sobre o objetivo da utilização e desenvolvimento dos Sistemas de Informação nas Organizações, exibindo informações sobre as necessidades do desenvolvimento e utilização dos sistemas, os objetivos totais do sistema, o ambiente do sistema, recursos, componentes e administração do sistema.

FUNDAMENTAÇÃO TEÓRICA

1.1 Organização Empresarial no Contexto de um SI

2.1.1 Vantagens para a Organização

A transformação dos dados em informação é a principal função de um SI. Dentro de uma orientação de SI, os dados se tornam informação quando são a base sobre a qual possam ser tomada decisões eficientes e eficazes. A informação é usada para aumentar a probabilidade de que a decisão correta seja tomada. No contexto empresarial, o SI orienta a tomada de decisão nos 3 diferentes níveis: operacional, tático e estratégico. A informação deve ser recebida em tempo hábil para proporcionar as representações desejadas. Pode ser que haja informações que não são mais necessárias após certo tempo.

Em uma empresa, os sistemas se desenvolvem em 2 dimensões:

Vertical: componentes da empresa.

Horizontal: níveis de decisão na empresa.

Nível Estratégico: gerência de alto nível e planejamento a longo prazo pela organização. Decisões estratégicas: ocorrem nos altos escalões da empresa, geram atos cujos efeitos são duradouros e difíceis de serem modificadas.

Presidente da companhia de petróleo: que novas fontes nossa companhia pode utilizar? Deveríamos desenvolver linhas alternativas em nossas negociações

para ficarmos menos dependentes do setor de energia?

Secretário de Estado: que tipo de aliança produzirá melhores resultados, assegurando uma defesa forte contra nossos concorrentes? O que significa o último movimento militar no país X em termos de estratégia global?

Informações para planejamento estratégico e alto controle, são obtidas dos outros níveis de tomada de decisão.

Nível tático: supervisão e planejamento de atividades rotineiras (atividades de gerência por um determinado período).

Decisões táticas: ocorrem nos escalões intermediários da empresa e geram atos de efeito a prazo mais curto, tendo menos impacto no funcionamento da empresa.

Nível Operacional: atividades de trabalho ou tarefas de rotina da organização.

Decisões operacionais: ligadas ao controle operacional da empresa, visando alcançar os padrões de funcionamento pré-estabelecidos.

2.1.2 Processo de Software nas Organizações

Um processo de software é um conjunto de atividades e resultados associados que geram um produto de software. Essas atividades são, em sua maioria, executadas por desenvolvedores sistemas.

Há 4 atividades fundamentais no processo de software:

1. Especificação do Software – definição de requisitos e análise de requisitos – a funcionalidade do software e as restrições em sua operação devem ser definidas.

2. Desenvolvimento do Software – projeto e implementação - o software deve ser produzido de modo que atenda a suas especificações.

3. Validação do software – integração e teste - o software tem de ser validado para garantir que ele faz o que o cliente deseja.

4. Evolução do software – o software deve evoluir para atender às necessidades mutáveis do cliente.

2.1.3 Organização

É uma estrutura social estável e formal que retira recursos do ambiente e os processa para processa para produzir resultados. Essa definição foca três elementos: capital e trabalho são os fatores primários de produção fornecidos pelo ambiente. A organização

(empresa) transforma essas entradas em produtos e serviços por meio de uma função de produção. Os produtos e serviços são consumidos pelos ambientes, que os devolvem como entradas de suprimento.

Características Estruturais de todas as Organizações: clara divisão de trabalho, hierarquia, regras e procedimentos explícitos, julgamentos imparciais, qualificações técnicas para cargos, máxima eficiência organizacional.

As organizações podem influenciar o uso de tecnologia de informação (TI)de diversas maneiras:

a) por meio de decisões sobre as configurações técnicas e organizacionais dos sistemas.

b) Pelas decisões sobre quem irá projetar, montar e manter a sua infra-estrutura de TI – essas decisões determinam como os serviços de TI serão entregues.

Departamento de Sistemas de Informação – é o responsável pelos serviços tecnológicos – manutenção de equipamentos (hardware), programas (software), armazenagem de dados e redes que compreendem a infra-estrutura de TI da empresa. Esse departamento é composto por especialistas como: programadores, analistas de sistemas, lideres de projeto, gerentes de

SI. Muitas empresas têm um executivo-chefe de informática no comando de um departamento de SI.

Usuários finais – são representantes de departamentos externos ao grupo de sistemas de informação para quem as aplicações são desenvolvidas.

Há dois tipos de Organização:

a) Informal: surge naturalmente como fruto da interação social dos seus membros. Podem existir muitas dentro da empresa. A liderança está ligada mais às qualidades pessoais do indivíduo do que à posição hierárquica dentro da empresa.

b) Formal Estrutura Organizacional é concebida como o agrupamento das atividades necessárias para realizar objetivos e planos, a atribuição dessas atividades e setores especializados, a delegação e coordenação da autoridade.

2.1.4 Recursos envolvidos no desenvolvimento de SI nas organizações

Todos os sistemas têm ciclo de vida bem definido, ou seja, todos eles passam pelos estágios de:

• Concepção: enfoca a questão “o que?” – o que é o sistema.

Engloba: análise do sistema

Planejamento do projeto de software

Análise de requisitos

• Desenvolvimento: enfoca a questão “como” – como implementar o sistema

Engloba: projeto de software

Codificação

Testes

• Manutenção: enfoca “mudanças” – no sistema e no ambiente

Engloba: correção

Adaptação

Expansão

3- Desenvolvimento

3.1 - Ferramenta Case

3.1.1 – Surgimento

Na década de 1950, um grupo de engenheiros mecânicos e elétricos utilizavam ferramentas manuais rudimentares na elaboração de seus projetos, como calculadoras mecânicas, réguas de cálculo, lápis, entre outros. Uma década após, esse grupo começou a experimentar a engenharia baseada em computador, mas ainda com a relutância de alguns membros. Já na década de 1970, todos as fórmulas matemáticas e algoritmos de que o engenheiro necessitava estavam num grande conjunto de programas de computador, onde se tornou inevitável a adoção de tais ferramentas por essas pessoas, atraídas pela eficiência de seus resultados. Assim nasceram as Ferramentas CAD (Computer - Aided Design), utilizadas até hoje no campo da engenharia. Ainda na mesma década, uma variante dessas ferramentas emergiria para abalar o processo de desenvolvimento de software. As ferramentas CASE (Computer-Aided Software Engineering), como foram denominadas, tinham como objetivo automatizar atividades manuais pré-codificação, como Diagramas de Entidade-Relacionamento(DER) e Diagramas de fluxo de dados (DFD).

3.1.2 – Características

Uma ferramenta case possui como base as seguintes características:

- Armazenamento não redundante de objetos do projeto.

- Acesso de alto nível.

- Independência dos dados físicos.

- Controlo de transações.

- Segurança.

- Consultas e relatórios ad-hoc.

- Mecanismos de exportação/ importação.

- Suporte multi-utilizador.

- Armazenamento de estruturas de dados sofisticadas.

- Imposição de integridade.

- Interface de ferramentas ricas em termos semânticos.

- Gestão de processos e projetos.

- Versões, gestão de dependências, controle das mudanças.

- Acompanhamento de requisitos.

- Auditorias.

3.1.3 – Classificação

As ferramentas CASE podem ser classificadas:

- pelo seu uso nas várias etapas do processo de Engenharia de Software;

- por função, ou seja, por seus papéis como instrumentos para os profissionais da área de informática;

- pela arquitetura do ambiente que as suporta;

- pelo seu preço

3.1.4 – Requisitos

A captura dos requisitos do sistema junto ao usuário é um pouco diferenciada pois, os usuários de ferramentas CASE são desenvolvedores sendo assim não são tão bem definidos quanto os usuários de um aplicação comum.

Membros de equipes de marketing também auxiliam no processo, pois se trata de um produto dirigido a “mercado”.

O processo desta fase se dá basicamente por meio de atividades macro:

- Análise do mercado

- Análise de documentação de ferramentas similares existentes

- Testes sobre as ferramentas similares existentes

- Elaboração e aplicação de questionários (na forma de ciclo de questões) que deverão ser respondidos pelos desenvolvedores e pessoal de marketing

3.1.5 – Arquitetura

Uma ferramenta CASE deve ser flexível, com arquitetura modular para facilitar sua configuração para diferentes propósitos. A arquitetura deve ser baseada em:

- Componentes: que representam os subsistemas principais e objetos da ferramenta;

- Mecanismos de interação (tecnologia de integração): que representam a forma como os componentes interagem, trocam informações e afetam uns aos outros;

3.1.6 Custos

Aquisição de produtos CASE (hardware, software e recursos de rede).

Treinamento da equipe no uso de ferramentas CASE e no uso da metodologia de engenharia de software.

Adaptação das ferramentas CASE para atender aos padrões e procedimentos existentes.

Custos contínuos para a aquisição e instalação de novos releases do software.

3.1.7 Benefícios

Este tipo de ferramenta possui como benefícios um aumento na capacidade das pessoas de garantir a qualidade com a continua melhoria do processo de desenvolvimento, além da produção de sistemas com maior qualidade, de fácil manutenção, com uma documentação melhor e uma redução nos custos.

4 – Conclusão

Os Sistemas de Informação são peça fundamental para as empresas, não apenas na elaboração de relatórios, mas fazem parte de todos os departamentos e atividades da companhia, desde o simples controle até a confecção de planos estratégicos complexos. Tudo que acontece, todos processos, são regidos por um sistema, que pode ou não ser informatizado. Mais uma vez, deve ser considerada a importância do administrador nesse processo, que é nada menos que vital para a corporação.

Mais do que um modismo, a tecnologia deve ser compreendida como uma ferramenta, um dos diversos métodos para assegurar qualidade, competitividade, redução de custos e principalmente, satisfazer os desejos e anseios dos clientes, que são a verdadeira razão de ser das empresas.

Bibliografia:

Anacleto, Junia Coutinho. Universidade Federal de São Carlos. Disponível em: http://www.dc.ufscar.br/~junia/index-isi.htm. Acesso em 13/10/2006

Anquetil, Nicolas. Disponível em htt://mestradoinfo.ucb.br/prof/anquetil/disciplinas.html

Acesso em 13/10/2006

Moresi, Eduardo Amadeu. Disponível em http://www.scielo.br/scielo.php?script=sci_arttext&pid=S01009652000000100002&lng=es&nrm=iso

Acesso em 13/10/2006

Criando um tipo de dado Avançado em Delphi - Parte 5

2011-08-06T12:16:00.000-03:00

Dando sequência a serie de artigos Criando um tipo de dado Avançado em Delphi (confira aqui a parte1 a parte 2 a parte 3 e a parte 4 ), iremos implementar hoje a unit untTEAMSystem que ira conter um tipo de dado que executa operações do sistema, como retornar a versão do executável, abrir um diretório com o explorer, abrir um arquivo com o notepad.

Abra o Delphi (neste artigo fora utilizado o Delphi 2007) e adicione uma nova unit e salve-a como untTEAMSystem :

Adicione os tipos a seguir:

TEAMAplication = record
  private

  public
    function GetVersionInfo: string;
    function FileVersionInfo(Arquivo: string): string;
    procedure AbrirArquivoComNotePad(path: string);
    procedure AbrirExplorer(path: string);
    function DiretorioAplicacao: string;
    function ExecAndWait(const FileName, Params: string; const WindowState:
      Word): boolean;
    function ListarArquivos(Diretorio, Extencao: string; SubDiretorio: Boolean): TStringList;
    function ListarNomesArquivos(Diretorio, Extencao: string; SubDiretorio: Boolean): TStringList;
    function AppIsRunning(ActivateIt: boolean): Boolean;
    function CriaSubDiretorios(const NomeSubDir: string): boolean;
    function GetLocalUserName: string;
    function LastModify: string;
  end;

Como você pode observar não temos nenhum campo value, por que este dado ira agrupar apenas métodos para operações da aplicação.
vamos a implementação:

unit untTEAMSystem;

interface

uses untTEAMString, Windows, SysUtils, dialogs, Forms, Graphics,
  Controls, ShellApi, Classes;

type

{$REGION 'Tipos'}
  SizeInt = Integer;
  TStatusControle = (Editar, Navegar);
{$ENDREGION}

{$REGION 'Aplicação - TEAMAplication'}
  TEAMAplication = record
  private

  public
    function GetVersionInfo: string;
    function FileVersionInfo(Arquivo: string): string;
    procedure AbrirArquivoComNotePad(path: string);
    procedure AbrirExplorer(path: string);
    function DiretorioAplicacao: string;
    function ExecAndWait(const FileName, Params: string; const WindowState:
      Word): boolean;
    function ListarArquivos(Diretorio, Extencao: string; SubDiretorio: Boolean): TStringList;
    function ListarNomesArquivos(Diretorio, Extencao: string; SubDiretorio: Boolean): TStringList;
    function AppIsRunning(ActivateIt: boolean): Boolean;
    function CriaSubDiretorios(const NomeSubDir: string): boolean;
    function GetLocalUserName: string;
    function LastModify: string;
  end;

{$ENDREGION}

const
  strWindowsNotepade: string = 'c:\windows\notepad.exe';
implementation

{ TCSTSystemExecute }

{-------------------------------------------------------------------------------
  Procedure: TEAMAplication.GetLocalUserName
   Arguments: None
  Result:    string
  Objetivo:  Retornar o usuario logado no windows
-------------------------------------------------------------------------------}

function TEAMAplication.GetLocalUserName: string;
  procedure StrResetLength(var S: AnsiString);
  var
    I: SizeInt;
  begin
    for I := 1 to Length(S) do
      if S[I] = #0 then
      begin
        SetLength(S, I);
        Exit;
      end;
  end;
var
  Count: DWORD;

begin
  Count := 256 + 1; // UNLEN + 1
  // set buffer size to 256 + 2 characters
  { TODO : Win2k solution }
  SetLength(Result, Count);
  if GetUserName(PChar(Result), Count) then
    StrResetLength(Result)
  else
    Result := '';
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMAplication.AbrirArquivoComNotePad
    Arguments: path: string
  Result:    None
  Objetivo:  Abrir um arquivo usando o notepad
-------------------------------------------------------------------------------}

procedure TEAMAplication.AbrirArquivoComNotePad(path: string);
begin
  ShellExecute(0, 'open', pchar(Strwindowsnotepade), pchar(path), nil, SW_MAXIMIZE);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMAplication.AbrirExplorer
   Arguments: path: string
  Result:    None
  Objetivo:  Abrir o Explorer mostrando uma pasta
-------------------------------------------------------------------------------}

procedure TEAMAplication.AbrirExplorer(path: string);
begin
  ShellExecute(Application.Handle, PChar('open'), PChar('explorer.exe'),
    PChar(path), nil, SW_NORMAL);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMAplication.AppIsRunning
  Arguments: ActivateIt: boolean
  Result:    Boolean
  Objetivo:  Verificar se há uma instancia da aplicação rodando
-------------------------------------------------------------------------------}

function TEAMAplication.AppIsRunning(ActivateIt: boolean): Boolean;
var
  hSem: THandle;
  hWndMe: HWnd;
  AppTitle: string;
begin
  Result := False;
  AppTitle := Application.Title;
  hSem := CreateSemaphore(nil, 0, 1, pChar(AppTitle));
  if ((hSem <> 0) and (GetLastError() = ERROR_ALREADY_EXISTS)) then
  begin
    CloseHandle(hSem);
    Result := True;
  end;
  if Result and ActivateIt then
  begin
    Application.Title := 'zzzzzzz';
    hWndMe := FindWindow(nil, pChar(AppTitle));
    if (hWndMe <> 0) then
    begin
      if IsIconic(hWndMe) then
      begin
        ShowWindow(hWndMe, SW_SHOWNORMAL);
      end
      else
      begin
        SetForegroundWindow(hWndMe);
      end;
    end;
  end;

end;

{-------------------------------------------------------------------------------
  Procedure: TEAMAplication.CriaSubDir
   Arguments: const NomeSubDir: string
  Result:    boolean
  Objetivo:  Criar um ou vários sub-diretórios
-------------------------------------------------------------------------------}

function TEAMAplication.CriaSubDiretorios(const NomeSubDir: string): boolean;
begin
  if DirectoryExists(NomeSubDir) then
    Result := true
  else
    Result := ForceDirectories(NomeSubDir);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMAplication.DiretorioAplicacao
   Arguments: None
  Result:    string
  Objetivo:  Retornar o diretório da aplicação
-------------------------------------------------------------------------------}

function TEAMAplication.DiretorioAplicacao: string;
begin
  result := ExtractFilePath(Application.ExeName);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMAplication.ExecAndWait
  Arguments: const FileName, Params: string; const WindowState: Word
  Result:    boolean
  Objetivo:  Execultar e esperar o termino da execução de um exe
-------------------------------------------------------------------------------}

function TEAMAplication.ExecAndWait(const FileName, Params: string;
  const WindowState: Word): boolean;
var
  SUInfo: TStartupInfo;
  ProcInfo: TProcessInformation;
  CmdLine: string;
begin
  { Coloca o nome do arquivo entre aspas. Isto é necessário devido aos espaços contidos em nomes longos }
  CmdLine := '"' + Filename + '"' + Params;
  FillChar(SUInfo, SizeOf(SUInfo), #0);
  with SUInfo do
  begin
    cb := SizeOf(SUInfo);
    dwFlags := STARTF_USESHOWWINDOW;
    wShowWindow := WindowState;
  end;
  Result := CreateProcess(nil, PChar(CmdLine), nil, nil, false,
    CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil,
    PChar(ExtractFilePath(Filename)), SUInfo, ProcInfo);
  { Aguarda até ser finalizado }
  if Result then
  begin
    WaitForSingleObject(ProcInfo.hProcess, INFINITE);
    { Libera os Handles }
    CloseHandle(ProcInfo.hProcess);
    CloseHandle(ProcInfo.hThread);
  end;

end;

function TEAMAplication.FileVersionInfo(Arquivo: string): string;
begin
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMAplication.GetVersionInfo
  Arguments: None
  Result:    string
  Objetivo:  Retornar a versao da aplicação
-------------------------------------------------------------------------------}

function TEAMAplication.GetVersionInfo: string;

type
  PFFI = ^vs_FixedFileInfo;
var
  F: PFFI;
  Handle: Dword;
  Len: Longint;
  Data: Pchar;
  Buffer: Pointer;
  Tamanho: Dword;
  Parquivo: Pchar;
  Arquivo: string;
begin
  Arquivo := Application.ExeName;
  Parquivo := StrAlloc(Length(Arquivo) + 1);
  StrPcopy(Parquivo, Arquivo);
  Len := GetFileVersionInfoSize(Parquivo, Handle);
  Result := '';
  if Len > 0 then
  begin
    Data := StrAlloc(Len + 1);
    if GetFileVersionInfo(Parquivo, Handle, Len, Data) then
    begin
      VerQueryValue(Data, '\', Buffer, Tamanho);
      F := PFFI(Buffer);
      Result := Format('%d.%d.%d.%d',
        [HiWord(F^.dwFileVersionMs),
        LoWord(F^.dwFileVersionMs),
          HiWord(F^.dwFileVersionLs),
          Loword(F^.dwFileVersionLs)]
          );
    end;
    StrDispose(Data);
  end;
  StrDispose(Parquivo);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMAplication.LastModify
  Arguments: None
  Result:    string
  Objetivo:  Retornar a data da ultima modificação do execultavel
-------------------------------------------------------------------------------}

function TEAMAplication.LastModify: string;
var
  FileH: THandle;
  LocalFT: TFileTime;
  DosFT: DWORD;
  LastAccessedTime: TDateTime;
  FindData: TWin32FindData;

begin

  Result := '';

  FileH := FindFirstFile(PChar(Application.ExeName), FindData);

  if FileH <> INVALID_HANDLE_VALUE then
  begin

    //    Windows.FindClose(nil);

    if (FindData.dwFileAttributes and

      FILE_ATTRIBUTE_DIRECTORY) = 0 then

    begin

      FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFT);

      FileTimeToDosDateTime(LocalFT, LongRec(DosFT).Hi, LongRec(DosFT).Lo);

      LastAccessedTime := FileDateToDateTime(DosFT);

      Result := DateTimeToStr(LastAccessedTime);

    end;

  end;
end;

{-------------------------------------------------------------------------------
 Procedure: TEAMAplication.ListarArquivos
 Arguments: Diretorio, Extencao: string; SubDiretorio: Boolean
 Result:    TStringList
 Objetivo:  Listar os arquivo contidos em um diretório e/ou Subdiretório
-------------------------------------------------------------------------------}

function TEAMAplication.ListarArquivos(Diretorio, Extencao: string;
  SubDiretorio: Boolean): TStringList;
  function TemAtributo(Attr, Val: Integer): Boolean;
  begin
    Result := (Attr and Val = Val);
  end;
var
  F: TSearchRec;
  Ret: Integer;
  TempNome: string;
begin

  Result := TStringList.Create;

  Ret := FindFirst(Diretorio + '\*.*', faAnyFile, F);
  try
    while Ret = 0 do
    begin
      if TemAtributo(F.Attr, faDirectory) then
      begin
        if (F.Name <> '.') and (F.Name <> '..') then
          if SubDiretorio then
          begin
            TempNome := Diretorio + '\' + F.Name;
            Result.AddStrings(ListarArquivos(TempNome, Extencao, True));
          end;
      end
      else
      begin
        if Pos(Extencao, LowerCase(f.Name)) > 0 then
          Result.Add(Diretorio + '\' + F.Name);
      end;
      Ret := FindNext(F);
    end;
  finally
    begin
      FindClose(F);
    end;
  end;

end;

{-------------------------------------------------------------------------------
  Procedure: TEAMAplication.ListarNomesArquivos
  Arguments: Diretorio, Extencao: string; SubDiretorio: Boolean
  Result:    TStringList
  Objetivo:  Lista todos os arquivos de um diretório de acordo com a extenção
-------------------------------------------------------------------------------}

function TEAMAplication.ListarNomesArquivos(Diretorio, Extencao: string;
  SubDiretorio: Boolean): TStringList;
var
  I: Integer;
  Arq: TEAMString;
begin
  result := self.ListarArquivos(Diretorio, Extencao, SubDiretorio);

  for I := 0 to result.Count - 1 do
  begin
    Arq.text := Result[i];
    Result[i] := Arq.SubString(arq.SearchRigth('\') + 1, arq.Count + 1);
  end;
end;
{$ENDREGION}


end.

Adicione alguns edits e um TlistBox para o formulário de teste como abaixo:

Adicione o seguinte código no onCLick do botão "ok" :

procedure TForm1.btn1Click(Sender: TObject);
var
  APP : TEAMAplication;
begin
  edtGetVersionInfo.Text := APP.GetVersionInfo;
  edtDiretorioAplicacao.Text := APP.DiretorioAplicacao;
  edtGetLocalUserName.Text := APP.GetLocalUserName;
  lstListarArquivos.Items.Text := APP.ListarArquivos('c:\windows\system32','.dll',False).Text;
end  ;

Execute a aplicação e observe o resultado:

Assim finalizamos está série de posts. Analisamos e apreciamos todo o poder do record em pascal, organizamos mais o nosso código e ganhamos em produtividade. Aprendemos que não precisamos de dezenas de units com várias funções em vários lugares, podemos centralizar tudo em uma unica unit organizada, salva-la em um diretório e apenas adiciona-la ao projeto em que estamos trabalhando e usar.

Agora aproveite para exercitar o seu poder de programador para melhorar alguns métodos e adicionar novos e não deixe de nos enviar o seu código. "Compartilhar atrai amigos. Competir atrai inimigos"

Criando um tipo de dado Avançado em Delphi - Parte 4

2011-08-05T11:19:00.000-03:00

Dando sequência a serie de artigos Criando um tipo de dado Avançado em Delphi (confira aqui a parte1 a parte 2 e a parte 3 ), iremos implementar hoje a unit untTEAMDateTime que ira conter os tipos para se trabalhar com Date, Time e DateTime.

Abra o Delphi (neste artigo fora utilizado o Delphi 2007) e adicione uma nova unit e salve-a como untTEAMDateTime:

Adicione os tipos a seguir:

unit untTEAMDateTime;

interface

uses untTEAMString, untTEAMNumeric, DateUtils, SysUtils, Controls;

type

{$REGION 'TCSTDate '}

TCSTDate = record
  public
    Value: TDateTime;  

  end;

{$ENDREGION}

{$REGION 'TCSTTime'}

  TEAMTime = record
  public
    Value: TDateTime;  
  end;

{$ENDREGION}

implementation

end.

O campo "Value" nos dois records ira armazenar o conteúdo do nosso dado para que possamos aplicar as operações.
Como fizemos na unit untTEAMNumeric, vamos aproveitar aqui também os tipos TEAMString da untTEAMString e o TEAMInteger da untTEAMNumeric em alguns métodos. Vamos a listagem:

$REGION ' TEAMDate'}
  TEAMDate = record
  public
    Value: TDateTime;

    function ToString: TEAMString;
    function ToSqlServerFormat: TEAMString;
    function Date: TDate;
    function Formatar(Formato: string): TEAMString;
    function ToExtenco: TEAMString;
    function MesToExtenco: TEAMString;
    function DiaDaSemanaExtenco: TEAMString;
    function GetDia: TEAMinteger;
    function GetMes: TEAMinteger;
    function GetAno: TEAMinteger;
    function GetDiaSemana: TEAMinteger;
    function GetPrimeiroDiaMes: TEAMinteger;
    function GetUltimoDiaMes: TEAMinteger;
    procedure ADDMes(Meses: Integer);
    function DiasNoMes: TEAMinteger;
    function isAnoBiSexto: Boolean;
    function isFimDeSemana: Boolean;
    function INDates(DataInicial, DataFinal: Tdate): Boolean;
    procedure AddDias(NumDias: Integer);
    procedure SubDias(NumDias: Integer);
    procedure Encode(Dia, mes, ano: Word);
    procedure EncodeFromString(Data: string);
    procedure ReplaceTimer;
    procedure SetDateNow;

  end;
{$ENDREGION}

{$REGION ' TEAMTime'}
  TEAMTime = record
  public
    Value: TDateTime;
    function ToString: TEAMString;
    function DataHoraString: TEAMString;
    function Formatar(Formato: string): TEAMString;
    function GetHora: TEAMString;
    function GetMinutos: TEAMString;
    function GetSegundos: TEAMString;
    function ToExtenco: TEAMString;
    function ToMinutos: Integer;
  end;
{$ENDREGION}

A maioria dos métodos para Data/Hora estão presentes. Alguns muitos úteis como retornar o último dia do mês, adicionar dias a data, verificar se a data é final de semana, etc. Sinta-se a vontade para adicionar outros que achar nescessário. O próximo passo é a implementação dos métodos.
Veja a listagem completa da nossa unit:

unit untTEAMDateTime;

interface

uses untTEAMString, untTEAMNumeric, DateUtils, SysUtils, Controls;

type
{$REGION ' TEAMDate'}
  TEAMDate = record
  public
    Value: TDateTime;

    function ToString: TEAMString;
    function ToSqlServerFormat: TEAMString;
    function Date: TDate;
    function Formatar(Formato: string): TEAMString;
    function ToExtenco: TEAMString;
    function MesToExtenco: TEAMString;
    function DiaDaSemanaExtenco: TEAMString;
    function GetDia: TEAMinteger;
    function GetMes: TEAMinteger;
    function GetAno: TEAMinteger;
    function GetDiaSemana: TEAMinteger;
    function GetPrimeiroDiaMes: TEAMinteger;
    function GetUltimoDiaMes: TEAMinteger;
    procedure ADDMes(Meses: Integer);
    function DiasNoMes: TEAMinteger;
    function isAnoBiSexto: Boolean;
    function isFimDeSemana: Boolean;
    function INDates(DataInicial, DataFinal: Tdate): Boolean;
    procedure AddDias(NumDias: Integer);
    procedure SubDias(NumDias: Integer);
    procedure Encode(Dia, mes, ano: Word);
    procedure EncodeFromString(Data: string);
    procedure ReplaceTimer;
    procedure SetDateNow;

  end;
{$ENDREGION}

{$REGION ' TEAMTime'}
  TEAMTime = record
  public
    Value: TDateTime;
    function ToString: TEAMString;
    function DataHoraString: TEAMString;
    function Formatar(Formato: string): TEAMString;
    function GetHora: TEAMString;
    function GetMinutos: TEAMString;
    function GetSegundos: TEAMString;
    function ToExtenco: TEAMString;
    function ToMinutos: Integer;
  end;
{$ENDREGION}

implementation

{$REGION 'TEAMDate'}
{ TEAMDate }

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.AddDias
   Arguments: NumDias: Integer
  Result:    None
  Objetivo:  Adicionar dias para a data
-------------------------------------------------------------------------------}

procedure TEAMDate.AddDias(NumDias: Integer);
begin
  Self.Value := IncDay(Self.Value, NumDias);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.INDates
  Arguments: DataInicial, DataFinal: Tdate
  Result:    Boolean
  Objetivo:  Testar se uma data está em um intervalo
-------------------------------------------------------------------------------}

function TEAMDate.INDates(DataInicial, DataFinal: Tdate): Boolean;
begin
  Result := ((CompareDate(Self.Value, DataInicial) >= 0)
    and (CompareDate(Self.Value, DataFinal) <= 0));
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.DiaDaSemanaExtenco
  Arguments: None
  Result:    TEAMString
  Objetivo:  Retornar o dia em extenço
-------------------------------------------------------------------------------}

function TEAMDate.DiaDaSemanaExtenco: TEAMString;
const
  semana: array[1..7] of string = ('Domingo', 'Segunda-feira', 'Terça-feira', 'Quarta-feira', 'Quinta-feira', 'Sexta-feira', 'Sábado');
begin
  Result.Text := semana[DayOfWeek(Self.Value)]
end;

function TEAMDate.Date: TDate;
begin
  result := Self.Value;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.DiasNoMes
  Arguments: None
  Result:    Integer
  Objetivo:  Retornar o numero de dias no mes
-------------------------------------------------------------------------------}

function TEAMDate.DiasNoMes: TEAMinteger;
const
  DaysInMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
  Result.Value := DaysInMonth[Self.GetMes.Value];
  if (Self.GetMes.Value = 2) and Self.isAnoBiSexto then
    Inc(Result.Value);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.Encode
  Arguments: Ano mes e dia
  Result:    nenhum
  Objetivo:  Transforma o dia,mes e ano em uma data
-------------------------------------------------------------------------------}

procedure TEAMDate.Encode(Dia, mes, ano: Word);
begin
  Self.Value := EncodeDate(ano, mes, dia);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.EncodeFromString
  Arguments: Data: string
  Result:    None
  Objetivo:  Conveter uma string para uma data
-------------------------------------------------------------------------------}

procedure TEAMDate.EncodeFromString(Data: string);
begin
  Self.Value := StrToDate(data);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.Formatar
  Arguments: Formato: string
  Result:    TEAMString
  Objetivo:  Retornar a data formatada de acordo com o parametro passado
-------------------------------------------------------------------------------}

function TEAMDate.Formatar(Formato: string): TEAMString;
begin
  Result.Text := FormatDateTime(Formato, Self.Value);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.GetAno
  Arguments: None
  Result:    Integer
  Objetivo:  Retornar o ano
-------------------------------------------------------------------------------}

function TEAMDate.GetAno: TEAMinteger;
var
  ano, mes, dia: Word;
begin
  DecodeDate(Self.Value, ano, mes, dia);
  Result.Value := ano;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.GetDia
  Arguments: None
  Result:    Integer
  Objetivo:  Retornar o dia
-------------------------------------------------------------------------------}

function TEAMDate.GetDia: TEAMinteger;
var
  ano, mes, dia: Word;
begin
  DecodeDate(Self.Value, ano, mes, dia);
  Result.Value := dia;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.GetDiaSemana
  Arguments: None
  Result:    Integer
  Objetivo:  Retornar o dia da semana
-------------------------------------------------------------------------------}

function TEAMDate.GetDiaSemana: TEAMinteger;
begin
  Result.Value := DayOfTheWeek(Self.Value)
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.GetMes
  Arguments: None
  Result:    Integer
  Objetivo:  Retornar o mes da data
-------------------------------------------------------------------------------}

function TEAMDate.GetMes: TEAMinteger;
var
  ano, mes, dia: Word;
begin
  DecodeDate(Self.Value, ano, mes, dia);
  Result.Value := mes;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.GetPrimeiroDiaMes
  Arguments: Nenhum
  Result:    Nenhum
  Objetivo:  Retornar o primeiro dia do mes
-------------------------------------------------------------------------------}

function TEAMDate.GetPrimeiroDiaMes: TEAMinteger;
begin
  Result.Value := 1;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.GetUltimoDiaMes
  Arguments: Nenhum
  Result:    Nenhum
  Objetivo:  Retornar o ultimo dia do mes
-------------------------------------------------------------------------------}

function TEAMDate.GetUltimoDiaMes: TEAMinteger;
var
  ano, mes, dia: word;
  temp: TDate;
begin
  DecodeDate(Self.Value, ano, mes, dia);

  mes := mes + 1;
  if mes = 13 then
  begin
    mes := 1;
    ano := ano + 1;
  end;
  temp := EncodeDate(ano, mes, 1) - 1;

  Result.Value := DayOf(temp);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.ADDMes
  Arguments: Meses: Integer
  Result:    None
  Objetivo:  Adicionar um numero de meses a data
-------------------------------------------------------------------------------}

procedure TEAMDate.ADDMes(Meses: Integer);
begin
  Self.Value := IncMonth(Self.Value, Meses);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.isAnoBiSexto
  Arguments: None
  Result:    Boolean
  Objetivo:  Retornar se o ano é bissexto
-------------------------------------------------------------------------------}

function TEAMDate.isAnoBiSexto: Boolean;
begin
  Result := (Self.GetAno.Value mod 4 = 0) and ((Self.GetAno.Value mod 100 <> 0) or (Self.GetAno.Value mod 400 = 0));
end;

{-------------------------------------------------------------------------------
 Procedure: TEAMDate.isFimDeSemana
  Arguments: None
  Result:    Boolean
  Objetivo:  Retorna se a data é um fim de semana
-------------------------------------------------------------------------------}

function TEAMDate.isFimDeSemana: Boolean;

{Verifica se uma data informada cai em um final de semana}
begin
  if DayOfWeek(Self.Value) in [1, 7] then
    result := true
  else
    result := false;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.MesToExtenco
  Arguments: None
  Result:    TEAMString
  Objetivo:  Retornar o mês por extenco
-------------------------------------------------------------------------------}

function TEAMDate.MesToExtenco: TEAMString;
begin
  case Self.GetMes.Value of
    1: Result.Text := 'Janeiro';
    2: Result.Text := 'Fevereiro';
    3: Result.Text := 'Março';
    4: Result.Text := 'Abril';
    5: Result.Text := 'Maio';
    6: Result.Text := 'Junho';
    7: Result.Text := 'Julho';
    8: Result.Text := 'Agosto';
    9: Result.Text := 'Setembro';
    10: Result.Text := 'Outubro';
    11: Result.Text := 'Novembro';
    12: Result.Text := 'Dezembro';
  else
    Result.Text := '';
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.ReplaceTimer
  Arguments: None
  Result:    None
  Objetivo:  Apaga a hora
-------------------------------------------------------------------------------}

procedure TEAMDate.ReplaceTimer;
var
  newTime: TDateTime;
begin
  newTime := EncodeTime(0, 0, 0, 0);
  ReplaceTime(self.Value, newTime);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.SetDateNow
  Arguments: None
  Result:    None
  Objetivo:  seta a dataHora para o horario atual
-------------------------------------------------------------------------------}

procedure TEAMDate.SetDateNow;
begin
  Self.Value := Now;
end;
{-------------------------------------------------------------------------------
 Procedure: TEAMDate.SubDias
 Arguments: NumDias: Integer
 Result:    None
 Objetivo:  Subtrair um numero de dias da data
-------------------------------------------------------------------------------}

procedure TEAMDate.SubDias(NumDias: Integer);
begin
  NumDias := (NumDias * -1);
  Self.AddDias(NumDias);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.ToExtenco
  Arguments: None
  Result:    TEAMString
  Objetivo:  Retornar a data por extenço
-------------------------------------------------------------------------------}

function TEAMDate.ToExtenco: TEAMString;
begin
  Result.Text := FormatDateTime('dddddd', Self.Value);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.ToString
  Arguments: None
  Result:    TEAMString
  Objetivo:  Retornar a data em string
-------------------------------------------------------------------------------}

function TEAMDate.ToString: TEAMString;
begin
  Result.Text := DateToStr(Self.Value);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.ToSqlServerFormat
  Arguments: None
  Result:    TEAMString
  Objetivo:  Converter para o formato de data do sqlServer
-------------------------------------------------------------------------------}

function TEAMDate.ToSqlServerFormat: TEAMString;
begin
  Result.Text := FormatDateTime('YYYY-MM-DD', Self.Value);
end;

{$ENDREGION}

{$REGION 'TEAMTime'}
{ TEAMTime }

{-------------------------------------------------------------------------------
  Procedure: TEAMTime.DataHoraString
  Arguments: None
  Result:    TEAMString
  Objetivo:  Retorna a data e a hora em uma string
-------------------------------------------------------------------------------}

function TEAMTime.DataHoraString: TEAMString;
begin
  Result.Text := DateTimeToStr(Self.Value);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMTime.Formatar
  Arguments: Formato: string
  Result:    TEAMString
  Objetivo:  Formata a hora de acordo com o formato passado
-------------------------------------------------------------------------------}

function TEAMTime.Formatar(Formato: string): TEAMString;
begin
  Result.Text := FormatDateTime(Formato, Self.Value);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMTime.GetHora
  Arguments: None
  Result:    TEAMString
  Objetivo:  Retorna a hora
-------------------------------------------------------------------------------}

function TEAMTime.GetHora: TEAMString;
var
  hora, minutos, segundos, mcsegundos: Word;
begin
  Decodetime(Self.Value, hora, minutos, segundos, mcsegundos);
  Result.Text := intToStr(hora);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMTime.GetMinutos
  Arguments: None
  Result:    TEAMString
  Objetivo:  Retorna os minutos
-------------------------------------------------------------------------------}

function TEAMTime.GetMinutos: TEAMString;
var
  hora, minutos, segundos, mcsegundos: Word;
begin
  Decodetime(Self.Value, hora, minutos, segundos, mcsegundos);
  Result.Text := intToStr(minutos);

end;

{-------------------------------------------------------------------------------
  Procedure: TEAMTime.GetSegundos
  Arguments: None
  Result:    TEAMString
  Objetivo:  Retorna os segundos
-------------------------------------------------------------------------------}

function TEAMTime.GetSegundos: TEAMString;
var
  hora, minutos, segundos, mcsegundos: Word;
begin
  Decodetime(Self.Value, hora, minutos, segundos, mcsegundos);
  Result.Text := intToStr(segundos);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMTime.ToString
  Arguments: None
  Result:    TEAMString
  Objetivo:  Converte para string
-------------------------------------------------------------------------------}

function TEAMTime.ToString: TEAMString;
begin
  Result.Text := TimeToStr(Self.Value);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMTime.ToExtenco
  Arguments: None
  Result:    TEAMString
  Objetivo:  Retorna a hora em extenço
-------------------------------------------------------------------------------}

function TEAMTime.ToExtenco: TEAMString;
var
  Hora, Minuto, Segundo: TEAMinteger;

begin
  Hora.Value := self.GetHora.ToInt;
  Minuto.Value := self.GetMinutos.Toint;
  Segundo.Value := self.GetSegundos.Toint;

  Result.Text := Hora.ToExtenco.Text + ' hora';
  if Hora.Value > 1 then
    Result.Text := Result.Text + 's';
  if Minuto.Value > 0 then
  begin
    Result.Text := Result.Text + ', ' + Minuto.ToExtenco.Text + ' minuto';
    if Minuto.Value > 1 then
      Result.Text := Result.Text + 's'
  end;

  if Segundo.Value > 0 then
  begin
    Result.Text := Result.Text + ' e ' + Segundo.ToExtenco.Text + ' segundo';
    if Segundo.Value > 1 then
      Result.Text := Result.Text + 's'
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMTime.ToMinutos
  Arguments: None
  Result:    Integer
  Objetivo:  Converte Para Minutos
-------------------------------------------------------------------------------}

function TEAMTime.ToMinutos: Integer;
begin
  Result := (StrToInt(Copy(Self.ToString.Text, 1, 2)) * 60) + StrToInt(Copy(Self.ToString.Text, 4, 2));
end;

{$ENDREGION}

end.

Agora podemos iniciar o testes. Adione a unit untTEAMDateTime ao formulário:

unit untTEAMDateTime;

Adicione alguns edits e um botão como abaixo:

No ovento onClick do botão escreva o seguinte código:

procedure TForm1.btn1Click(Sender: TObject);
var
  EAMDateTime: TEAMDate;
  EAMTime: TEAMTime;
begin
  EAMDateTime.SetDateNow;

  edtValue.Text := EAMDateTime.ToString.Text;
  edtToExtenco.Text := EAMDateTime.ToExtenco.Text;
  edtGetDia.Text := EAMDateTime.GetDia.ToString.Text;
  edtGetMes.Text := EAMDateTime.GetMes.ToString.Text;
  edtGetAno.Text := EAMDateTime.GetAno.ToString.Text;
  edtGetUltimoDiaMes.Text := EAMDateTime.GetUltimoDiaMes.ToString.Text;
  edtHashDateTime.Text := EAMDateTime.ToString.Hash;


  EAMTime.Value := Now;

  edtTimeValue.Text := EAMTime.Formatar('HH:MM:SS').Text;
  edtTimeToExtenco.Text := EAMTime.ToExtenco.Text;
  edtGetSegundos.Text := EAMTime.GetSegundos.Text;
  edtGetHora.Text := EAMTime.GetHora.Text;
  edtGetMinutos.Text := EAMTime.GetMinutos.Text;
   edtHashTime.Text := EAMTime.ToString.Hash;
end

Execute e confira o resultado:

Todos os métodos da listagem foram documentados para facilitar o entendimento da sua finalidade. Fique a vontade para adicionar novos métodos e procedures. :)

Confira aqui o próximo post

Observação: Algumas das procedure e functions usadas neste artigo são uma compilação de códigos encontrados na internet. se você encontrar aqui algum código de sua autoria, entre em contato para que possamos dar-lhe o devido crédito.

Criando um tipo de dado Avançado em Delphi - Parte 3

2011-08-04T19:53:00.000-03:00

Dando sequência a serie de artigos Criando um tipo de dado Avançado em Delphi (confira aqui a parte1 e a parte 2 ), vamos implementar dois tipos numéricos: o TEAMDouble e o TEAMInteger (o nome é sugestivo) . Estes tipos vão nos ajudar a trabalhar com os tipos inteiro e Double.

Abra o Delphi (neste artigo fora utilizado o Delphi 2007) e adicione uma nova unit e salve-a como untTEAMNumeric:

Adicione os dois tipos a seguir:

unit untTEAMNumeric;

interface

uses SysUtils, Math, Graphics, Classes, UniTEAMString, WinTypes;

type

  TEAMDouble = record
    Value: Double;
  end;

  TEAMInteger = record
    Value: Integer;
  end;

implementation

end.

O campo "Value" nos dois records ira armazenar o conteúdo do nosso dado para que possamos aplicar as operações. Repare no uses a unit untTEAMNumeric, iremos usar o tipo TEAMString em alguns campos. veja a listagem:

TEAMDouble = record
    Value: Double;
    function Arredonda(inCasas: Integer): Double;
    function Trunca(inCasas: Integer): Double;
    function CalcularPercentual(Percent: Real): real;
    function CalculaProporcao(Valor: Real): Real;
    procedure CodigoBarras(Imagem: TCanvas);
    function ToString: TEAMString;
    function ToSqlServerFormat: TEAMString;
    function ToExtenco: TEAMString;
    function ToExtencoReais: TEAMString;
    function ToReias: TEAMString;
    procedure ADD(valor: Double);
    procedure inc;
    procedure Dec;
    procedure Clear;
    procedure Eval(Num: string);
  end;

  TEAMInteger = record
    Value: Integer;
    function ToString: TEAMString;
    function ToExtenco: TEAMString;
    procedure inc;
    procedure ADD(valor: integer);
    function NextValue: integer;
    function PriorValue: integer;
    procedure Dec;
    procedure Clear;
  end;

Retornar um TCSTString nos dara mais flexibilidade como veremos mais adiante. O próximo passo é a implementação dos métodos.
Veja a listagem completa da nossa unit:

unit untTEAMNumeric;

interface

uses SysUtils, Math, Graphics, Classes, untTEAMString, WinTypes;

type

  TEAMDouble = record
    Value: Double;
    function Arredonda(inCasas: Integer): Double;
    function Trunca(inCasas: Integer): Double;
    function CalcularPercentual(Percent: Real): real;
    function CalculaProporcao(Valor: Real): Real;
    procedure CodigoBarras(Imagem: TCanvas);
    function ToString: TEAMString;
    function ToSqlServerFormat: TEAMString;
    function ToExtenco: TEAMString;
    function ToExtencoReais: TEAMString;
    function ToReias: TEAMString;
    procedure ADD(valor: Double);
    procedure inc;
    procedure Dec;
    procedure Clear;
    procedure Eval(Num: string);
  end;

  TEAMInteger = record
    Value: Integer;
    function ToString: TEAMString;
    function ToExtenco: TEAMString;
    procedure inc;
    procedure ADD(valor: integer);
    function NextValue: integer;
    function PriorValue: integer;
    procedure Dec;
    procedure Clear;
  end;
implementation

resourcestring
  strNumeroForaIntervalo = 'TEAMDouble: O valor está fora do intervalo' +
    ' permitido.';

const
  Unidades: array[1..9] of string = ('Um', 'Dois', 'Tres', 'Quatro', 'Cinco', 'Seis', 'Sete', 'Oito', 'Nove');
  Dez: array[1..9] of string = ('Onze', 'Doze', 'Treze', 'Quatorze', 'Quinze', 'Dezesseis', 'Dezessete', 'Dezoito', 'Dezenove');
  Dezenas: array[1..9] of string = ('Dez', 'Vinte', 'Trinta', 'Quarenta', 'Cinquenta', 'Sessenta', 'Setenta', 'Oitenta', 'Noventa');
  Centenas: array[1..9] of string = ('Cento', 'Duzentos', 'Trezentos', 'Quatrocentos', 'Quinhentos', 'Seiscentos', 'Setecentos', 'Oitocentos', 'Novecentos');
  MoedaSigular = 'Real';
  MoedaPlural = 'Reais';
  CentSingular = 'Centavo';
  CentPlural = 'Centavos';
  Zero = 'Zero';

  { TEAMDouble }

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.ADD
  Arguments: valor: Double
  Result:    None
  Objetivo:  Adicioonar um valor
-------------------------------------------------------------------------------}

procedure TEAMDouble.ADD(valor: Double);
begin
  Self.Value := Self.Value + valor;
end;
{-------------------------------------------------------------------------------
    Procedure: TEAMDouble.Arredonda
    Arguments: inCasas: Integer
    Result:    Double
    Objetivo:  Arrendondar o valor de accordo com o numero de casas decimais
  -------------------------------------------------------------------------------}

function TEAMDouble.Arredonda(inCasas: Integer): Double;
var
  stValor: string;
  dlValor: Double;
begin
  dlValor := Value + (5 * Power(10, -(inCasas + 1)));
  stValor := Floattostr(dlValor);
  if pos(',', stvalor) = 0 then
    stValor := stValor + ',';
  stvalor := stvalor + '0000';
  stValor := Copy(stValor, 1, pos(',', stValor) + inCasas);
  Result := StrToFloat(stValor);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.CalculaProporcao
  Arguments: Valor: Real
  Result:    Real
  Objetivo:  Calcular a proporção do valor no numero passado
-------------------------------------------------------------------------------}

function TEAMDouble.CalculaProporcao(Valor: Real): Real;
begin
  Result := ((Self.Value * 100) / Valor);
end;

{-------------------------------------------------------------------------------
 Procedure: TEAMDouble.CalcularPercentual
 Arguments: Percent: Real
 Result:    real
 Objetivo:  Calcular o percent do
-------------------------------------------------------------------------------}

function TEAMDouble.CalcularPercentual(Percent: Real): real;
begin
  percent := percent / 100;
  result := value * Percent;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.Clear
  Arguments: None
  Result:    None
  Objetivo:  inicializa  valor
-------------------------------------------------------------------------------}

procedure TEAMDouble.Clear;
begin
  Self.Value := 0;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.CodigoBarras
  Arguments: var Imagem: TCanvas
  Result:    None
  Objetivo:  Gerar o código de Barras do valor passado
-------------------------------------------------------------------------------}

procedure TEAMDouble.CodigoBarras(Imagem: TCanvas);
const
  digitos: array['0'..'9'] of string[5] = ('00110', '10001', '01001', '11000',
    '00101', '10100', '01100', '00011', '10010', '01010');
var
  s, codigo: string;
  i, j, x, t: Integer;
begin
  codigo := Self.ToString.Text;
  // Gerar o valor para desenhar o código de barras
  // Caracter de início
  s := '0000';
  for i := 1 to length(codigo) div 2 do
    for j := 1 to 5 do
      s := s + Copy(Digitos[codigo[i * 2 - 1]], j, 1) + Copy(Digitos[codigo[i * 2]], j, 1);
  // Caracter de fim
  s := s + '100';
  // Desenhar em um objeto canvas
  // Configurar os parâmetros iniciais
  x := 0;
  // Pintar o fundo do código de branco
  Imagem.Brush.Color := clWhite;
  Imagem.Pen.Color := clWhite;
  Imagem.Rectangle(0, 0, 2000, 79);
  // Definir as cores da caneta
  Imagem.Brush.Color := clBlack;
  Imagem.Pen.Color := clBlack;
  // Escrever o código de barras no canvas
  for i := 1 to length(s) do
  begin
    // Definir a espessura da barra
    t := strToInt(s[i]) * 2 + 1;
    // Imprimir apenas barra sim barra não (preto/branco - intercalado);
    if i mod 2 = 1 then
      Imagem.Rectangle(x, 0, x + t, 79);
    // Passar para a próxima barra
    x := x + t;
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.Dec
  Arguments: None
  Result:    None
  Objetivo:  Decementa o valor em 1
-------------------------------------------------------------------------------}

procedure TEAMDouble.Dec;
begin
  self.Value := Self.Value - 1;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.Eval
  Arguments: Num: string
  Result:    None
  Objetivo:  Converte uma string para um double
-------------------------------------------------------------------------------}

procedure TEAMDouble.Eval(Num: string);
begin
  if Trim(num) <> '' then
    Self.Value := StrToFloat(Num)
  else
    self.value := 0;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.inc
  Arguments: None
  Result:    None
  Objetivo:  Incrementa o valor
-------------------------------------------------------------------------------}

procedure TEAMDouble.inc;
begin
  self.Value := Self.Value + 1;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.ToExtenco
  Arguments: None
  Result:    TEAMString
  Objetivo:  Converte o valor para extenço
-------------------------------------------------------------------------------}

function TEAMDouble.ToExtenco: TEAMString;
var
  Texto, Milhar, Centena, Centavos: string;

  function ifs(Expressao: Boolean; CasoVerdadeiro, CasoFalso: string): string;
  begin
    if Expressao then
      Result := CasoVerdadeiro
    else
      Result := CasoFalso;
  end;

  function MiniExtenso(trio: string): string;
  var
    Unidade, Dezena, Centena: string;
  begin
    Unidade := '';
    Dezena := '';
    Centena := '';
    if (trio[2] = '1') and (trio[3] <> '0') then
    begin
      Unidade := Dez[strtoint(trio[3])];
      Dezena := '';
    end
    else
    begin
      if trio[2] <> '0' then
        Dezena := Dezenas[strtoint(trio[2])];
      if trio[3] <> '0' then
        Unidade := Unidades[strtoint(trio[3])];
    end;
    if (trio[1] = '1') and (Unidade = '') and (Dezena = '') then
      Centena := 'Cem'
    else if trio[1] <> '0' then
      Centena := Centenas[strtoint(trio[1])]
    else
      Centena := '';
    Result := Centena + ifs((Centena <> '') and ((Dezena <> '') or (Unidade <> '')), ' e ', '')
      + Dezena + ifs((Dezena <> '') and (Unidade <> ''), ' e ', '') + Unidade;
  end;

begin
  if (self.value > 999999.99) or (self.value < 0) then
  begin
    raise Exception.Create(strNumeroForaIntervalo);
  end;
  if self.value = 0 then
  begin
    Result.Text := '';
    Exit;
  end;
  Texto := formatfloat('000000.00', self.value);
  Milhar := MiniExtenso(Copy(Texto, 1, 3));
  Centena := MiniExtenso(Copy(Texto, 4, 3));
  Centavos := MiniExtenso('0' + Copy(Texto, 8, 2));
  Result.Text := Milhar;
  if Milhar <> '' then
  begin
    Result.Text := Result.Text + ' Mil ';
  end;
  if (((copy(texto, 4, 2) = '00') and (Milhar <> '') and (copy(texto, 6, 1) <> '0'))) or (centavos = '') and (milhar <> '') then
    Result.Text := Result.Text + ' e ';
  if (Milhar + Centena <> '') then
    Result.Text := Result.Text + Centena;

  if Centavos = '' then
  begin
    Exit;
  end
  else
  begin
    if Milhar + Centena = '' then
      Result.Text := Centavos
    else
      Result.Text := Result.Text + ' e ' + Centavos;
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.ToExtencoReais
  Arguments: None
  Result:    TEAMString
  Objetivo:  Converte o valor para extenço em reais
-------------------------------------------------------------------------------}

function TEAMDouble.ToExtencoReais: TEAMString;
var
  Texto, Milhar, Centena, Centavos: string;
  ////////////////////////////////fucao auxiliar extenso////////////////////////////////
  function ifs(Expressao: Boolean; CasoVerdadeiro, CasoFalso: string): string;
  begin
    if Expressao then
      Result := CasoVerdadeiro
    else
      Result := CasoFalso;
  end;
  ////////////////////////////funcao auxiliar extenso/////////////////////////
  function MiniExtenso(trio: string): string;
  var
    Unidade, Dezena, Centena: string;
  begin
    Unidade := '';
    Dezena := '';
    Centena := '';
    if (trio[2] = '1') and (trio[3] <> '0') then
    begin
      Unidade := Dez[strtoint(trio[3])];
      Dezena := '';
    end
    else
    begin
      if trio[2] <> '0' then
        Dezena := Dezenas[strtoint(trio[2])];
      if trio[3] <> '0' then
        Unidade := Unidades[strtoint(trio[3])];
    end;
    if (trio[1] = '1') and (Unidade = '') and (Dezena = '') then
      Centena := 'Cem'
    else if trio[1] <> '0' then
      Centena := Centenas[strtoint(trio[1])]
    else
      Centena := '';
    Result := Centena + ifs((Centena <> '') and ((Dezena <> '') or (Unidade <> '')), ' e ', '')
      + Dezena + ifs((Dezena <> '') and (Unidade <> ''), ' e ', '') + Unidade;
  end;

begin
  if (self.value > 999999.99) or (self.value < 0) then
  begin
    raise Exception.Create(strNumeroForaIntervalo);
  end;
  if self.value = 0 then
  begin
    Result.Text := '';
    Exit;
  end;
  Texto := formatfloat('000000.00', self.value);
  Milhar := MiniExtenso(Copy(Texto, 1, 3));
  Centena := MiniExtenso(Copy(Texto, 4, 3));
  Centavos := MiniExtenso('0' + Copy(Texto, 8, 2));
  Result.Text := Milhar;
  if Milhar <> '' then
  begin
    if copy(texto, 4, 3) = '000' then
      Result.Text := Result.Text + ' Mil Reais'
    else
      Result.Text := Result.Text + ' Mil ';
  end;
  if (((copy(texto, 4, 2) = '00') and (Milhar <> '') and (copy(texto, 6, 1) <> '0'))) or (centavos = '') and (milhar <> '') then
    Result.Text := Result.Text + ' e ';
  if (Milhar + Centena <> '') then
    Result.Text := Result.Text + Centena;
  if (Milhar = '') and (copy(texto, 4, 3) = '001') then
    Result.Text := Result.Text + ' Real'
  else if (copy(texto, 4, 3) <> '000') then
    Result.Text := Result.Text + ' Reais';
  if Centavos = '' then
  begin
    Result.Text := Result.Text + '.';
    Exit;
  end
  else
  begin
    if Milhar + Centena = '' then
      Result.Text := Centavos
    else
      Result.Text := Result.Text + ' e ' + Centavos;
  end;
  if (copy(texto, 8, 2) = '01') and (Centavos <> '') then
    Result.Text := Result.Text + ' Centavo.'
  else
    Result.Text := Result.Text + ' Centavos.';

end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.ToReias
  Arguments: None
  Result:    TEAMString
  Objetivo:  Formata o valor para dinheiro
-------------------------------------------------------------------------------}

function TEAMDouble.ToReias: TEAMString;
begin
  Result.Text := FormatFloat('R$ 0.,00', Self.Value);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.ToString
  Arguments: None
  Result:    string
  Objetivo:  Converter para no formato para ser garvado no  sqlsrever
-------------------------------------------------------------------------------}

function TEAMDouble.ToSqlServerFormat: TEAMString;
var
  Aux: TEAMString;
begin
  Aux.Text := FloatToStr(Self.Value);
  Result.Text := Aux.ReplaceChar(',', '.');
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.ToString
  Arguments: None
  Result:    TEAMString
  Objetivo:  Converte o Valor para uma string
-------------------------------------------------------------------------------}

function TEAMDouble.ToString: TEAMString;
begin
  Result.Text := FloatToStr(Self.Value);
end;
{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.Trunca
  Arguments: inCasas: Integer
  Result:    Double
  Objetivo:  Truncar o valor com determinado numero de casas decimais
-------------------------------------------------------------------------------}

function TEAMDouble.Trunca(inCasas: Integer): Double;
var
  stValor: string;
begin
  stValor := Floattostr(Value);
  if pos(',', stvalor) = 0 then
    stValor := stValor + ',';
  stvalor := stvalor + '0000';
  stValor := Copy(stValor, 1, pos(',', stValor) + inCasas);
  Result := StrToFloat(stValor);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMInteger.ADD
  Arguments: valor: integer
  Result:    None
  Objetivo:  Incrementa o valor  em 1
-------------------------------------------------------------------------------}

procedure TEAMInteger.ADD(valor: integer);
begin
  Self.Value := self.Value + valor;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMInteger.Clear
  Arguments: None
  Result:    None
  Objetivo:  Apaga o conteudo
-------------------------------------------------------------------------------}

procedure TEAMInteger.Clear;
begin
  Self.Value := 0;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMInteger.Dec
  Arguments: None
  Result:    None
  Objetivo:  Decrementa o valor em 1
-------------------------------------------------------------------------------}

procedure TEAMInteger.Dec;
begin
  Self.Value := Self.Value - 1;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMInteger.inc
  Arguments: None
  Result:    None
  Objetivo:  incrementa o valor em 1
-------------------------------------------------------------------------------}

procedure TEAMInteger.inc;
begin
  Self.Value := Self.Value + 1;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMInteger.NextValue
  Arguments: None
  Result:    integer
  Objetivo:  Retorna qual será o próximo valor
-------------------------------------------------------------------------------}

function TEAMInteger.NextValue: integer;
begin
  Result := self.Value + 1;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMInteger.PriorValue
  Arguments: None
  Result:    integer
  Objetivo:  Retorna qual será o valor anterior
-------------------------------------------------------------------------------}

function TEAMInteger.PriorValue: integer;
begin
  result := self.value - 1;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMInteger.ToExtenco
  Arguments: None
  Result:    TEAMString
  Objetivo:  Converte o valor para extenço
-------------------------------------------------------------------------------}

function TEAMInteger.ToExtenco: TEAMString;
var
  Num: TEAMDouble;
begin
  Num.Value := Self.Value;
  Result := Num.ToExtenco;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMInteger.ToString
  Arguments: None
  Result:    TEAMString
  Objetivo:  Converte o valor para string
-------------------------------------------------------------------------------}

function TEAMInteger.ToString: TEAMString;
begin
  Result.Text := IntToStr(Self.Value);
end;

end.

Vamos aos teste: adicione alguns edits e um botão como abaixo

Adicione a unit untTEAMNumeric ao formulário:

unit untTEAMNumeric;

No ovento onClick do botão escreva o seguinte código:

procedure TForm1.btn1Click(Sender: TObject);
var
  EAMDouble:TEAMDouble;
  EAMInteger:TEAMInteger;
begin
 EAMDouble.Value := 99.989;
 EAMInteger.Value := 88;

  edtValorDouble.Text := EAMDouble.ToString.Text;
  edtArredonda.Text := FloatToStr(EAMDouble.Arredonda(1));
  edtTrunca.Text := FloatToStr(EAMDouble.Trunca(2));
  edtSqlServerFormat.Text := EAMDouble.ToSqlServerFormat.Text;
  edtExtencoReias.Text := EAMDouble.ToExtencoReais.Text;
  edtCalculaPercentual.Text := FloatToStr(EAMDouble.CalcularPercentual(50));

  edtValorInteger.Text := EAMInteger.ToString.Text;
  edtToString.Text := EAMInteger.ToString.Text;
  edtPriorValue.Text := IntToStr(EAMInteger.PriorValue);
  edtNextValue.Text := IntToStr(EAMInteger.NextValue);
  edtToExtencoInteger.Text := EAMInteger.ToExtenco.Text;


end;

Execute e confira o resultado:

Adicionar o tipo TEAMString nos novos tipos que criamos, nos fez poupar algum tempo nas conversões dos dados, isso sem mencionar que poderíamos realizar outras operações como realizar um hash.
Como exemplo adicone mais 2 edits no formulário de teste e o seguinte código no evento onClick do botão :

edtHashInteger.Text := EAMInteger.ToString.Hash;
 edtHashDouble.Text := EAMDouble.ToString.Hash;

Execute e confira o resultado:

Todos os métodos da listagem foram documentados para facilitar o entendimento da sua finalidade. Fique a vontade para adicionar novos métodos e procedures. :)

Observação: Algumas das procedure e functions usadas neste artigo são uma compilação de códigos encontrados na internet. se você econtrar aqui algum código de sua autoria, entre em contato para que possamos dar-lhe o devido crédito.

Confira aqui o próximo post

Criando um tipo de dado Avançado em Delphi - Parte 2

2011-08-04T12:23:00.000-03:00

No post anterior você conferiu como podemos usar o record do pascal apartir do Delphi 2006 para criar um tipo de dado mais avançado, que nos permitia agrupar as principais operações com string em um único tipo.
Agora vamos dar sequência ao artigo adicionando novas operações para o nosso dado:

TEAMString = record
    Text: string;

     { Substituição}
    function ReplaceChar(Caracter, Subst: char): string;

    {Remove os Espaços em branco }
    function Alltrim: string;
    function LTrim: string;
    function RTrim: string;

    {Conversão}
    function Lower: string;
    function Upper: string;
    function CaixaMista: string;

    {Pesquisa um caractere }
    function SearchLeft(Caracter: string): integer;
    function SearchRigth(Caracter: string): integer;

    {Variaveis}
    function Count: integer;
    function IsEmpty: Boolean;
    function Wordcount: integer;

    {Operações}
    function QuebraString(APosicao: Integer; ASeparador: string): string;
    function ReverseStr: string;
    function ToFloat: Double;
    function ToDateTime: TDateTime;
    function ToPChar: PChar;
    function ToFloatExtended: Extended;
    function ToCurrency: Currency;
    function ToCurrencyString: string;
    function ToInt: Integer;
    function ToCNPJCpf: string;
    function ToAspas: string;
    function ToCustomFormat(Mask: string): string;
    function Empty: string;

    function RemoveAcento: string;
    function RemoveChar(Caracter: char): string;
    function ReplicaChar(const Ch: Char; const Len: integer): string;
    function StrIntComZero(const Value, Len: integer): string;
    function Explode(const Ch: Char): TStringList;
    function ExplodeTrim(const Ch: Char): TStringList;
    function ExisteInt: Boolean;
    procedure StrResetLength(var S: AnsiString);
    function SubString(PosInicial, PosFinal: Integer): string;
    procedure Concate(Separador, Valor: string);
    procedure DeleteFinalText(Tam: Integer);
    function HashMD5: string;
    procedure ADD(s: string);
    procedure Clear;
    function ContemString(s: string): Boolean;
    procedure SetTextLength(Tam: integer);
    procedure ADDQuote(Separador, valor,Quote : string);

    function IsNumeric: Boolean;
    function IsFloat: Boolean;
    function IsInteger: Boolean;
    function IsDateTime: Boolean;

    { Operações PAD}
    function PadC(const Len: integer; const Ch: Char): string;
    function PadL(const Len: integer; const Ch: Char): string;
    function PadR(const Len: integer; const Ch: Char): string;

  end;

Repare que na nossa listagem temos funções para os mais variados fins, deste funções simples como apagar o conteúdo da string até uma função hash MD5 pronta pra ser usada. Dessa forma agrupamos as operações com string em um só lugar, organizando melhor o nosso código e deixando-o muito mais legível!

Vamos a implementação dos métodos:

unit untTEAMString;

unit untTEAMString;

interface
   uses Classes,SysUtils, IdGlobal, IdHash, IdHashMessageDigest;
type
  TEAMString = record
    Text: string;

     { Substituição}
    function ReplaceChar(Caracter, Subst: char): string;

    {Remove os Espaços em branco }
    function Alltrim: string;
    function LTrim: string;
    function RTrim: string;

    {Conversão}
    function Lower: string;
    function Upper: string;
    function CaixaMista: string;

    {Pesquisa um caractere }
    function SearchLeft(Caracter: string): integer;
    function SearchRigth(Caracter: string): integer;

    {Variaveis}
    function Count: integer;
    function IsEmpty: Boolean;
    function Wordcount: integer;

    {Operações}
    function QuebraString(APosicao: Integer; ASeparador: string): string;
    function ReverseStr: string;
    function ToFloat: Double;
    function ToDateTime: TDateTime;
    function ToPChar: PChar;
    function ToFloatExtended: Extended;
    function ToCurrency: Currency;
    function ToCurrencyString: string;
    function ToInt: Integer;
    function ToCNPJCpf: string;
    function ToAspas: string;
    function ToCustomFormat(Mask: string): string;
    function Empty: string;

    function RemoveAcento: string;
    function RemoveChar(Caracter: char): string;
    function ReplicaChar(const Ch: Char; const Len: integer): string;
    function StrIntComZero(const Value, Len: integer): string;
    function Explode(const Ch: Char): TStringList;
    function ExplodeTrim(const Ch: Char): TStringList;
    function ExisteInt: Boolean;
    function SubString(PosInicial, PosFinal: Integer): string;
    procedure Concate(Separador, Valor: string);
    procedure DeleteFinalText(Tam: Integer);
    function HashMD5: string;
    procedure ADD(s: string);
    procedure Clear;
    function ContemString(s: string): Boolean;
    procedure SetTextLength(Tam: integer);
    procedure ADDQuote(Separador, valor,Quote : string);

    function IsNumeric: Boolean;
    function IsFloat: Boolean;
    function IsInteger: Boolean;
    function IsDateTime: Boolean;

    { Operações PAD}
    function PadC(const Len: integer; const Ch: Char): string;
    function PadL(const Len: integer; const Ch: Char): string;
    function PadR(const Len: integer; const Ch: Char): string;
  end;


{ TEAMString }

{$ENDREGION}


implementation



{$REGION 'TEAMString'}

{ TEAMString }


function TEAMString.SubString(PosInicial, PosFinal: Integer): string;
begin
  Result := Copy(Self.Text, PosInicial, PosFinal - PosInicial);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.Concate
  Arguments: Separador, Valor: string
  Result:    None
  Objetivo:  Concatenar uma valor passado a string separado por um caracter
-------------------------------------------------------------------------------}

procedure TEAMString.Concate(Separador, Valor: string);
begin
  if Self.Text = '' then
    Self.Text := Self.Text + Valor
  else
    Self.Text := Self.Text + Separador + Valor;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ContemString
  Arguments: s: string
  Result:    Boolean
  Objetivo:  verifica se existe uma substring
-------------------------------------------------------------------------------}

function TEAMString.ContemString(s: string): Boolean;
begin
  Result := (Pos(s, Self.Text) > 0);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.Count
  Arguments: None
  Result:    integer
  Objetivo:  Retornar o tamanho da string
-------------------------------------------------------------------------------}

function TEAMString.Count: integer;
begin
  Result := Length(Self.Text);
end;


{-------------------------------------------------------------------------------
  Procedure: TEAMString.DeleteFinalText
  Arguments: Tam: Integer
  Result:    None
  Objetivo:  Apagar a ultima posicao da string
-------------------------------------------------------------------------------}
procedure TEAMString.DeleteFinalText(Tam: Integer);
begin
  Delete(Self.Text, (self.Count - Tam) + 1, Tam);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.CaixaMista
  Arguments: None
  Result:    None
  Objetivo:  Transforma a primeira letra dos nomes em Maiúscula
-------------------------------------------------------------------------------}

function TEAMString.CaixaMista: string;
var
  tam, pos1, pos2: integer;
  stPal, stTmp, stAux: string;
begin
  stAux := Self.Text;
  tam := Length(stAux);
  stAux := TrimRight(stAux) + ' ';
  stAux := AnsiUpperCase(stAux);
  while True do
  begin
    pos1 := POS(' ', stAux);
    if pos1 = 0 then
      break;
    stPal := Copy(stAux, 1, pos1);
    pos2 := pos(stPal, ' DA - DAS - DE - DO - DOS ');
    if pos2 > 0 then
      stPal := AnsiLowerCase(stPal)
    else
      stPal := Copy(stPal, 1, 1) + AnsiLowerCase(Copy(stPal, 2, tam));
    stTmp := stTmp + stPal;
    stAux := copy(stAux, pos1 + 1, tam)
  end;
  Result := stTmp;
end;


{-------------------------------------------------------------------------------
  Procedure: TEAMString.Clear
  Arguments: None
  Result:    None
  Objetivo:  Apagar o conteudo da string
-------------------------------------------------------------------------------}
procedure TEAMString.Clear;
begin
  Self.Text := '';
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ToCNPJ
  Arguments: None
  Result:    string
  Objetivo:  formata Cpf/Cnpj sem q o usuario tenha q digitar os pontos, traços e barra
-------------------------------------------------------------------------------}

function TEAMString.ToCNPJCpf: string;
var
  vTam, xx: Integer;
  vDoc: string;
begin
  vTam := Length(Self.Text);
  for xx := 1 to vTam do
    if (Copy(Self.Text, xx, 1) <> '.') and (Copy(Self.Text, xx, 1) <> '-') and (Copy(Self.Text, xx, 1) <> '/') then
      vDoc := vDoc + Copy(Self.Text, xx, 1);
  Self.Text := vDoc;
  vTam := Length(Self.Text);
  vDoc := '';
  vDoc := '';
  for xx := 1 to vTam do
  begin
    vDoc := vDoc + Copy(Self.Text, xx, 1);
    if vTam = 11 then
    begin
      if (xx in [3, 6]) then
        vDoc := vDoc + '.';
      if xx = 9 then
        vDoc := vDoc + '-';
    end;
    if vTam = 14 then
    begin
      if (xx in [2, 5]) then
        vDoc := vDoc + '.';
      if xx = 8 then
        vDoc := vDoc + '/';
      if xx = 12 then
        vDoc := vDoc + '-';
    end;
  end;
  Result := vDoc;
end;


{-------------------------------------------------------------------------------
  Procedure: TEAMString.Empty
  Arguments: None
  Result:    string
  Objetivo:  Retornar uma string Vazia
-------------------------------------------------------------------------------}
function TEAMString.Empty: string;
begin
  result := '';
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ExisteInt
  Arguments: None
  Result:    Boolean
  Objetivo:  Testar se na string existe um numero inteiro valido ou não
-------------------------------------------------------------------------------}

function TEAMString.ExisteInt: Boolean;
begin
  try
    StrToInt(Text);
    Result := True;
  except
    Result := False;
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.Explode
  Arguments: const Ch: Char
  Result:    TStringList
  Objetivo:   Explodir a string em uma TStringList de acordo com o carater separador
-------------------------------------------------------------------------------}

function TEAMString.Explode(const Ch: Char): TStringList;
var
  c: word;
  Source: string;
begin
  Result := TStringList.Create;
  c := 0;

  Source := Self.Text;
  while source <> '' do
  begin
    if Pos(CH, source) > 0 then
    begin
      Result.Add(Copy(Source, 1, Pos(CH, source) - 1));
      Delete(Source, 1, Length(Result[c]) + Length(CH));
    end
    else
    begin
      Result.Add(Source);
      Source := '';
    end;
    inc(c);
  end;
end;
 {-------------------------------------------------------------------------------
  Procedure: TEAMString.Explode
  Arguments: const Ch: Char
  Result:    TStringList
  Objetivo:  Explodir a string em uma TStringList de acordo com o carater separador
  removendo os espaços em branco
-------------------------------------------------------------------------------}

function TEAMString.ExplodeTrim(const Ch: Char): TStringList;
var
  I: Integer;
begin
  Result := Self.Explode(ch);

  for I := 0 to Result.Count - 1 do
  begin
    Result.Strings[i] := Trim(Result.Strings[i]);
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.IsDateTime
  Arguments: self.value: string
  Result:    Boolean
  Objetivo:  Verificar se a string é do tipo DateTime
-------------------------------------------------------------------------------}

function TEAMString.IsDateTime: Boolean;
var
  i: Integer;
begin
  if (self.Text = '') then
  begin
    Result := False;
    Exit;
  end;

  Result := True;

  for i := 1 to Length(self.Text) do
    if not (self.Text[i] in ['0'..'9', DateSeparator]) then
    begin
      Result := False;
      Break;
    end;

end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.IsEmpty
  Arguments: inString: string
  Result:    Boolean
  Objetivo:  Verificar se a string está vazia
-------------------------------------------------------------------------------}

function TEAMString.IsEmpty: Boolean;
begin
  Result := (self.Text = '');
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.IsFloat
  Arguments: None
  Result:    Boolean
  Objetivo:  Verificar se a string é um float
-------------------------------------------------------------------------------}

function TEAMString.IsFloat: Boolean;
var
  Value: Extended;
begin
  Result := TextToFloat(Self.ToPChar, Value, fvExtended);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.IsInteger
  Arguments:
  Result:    Boolean
  Objetivo:  Verificar se a string é um inteiro
-------------------------------------------------------------------------------}

function TEAMString.IsInteger(): Boolean;
begin
  if (Pos('.', Self.Text) > 0) or not IsNumeric then
  begin
    Result := False;
    Exit;
  end;

  try
    StrToInt(Self.Text);
    Result := True;
  except
    Result := False;
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.IsNumeric
  Arguments: None
  Result:    Boolean
  Objetivo:  Verificar se a string contem caracteres numericos
-------------------------------------------------------------------------------}

function TEAMString.IsNumeric: Boolean;
var
  i: Integer;
begin
  if (Self.Text = '') then
  begin
    Result := False;
    Exit;
  end;

  Result := True;

  for i := 1 to Length(Self.Text) do
    if not (self.Text[i] in ['0'..'9', '.', ',']) then
    begin
      Result := False;
      Break;
    end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.Lowercase_S
  Arguments: None
  Result:    None
  Objetivo:  Converter a string para minusculo
-------------------------------------------------------------------------------}

function TEAMString.Lower: string;
begin
  Result := LowerCase(self.Text);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.LTrim
  Arguments: None
  Result:    None
  Objetivo:  Remove os Espaços em branco à esquerda da string
-------------------------------------------------------------------------------}

function TEAMString.LTrim: string;
var
  I: Integer;
begin
  I := 0;
  while True do
  begin
    inc(I);
    if I > length(self.Text) then
      break;
    if self.Text[I] <> #32 then
      break;
  end;
  Result := Copy(self.Text, I, length(self.Text));
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.MD5
 11/2/2011
  Arguments: None
  Result:    string
  Objetivo:  Retorna o Md5 da string
-------------------------------------------------------------------------------}

function TEAMString.HashMD5: string;
begin
  with TIdHashMessageDigest5.Create do
    try
      Result := TIdHash128.AsHex(HashValue(Self.Text));
    finally
      Free;
    end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.QuebraString
  Arguments: APosicao: Integer; ASeparador: string
  Result:    string
  Objetivo:  Retornar o que está após o separador
-------------------------------------------------------------------------------}

function TEAMString.QuebraString(APosicao: Integer; ASeparador: string): string;
var
  i, cont: integer;
begin
  cont := 0;
  if (APosicao <= 0) then
    exit;
  for i := 0 to length(self.Text) do
  begin
    if self.Text[i] = ASeparador then
    begin
      inc(cont);
    end;
    if cont = APosicao then
    begin
      Result := self.Text[i];
    end;
  end;

end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.RemoveAcento
  Arguments: None
  Result:    None
  Objetivo:  Remover os acentos da string
-------------------------------------------------------------------------------}

function TEAMString.RemoveAcento: string;
const
  ComAcento = 'àâêôûãõáéíóúçüÀÂÊÔÛÃÕÁÉÍÓÚÇÜ';
  SemAcento = 'aaeouaoaeioucuAAEOUAOAEIOUCU';
var
  x: Integer;
begin

  Result := Self.Text;
  for x := 1 to Length(Self.Text) do
  begin
    if Pos(Self.Text[x], ComAcento) <> 0 then
      Result[x] := SemAcento[Pos(Text[x], ComAcento)]
  end;
end;


{-------------------------------------------------------------------------------
  Procedure: TEAMString.RemoveChar
  Arguments: Caracter: char
  Result:    string
  Objetivo:  Remove o caracter passado da string
-------------------------------------------------------------------------------}
function TEAMString.RemoveChar(Caracter: char): string;
var
  i: integer;
begin
  Result := '';
  for i := 1 to length(self.Text) do
  begin
    if self.Text[i] <> Caracter then
    begin
      Result := Result + Self.Text[i];
    end;
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ReplaceChar
  Arguments: Caracter, Subst: char
  Result:    None
  Objetivo:  Substiuir um caracter  dentro da string
-------------------------------------------------------------------------------}

function TEAMString.ReplaceChar(Caracter, Subst: char): string;
var
  i: integer;
begin
  Result := Self.Text;
  for i := 0 to length(self.Text) do
  begin
    if self.Text[i] = Caracter then
    begin
      Result[i] := Subst;
    end;
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ReplChar
  Arguments: const Ch: Char; const Len: integer
  Result:    string
  Objetivo:  Replica um caractere n vezes formando uma string
-------------------------------------------------------------------------------}

function TEAMString.ReplicaChar(const Ch: Char; const Len: integer): string;
var
  I: integer;
begin
  SetLength(Result, Len);
  for I := 1 to Len do
    Result[I] := Ch;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ReverseStr
  Arguments: None
  Result:    string
  Objetivo:  Retornar o inverso da string
-------------------------------------------------------------------------------}

function TEAMString.ReverseStr: string;
var
  I: Integer;
begin
  Result := '';
  for I := Length(self.Text) downto 1 do
    Result := Result + self.Text[I];
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.RTrim
  Arguments: None
  Result:    None
  Objetivo:  Remover os espaços em branco a direita da string
-------------------------------------------------------------------------------}

function TEAMString.RTrim: string;
var
  I: Integer;
begin
  I := length(self.Text) + 1;
  while True do
  begin
    Dec(I);
    if I <= 0 then
      break;
    if self.Text[I] <> #32 then
      break;
  end;
  Result := Copy(self.Text, 1, I);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.SearchLeft
  Arguments: Caracter: string; PosInicial: integer
  Result:    integer
  Objetivo:  Pesquisa um caractere à esquerda da string, retornando sua posição
-------------------------------------------------------------------------------}

function TEAMString.SearchLeft(Caracter: string): integer;
var
  i: integer;
begin
  result := -1;
  for i := 0 to length(self.Text) do
  begin
    if self.Text[i] = Caracter then
    begin
      Result := i;
      exit;
    end;
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.SearchRigth
  Arguments: Caracter: string; PosInicial: integer
  Result:    integer
  Objetivo:  Pesquisa um caractere à direita da string, retornando sua posição
-------------------------------------------------------------------------------}

function TEAMString.SearchRigth(Caracter: string): integer;
var
  i: integer;
begin
  result := -1;
  for i := length(self.Text) downto 0 do
  begin
    if self.Text[i] = Caracter then
    begin
      Result := i;
      exit;
    end;
  end;
end;

procedure TEAMString.SetTextLength(Tam: integer);
begin
  Self.Text := StringOfChar(' ', Tam);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.StrIntComZero
  Arguments: const Value, Len: integer
  Result:    string
  Objetivo:  Forma um número inteiro com zeros à esquerda
-------------------------------------------------------------------------------}

function TEAMString.StrIntComZero(const Value, Len: integer): string;
var
  I: integer;
begin
  Result := IntToStr(Value);
  I := Length(Result);
  if I < Len then
    Result := Self.ReplicaChar('0', Len - I) + Result
  else if I > Len then
    Result := ReplicaChar('*', Len);

end;


{-------------------------------------------------------------------------------
  Procedure: TEAMString.ToAspas
  Author:    Evaldo
  DateTime:  04/08/2011
  Arguments: None
  Result:    string
  Objetivo:  Retornar uma string com aspas
-------------------------------------------------------------------------------}
function TEAMString.ToAspas: string;
begin
  Result := QuotedStr(Self.Text);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ToCurrency

  DateTime:  10/6/2010
  Arguments: None
  Result:    Currency
  Objetivo:  Converter para Currency
-------------------------------------------------------------------------------}

function TEAMString.ToCurrency: Currency;
begin
  Result := StrToCurr(Self.Text);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ToCurrencyString
  Arguments: None
  Result:    string
  Objetivo:  Formatar um valor double em monetário
-------------------------------------------------------------------------------}

function TEAMString.ToCurrencyString: string;
begin
  Result := 'R$ ' + FormatCurr('0.,00', Self.ToCurrency);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ToCustomFormat
  Author:    Evaldo
  DateTime:  04/08/2011
  Arguments: Mask: string
  Result:    string
  Objetivo:  Mascara customizada
-------------------------------------------------------------------------------}
function TEAMString.ToCustomFormat(Mask: string): string;
begin
  result := Format(Mask, [Self.Text])
end;


{-------------------------------------------------------------------------------
  Procedure: TEAMString.ToDateTime
  Author:    Evaldo
  DateTime:  04/08/2011
  Arguments: None
  Result:    TDateTime
  Objetivo:  Converte para DataHora
-------------------------------------------------------------------------------}
function TEAMString.ToDateTime: TDateTime;
begin
  Result := StrToDateTime(Self.Text);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ToFloat
  Arguments: None
  Result:    Extended
  Objetivo:  Filtra uma string qualquer, convertendo as suas partes
  numéricas para sua representação decimal, por exemplo:
  'R$ 1.200,00' para 1200,00 '1AB34TZ' para 134
-------------------------------------------------------------------------------}

function TEAMString.ToFloat: Double;
var
  Aux: string;
begin
  Aux := self.ReplaceChar('.', ',');

  Result := StrToFloat(aux);
end;

function TEAMString.ToFloatExtended: Extended;
var
  i: Integer;
  stAux: string;
  blSeenDecimal, blSeenSgn: Boolean;
begin
  stAux := '';
  blSeenDecimal := False;
  blSeenSgn := False;
  {Percorre os caracteres da string:}
  for i := Length(Self.Text) downto 0 do
    {Filtra a string, aceitando somente números e separador decimal:}
    if (Self.Text[i] in ['0'..'9', '-', '+', DecimalSeparator]) then
    begin
      if (Self.Text[i] = DecimalSeparator) and (not blSeenDecimal) then
      begin
        stAux := Self.Text[i] + stAux;
        blSeenDecimal := True;
      end
      else if (Self.Text[i] in ['+', '-']) and (not blSeenSgn) and (i = 1) then
      begin
        stAux := Self.Text[i] + stAux;
        blSeenSgn := True;
      end
      else if Self.Text[i] in ['0'..'9'] then
      begin
        stAux := Self.Text[i] + stAux;
      end;
    end;
  Result := StrToFloat(stAux);

end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ToInt

  DateTime:  7/6/2010
  Arguments: None
  Result:    Integer
  Objetivo:  Converter para inteiro
-------------------------------------------------------------------------------}

function TEAMString.ToInt: Integer;
begin
  Result := StrToInt(Self.Text);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ToPChar


  Arguments: None
  Result:    PChar
  Objetivo:  Retornar um ponteiro para char
-------------------------------------------------------------------------------}

function TEAMString.ToPChar: PChar;
{Converte String em Pchar}
type
  TRingIndex = 0..7;
var
  Ring: array[TRingIndex] of PChar;
  RingIndex: TRingIndex;
  Ptr: PChar;
begin
  Ptr := @self.Text[Length(self.Text)];
  Inc(Ptr);
  if Ptr^ = #0 then
  begin
    Result := @self.Text[1];
  end
  else
  begin
    Result := StrAlloc(Length(self.Text) + 1);
    RingIndex := (RingIndex + 1) mod (High(TRingIndex) + 1);
    StrPCopy(Result, self.Text);
    StrDispose(Ring[RingIndex]);
    Ring[RingIndex] := Result;
  end;

end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.Alltrim


  Arguments: None
  Result:    None
  Objetivo:  Remover os espaços em branco a direita e a esquerda da string
-------------------------------------------------------------------------------}

procedure TEAMString.ADD(s: string);
begin
  Self.Text := Self.Text + s;
end;


{-------------------------------------------------------------------------------
  Procedure: TEAMString.ADDQuote
  Author:    Evaldo
  DateTime:  04/08/2011
  Arguments: Separador, valor,Quote:string
  Result:    None
  Objetivo:  Retorna uma string com um separador e um Quote
-------------------------------------------------------------------------------}
procedure TEAMString.ADDQuote(Separador,  valor,Quote:string);
begin
  if Self.IsEmpty then
    Self.Text := Self.Text + Quote + valor + Quote
  else
    Self.Text := Self.Text + Separador + Quote + valor + Quote;
end;
{-------------------------------------------------------------------------------
  Procedure: TEAMString.Alltrim
  Arguments: None
  Result:    string
  Objetivo:  Remove os espaços em Branco de uma string
-------------------------------------------------------------------------------}
function TEAMString.Alltrim: string;
begin
  Result := Trim(Text);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.UpperCase_s
  Arguments: None
  Result:    None
  Objetivo:  Converter a string para maiúsculo
-------------------------------------------------------------------------------}

function TEAMString.Upper: string;
begin
  Result := UpperCase(self.Text);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.wordcount
  Arguments: None
  Result:    integer
  Objetivo:  Retorna o número de palavras que contem em uma string
-------------------------------------------------------------------------------}

function TEAMString.Wordcount: integer;
var
  i: integer;
  len: integer;
begin
  len := length(Self.Text);
  Result := 0;
  i := 1;
  while i <= len do
  begin
    while ((i <= len) and ((Self.Text[i] = #32) or (Self.Text[i] = #9) or
      (Self.Text[i] = ';'))) do
      inc(i);
    if i <= len then
      inc(Result);
    while ((i <= len) and ((Self.Text[i] <> #32) and (Self.Text[i] <> #9) and
      (Self.Text[i] <>
      ';'))) do
      inc(i);
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.PadC
  Arguments: const Len: integer; const Ch: Char
  Result:    string
  Objetivo:  Completa a string com caracter passado a esquerda e a direita da string
  de acordo com o tamanho indicado
-------------------------------------------------------------------------------}

function TEAMString.PadC(const Len: integer; const Ch: Char): string;
var
  I, J: integer;
  Pad: string;
  Impar: boolean;
begin
  I := Length(self.Text);
  if I < Len then
  begin
    J := Len - I;
    Impar := J mod 2 = 1;
    J := J div 2;
    Pad := self.ReplicaChar(Ch, J);
    Result := Pad + Self.Text + Pad;
    if Impar then
      Result := Result + Ch;
  end
  else if I > Len then
  begin
    J := I - Len;
    Impar := J mod 2 = 1;
    J := J div 2;
    Result := Self.Text;
    Delete(Result, I - J + 1, J);
    Delete(Result, 1, J);
    if Impar then
    begin
      Dec(I, J * 2);
      Delete(Result, I, 1);
    end;
  end
  else
    Result := Self.Text;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.PadL
  Arguments: const Len: integer; const Ch: Char
  Result:    string
  Objetivo:  Completa a string com caracter passado a esquerda da string de acordo com o tamanho indicado
-------------------------------------------------------------------------------}

function TEAMString.PadL(const Len: integer; const Ch: Char): string;
var
  LenS: integer;
begin
  LenS := Length(Self.Text);
  if LenS < Len then
    Result := self.ReplicaChar(Ch, Len - LenS) + self.Text
  else if LenS > Len then
    Result := Copy(self.Text, LenS - Len + 1, Len)
  else
    Result := self.Text;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.PadR
  Arguments: const Len: integer; const Ch: Char
  Result:    string
  Objetivo:  Completa a string com caracter passado a direita da string de acordo com o tamanho indicado
-------------------------------------------------------------------------------}

function TEAMString.PadR(const Len: integer; const Ch: Char): string;
var
  LenS: integer;
begin
  LenS := Length(self.Text);
  if LenS < Len then
    Result := self.Text + self.ReplicaChar(Ch, Len - LenS)
  else if LenS > Len then
    Result := Copy(self.Text, 1, Len)
  else
    Result := self.Text;
end;

{$ENDREGION}

end.

Adicione alguns edits para o formulário de teste como abaixo:

Adicione o seguinte código no onCLick do botão "ok" :

procedure TForm1.btn1Click(Sender: TObject);
var
  EAMString:TEAMString;
begin
  EAMString.Text := ' Teste ';

  edtTexto.Text := EAMString.Text;
  edtTrimALL.Text := EAMString.Alltrim;
  edtTrimL.Text := EAMString.LTrim;
  edtTrimR.Text := EAMString.RTrim;
  edtHash.Text := EAMString.HashMD5;
  edtPADL.Text := EAMString.PadL(10,'0');
  edtReverseStr.Text := EAMString.ReverseStr;
  edtToAspas.Text := EAMString.ToAspas;
end;

Execute a aplicação e observe o resultado:

Todos os métodos da listagem foram documentados para facilitar o entendimento da sua finalidade. Fique a vontade para adicionar novos métodos e procedures. :)

Confira aqui o próximo post

Observação: Algumas das procedure e functions usadas neste artigo são uma compilação de códigos encontrados na internet. se você econtrar aqui algum código de sua autoria, entre em contato para que possamos dar-lhe o devido crédito.

Criando um tipo de dado Avançado em Delphi - Parte 1

2011-08-03T15:42:00.000-03:00

Criando um tipo de dado Avançado em Delphi:

Talvez você não saiba, mas o tipo record em pascal pode conter em sua estrutura functions e procedures desde o Delphi 2006, Sendo assim nos podemos tirar proveito disso para criar um tipo de dado mais avançado.
Vamos tomar como exemplo o tipo string. O que você consegue fazer com um dado do tipo string? Nada, apenas usar para guardar o seu conteúdo. Qualquer operação que você precise realizar nesse dado terá que usar alguma função externa.
Para contornar isso, podemos usar o record para criar um tipo de dado mais avançado e como exemplo vamos criar um tipo TEAMString (o nome é sugestivo) :

Abra o delphi (neste artigo fora utilizado o Delphi 2007) e crie um novo projeto para aplicação:

Agora adicione uma nova unit e salve-a como untTEAMString:

Agora estamos pronto para começar! Vamos criar o record:

unit untTEAMString;

interface
 uses Classes,SysUtils;
type
  TEAMString = record
    Text: string;
  end;

implementation

end.

Repare que o nosso Tipo TEAMString possui um campo "Text" esse campo nós vamos usar para guardar uma string e posteriormente aplicar operações nesse dado.

Agora vamos adicionar algumas operações mais comuns com strings para deixar esse nosso tipo mais parrudo. Para começar vamos utilizar as operações para remover espaços em branco no inicio, no final e no inicio e no final de uma string. Então vamos adiciona-las:

TEAMString = record
    Text: string;

    {Remove os Espaços em branco }
    function Alltrim: string;
    function LTrim: string;
    function RTrim: string;

  end;

Agora a implementação:

uses Classes,SysUtils;

type
  
TEAMString = record
    Text: string;

    {Remove os Espaços em branco }
    function Alltrim: string;
    function LTrim: string;
    function RTrim: string;

  end;

implementation

{ TEAMString }

// Objetivo:  Remove os Espaços em branco
function TEAMString.Alltrim: string;
begin
  Result := Trim(Text);
end;

// Objetivo:  Remove os Espaços em branco à esquerda da string
function TEAMString.LTrim: string;
var
  I: Integer;
begin
  I := 0;
  while True do
  begin
    inc(I);
    if I > length(self.Text) then
      break;
    if self.Text[I] <> #32 then
      break;
  end;
  Result := Copy(self.Text, I, length(self.Text));
end;

//Objetivo:  Remover os espaços em branco a direita da string
function TEAMString.RTrim: string;
var
  I: Integer;
begin
  I := length(self.Text) + 1;
  while True do
  begin
    Dec(I);
    if I <= 0 then
      break;
    if self.Text[I] <> #32 then
      break;
  end;
  Result := Copy(self.Text, 1, I);
end;

end.

Agora já temos alguma funcionalidade para esse nosso tipo. Vamos Fazer um pequeno teste.
No formulário da aplicação adicione um botão e 4 edits. Também não se esqueça de adcionar
a untTEAMString no USES do formulário:

uses Classes,SysUtils;

Codificando o botão:
Declare uma variável do tipo TEAMString e atribua a ela o valor do Edit texto. Em seguida, atribua os aos outros edits o resultado das operações:

procedure TForm1.btn1Click(Sender: TObject);
var
  EAMString:TEAMString;
begin
  EAMString.Text := edtTexto.Text;
  edtTrimALL.Text := EAMString.Alltrim;
  edtTrimL.Text := EAMString.LTrim;
  edtTrimR.Text := EAMString.RTrim;
end;

Rode a aplicação insira um texto com espaços a esquerda e a direita e clique no botão Ok:

Se você selecionar o texto com o mouse podera observar que o espaço em branco foi removido no Edit "Trim ALL" e removido a esquerda no Edit "Trim Left" e a direita no "Edit Trim Right".
Repare que realizamos algumas operações no dado sem ter o seu conteúdo alterado e sem precisar usar funções externas, deixando o nosso código muito mais limpo e legível! Isso sem falar na produtividade que aumentara consideravelmente.
Já imaginou no que da para fazer? Nos próximos posts vamos adicionar novas funcionalidades e criar novos tipos avançados.

Confira aqui a segunda parte desse Artigo

Instalando o Driver USB das Impressoras Fiscais da Bematech no Windows 7

2011-07-26T10:25:00.000-03:00

Instalando o Driver USB das Impressoras Fiscais da Bematech no Windows 7

Primeiro baixe o Driver aqui. Em seguida descompacte o instalador em um diretório em seu computador:

Após a extração, execute o arquivo “bemafi32.exe”:

Escolha um diretório para salvar os arquivos e clique em instalar:

Verifique os arquivos extraidos:

Agora vá em "meu computador-> Gerenciador de dispositivo" e localize o dispositivo USB relativo a impressora:

Agora clique com o botão direito sobre o dispositivo desconhecido e escolha propriedades:

Agora vá na aba Driver e clique em Atualizar Driver:

Na tela seguinte, clique em procurar no meu computador:

Agora clique em procurar em uma lista de drivers:

Agora clique no botão Disco para procurar o driver:

Navegue até a pasta onde você extraiu os arquivos:

E escolha o arquivo UsbioR1.inf e clique em ok:

Selecione o driver da Bematech e clique em Próximo:

Ignore o aviso de segurança do windows e clique em instalar o driver:

Se tudo ocorreu bem o driver será instalado com sucesso:

Agora acesse o arquivo bemafi32.ini (geralmente fica no diretório c:\windows\system32) e modifique a chave "porta" para USB:

Depois destes passos a impressora estará pronta para funcionar pela porta USB no Windows 7.

2011-05-19T22:14:00.000-03:00

FreeRapid Downloader em dual boot

O FreeRapid Downloader é um excelente gerenciador de downloads de servidores de hospedagem open source. Atualmente ele suporta mais de 230 servidores de hospedagem, dentre os quais estão:

MediaFire.com
Megaupload.com
Hotfile.com
FileFactory.com
Filebase.to
Uploaded.to
DepositFiles.com
Share-online.biz
Storage.to
Uploading.co

O FreeRapid Downloader permite também salvar vídeos do youtube, basta copiar a url com o aplicativo aberto que ele detecta automaticamente que é um vídeo e oferece a opção de download.

O mesmo vale para os todos os servidores suportados: Ele detecta de qual servidor é a url e se for preciso inserir captcha, ele irá exibir um campo com a imagem. O aplicativo permite incluir várias urls de diferentes servidores ao mesmo tempo, pausar os downloads, calcular o tempo restante até o termino, exibir a velocidade da conexão, dentre outros.

O português está incluído na galeria de idiomas suportados, o que facilita muito para usuários brasileiros.

O FreeRapid Downloader é muti-plataforma, o que nos permite usá-lo em dual boot. Para começar escolha um diretório compartilhado com os 2 sistemas operacionais onde ficararam os arquivos do aplicativo. Para este artigo foi escolhido o diretório montado no linux:

/home/dados/frd

Para executar no linux você pode usar o arquivo frd.sh disponível no diretório do FreeRapid Downloader ou então digitar no console:

java -jar frd.jar

Para que ele funcione em dual boot no Windows vamos precisar criar um arquivo bat com o seguinte comando:

frd.exe -p

O -p diz para o FreeRapid Downloader ser portabel, ou seja, usar o diretório de configuração local, a pasta config. Em seguida é só executar o arquivo bat.

È recomendado também que ao escolher o diretório para salvar os arquivos, você escolha um que esteja acessível aos dois sistemas operacionais, assim ao começar o download em um sistema, você pode terminar no outro.

Está técnica também pode ser usada para fazer backup dos downloads ainda em andamento do FreeRapid Downloader no windows. Bastando apenas salvar o diretório onde o aplicativo está salvo e copia-lo para um lugar seguro. No linux, ele já salva no diretório local.

Obs: Para que o FreeRapid Downloader funcione corretamente é preciso ter instalado o Java no computador.

Abaixo, um vídeo de que da mais detalhes do uso do FreeRapid Downloader:

Mais informações na página oficial do projeto :

http://wordrider.net/freerapid/download.html

Є & V

Delphi - The action must be retried

Como Evitar Pegar Vírus e Bloquear Propagandas na Internet

Tanto no Firefox, como no Google Chorme, você consegue instalar extensões que melhoram o navegador, como tradutores, dicionários, etc.Existe uma extensão para os dois navegadores que se chama AdBlock Plus.

Para quem usa Firefox é só abrir o link e clicar em Download. https://addons.mozilla.org/en-US/android/addon/adblock-plus/?src=category

Para quem usa Chorme, abrir o link abaixo e clicar em "Adicionar para Chrome".https://chrome.google.com/webstore/detail/adblock-plus/cfhdojbkjhnklbpkdaibdccddilifddbO AdBlock Plus está disponível também para o firefox mobile no Android, e funciona da mesma forma que o desktop.

Delphi + Zeos: Não foi possível conectar ao Oracle 11g

Como mudar o idioma do NetBeans

Milestone 3 XT860:Rom Steel Droid 4.5

Eclipse - Waiting for xdebug session

Delphi - Exibindo diálogos no estilo jquery

jQueryUI - Cahe Auto Complete com Jsonu

ACBR Exibindo o MD5 No campo de Informações Complementares do Danfe

Preparando o Mint/Ubuntu para desenvolver com Pyqt4

Instalando o PyQt4 no Linux Mint/Ubuntu

Rom Eclipse no Milestone 3/Droid 3 (XT860) - Parte 1

Rom Eclipse no Milestone 3/Droid 3 (XT860) - Parte 2

Rom Eclipse no Milestone 3/Droid 3 (XT860) - Parte 3

Rom Eclipse no Milestone 3/Droid 3 (XT860) - Parte 4

Rom Eclipse no Milestone 3/Droid 3 (XT860) - Parte 5

Rom Eclipse no Milestone 3/Droid 3 (XT860) - Parte 6

Python: Download File from web

Desenvolvimento de sistemas de Informação nas organizações

INTRODUÇÃO

FUNDAMENTAÇÃO TEÓRICA

1.1 Organização Empresarial no Contexto de um SI

Criando um tipo de dado Avançado em Delphi - Parte 5

Criando um tipo de dado Avançado em Delphi - Parte 4

Criando um tipo de dado Avançado em Delphi - Parte 3

Criando um tipo de dado Avançado em Delphi - Parte 2

Criando um tipo de dado Avançado em Delphi - Parte 1

Instalando o Driver USB das Impressoras Fiscais da Bematech no Windows 7

Tanto no Firefox, como no Google Chorme, você consegue instalar extensões que melhoram o navegador, como tradutores, dicionários, etc.
Existe uma extensão para os dois navegadores que se chama AdBlock Plus.

Para quem usa Firefox é só abrir o link e clicar em Download.
https://addons.mozilla.org/en-US/android/addon/adblock-plus/?src=category

Para quem usa Chorme, abrir o link abaixo e clicar em "Adicionar para Chrome".
https://chrome.google.com/webstore/detail/adblock-plus/cfhdojbkjhnklbpkdaibdccddilifddbO AdBlock Plus está disponível também para o firefox mobile no Android, e funciona da mesma forma que o desktop.