Buscar arquivos e guardar resultado em tabela

Abaixo vamos ter uma rotina que costumo usar para pesquisar arquivos via progress.

Esta rotina possui uma falha pois não consegue reconhecer arquivos que tenham espaço no nome.

define temp-table tt-local
    field caminho as character format "x(25)"
    field dt-mod  as date
    field nome    as character format "x(25)"
    field tipo    as character.

define variable pPath         as character no-undo.
define variable pTipo         as character no-undo.
define variable pLerSubpastas as logical   no-undo.

/* Aqui vamos definir os parametros da pesquisa */
assign
    pPath = "C:\"
    pTipo = "*.*"
    pLerSubpastas = false.

if pLerSubpastas = true then
    INPUT  THROUGH  VALUE("dir /b/s " + pPath + pTipo).
else
    INPUT  THROUGH  VALUE("dir /b " + pPath + pTipo).

REPEAT:
    create tt-local.
    IMPORT tt-local no-error.

    /* Quando não inclui busca subpastas o dir só retorna o nome do arquivo. */
    if pLerSubpastas = false then
        assign tt-local.caminho = pPath + tt-local.caminho.
END.                                                                                          
INPUT CLOSE.

for each tt-local:
    /* Sempre traz um registro em branco, vamos exclui-lo */
    if tt-local.caminho = "" then do:
        delete tt-local.
        next.
    END.

    /* Obtemos os atributos do arquivo */
    ASSIGN file-info:FILE-NAME = tt-local.caminho.

    /* Só queremos arquivos, então se for uma pasta ou tipo não identificado vamos exclui-lo */
    assign tt-local.tipo  = file-info:FILE-TYPE.
    if index(tt-local.tipo, "D") > 0 
    or tt-local.tipo = ? then do:
        delete tt-local.
        next.
    END.

    assign tt-local.dt-mod  = DATE(FILE-INFO:FILE-MOD-DATE) no-error.
    assign tt-local.nome  = file-info:FILE-NAME.

    /* Vamos extrair o nome do arquivo */
    assign tt-local.nome = substring(tt-local.caminho, r-index(tt-local.caminho, '\') + 1).
    assign tt-local.nome = substring(tt-local.nome, 1, r-index(tt-local.nome, '.') - 1).

    DISPLAY tt-local with width 500.
end.

Veja o resultado da pesquisa por arquivos com extensão TXT no meu C:

Resultado pesquisa arquivos progress4gl

Deixe um comentário

O seu endereço de e-mail não será publicado. Campos obrigatórios são marcados com *

Esse site utiliza o Akismet para reduzir spam. Aprenda como seus dados de comentários são processados.