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

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"