Fechar

quarta-feira, 21 de setembro de 2011

Python: Download File from web

0 comentários
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.

sexta-feira, 26 de agosto de 2011

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

0 comentários

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

sábado, 6 de agosto de 2011

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

1 comentários
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"

sexta-feira, 5 de agosto de 2011

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

0 comentários
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.

quinta-feira, 4 de agosto de 2011

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

0 comentários
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

Mais Populares

Seguidores

Є & V. Copyright 2011 Evaldo Avelar Marques - sprintrade network