Localizando e consultando arquivos com o FileSystemObject

São frequentes as perguntas em fórum de discussão sobre como manipular arquivos em disco com o VB e não raro pergunta-se como localizar um determinado arquivo no disco utilizando o VB.

Existe um componente COM disponível no Windows chamado FileSystemObject. O VB pode manipular este componente para ter acesso ao sistema de disco da máquina.

Vamos fazer um mecanismo de busca de arquivos em disco.

O usuário poderá digitar na txtProcurar o nome do arquivo que ele deseja localizar, podendo usar máscaras (*.txt) por exemplo. Ao clicar no botão cmdencontrar será feita a busca do arquivo em todo o HD e o resultado será mostrado na lstarquivos. O label servirá para mostrar o diretório que está sendo pesquisado no momento.

Temos aqui um excelente uso para a recursividade. Cada diretório poderá ter subdiretórios e estes mais subdiretórios e assim por diante. Assim deveremos criar uma sub que receba um objeto Folder do filesystemobject. Primeiramente ela verificará os arquivos contidos na própria pasta, caso atendam ao critério de busca ela exibirá os arquivos na listbox.

Tendo verificado todos os arquivos da folder, a função deverá fazer uma verificação em cada uma das subpastas existentes. Desta forma a função irá chamar ela mesma passando como parâmetro uma das subpastas, então ela chamará ela mesma tantas vezes quanto forem as subpastas da pasta atual.

O mesmo se repetirá continuamente para as subpastas, as subsubpastas e assim por diante. A técnica de fazer com que uma função chame ela mesma é chamada de recursividade.

Precisaremos declarar o objeto FileSystemObject. Teremos que fazer um references (Project -> References) para a biblioteca do FileSystemObject (Microsoft Scripting Runtime) e definir uma variável deste tipo.

O botão, por sua vez, precisará chamar a função de localização (vamos chama-la de AchaArquivos) transmitindo a pasta inicial (vamos considerar como sendo C:\)

Veja como fica:

Dim fso As New FileSystemObject
Private Sub cmdEncontrar_Click()
txtProcurar.Text = UCase(txtProcurar.Text)
AchaArquivos fso.GetFolder("c:\")
End Sub

Observe que o Ucase na textbox foi aplicado já neste ponto para que desta forma seja feito uma única vez, ganhando-se performance.

O método GetFolder do objeto FileSystemObject recupera um objeto Folder (pertence à biblioteca do FileSystemObject). Assim sendo estamos transmitindo para a função AchaArquivos o objeto Folder relativo a pasta C:\, veja:

Sub AchaArquivos(f As Folder)
End Sub

Precisaremos então fazer a verificação de todos os arquivos contidos na pasta. O objeto Folder possui uma propriedade chamada Files que contém tais arquivos. Podemos fazer um For/each, mas para isso precisaremos de uma variável do tipo File. Veja como fica:

Sub AchaArquivos(f As Folder)
Dim a As File
  For Each a In f.Files
  Next
End Sub

Dentro do for/Each precisaremos fazer a comparação do nome do arquivo com a máscara que foi digitada na textbox. Se o nome do arquivo estiver de acordo com a máscara iremos inseri-lo na listbox. Para esta comparação podemos usar o operador LIKE do VB (sim, o VB tem um operador LIKE, vide dica 80). Veja:

Sub AchaArquivos(f As Folder)
Dim a As File

For Each a In f.Files
  If UCase(a.Name) Like txtProcurar.Text Then
     lstArquivos.AddItem a.Name
  End If
Next
End Sub

Lembre-se que já haviamos aplicado o Ucase na textbox, ganhando performance com isso.

Feito isso os arquivos desta pasta que atendem ao critério já estarão dentro do ListBox. Torna-se necessário agora fazermos a busca em cada uma das subpastas de F.

O objeto Folder possui uma coleção chamada SubFolders que contém todas as subpastas existentes na pasta em questão. Podemos fazer um loop na coleção SubFolders e, para cada item de subFolder chamarmos a própria sub AchaArquivos novamente, dai a utilização de recursividade. Veja como fica:

Sub AchaArquivos(f As Folder)

Dim a As File
Dim sf As Folder

For Each a In f.Files
If UCase(a.Name) Like txtProcurar.Text Then
lstArquivos.AddItem a.Name
End If
Next

For Each sf In f.SubFolders
AchaArquivos sf
Next
End Sub

É interessante observar no algorítimo a forma como a recursividade se aprofundará na estrutura de diretórios do disco e, ao atingir os últimos níveis de diretório, retornará.

Podemos agora embelezar um pouco a busca, adicionando um label no formulário (lblProcurar) e exibindo no label o diretório no qual estamos realizando a busca no momento. Mas como a exibição será feita dentro do loop, este não permitirá nem que o label nem que a listbox se atualizem, então não conseguiremos ver o conteúdo do label e da listbox enquanto a busca não terminar.

Para evitar esse problema precisaremos utilizar a instrução DoEvents. A instrução DoEvents verifica se existe algum evento da interface gráfica solicitando resposta e o atende antes de continuar a execução do código. Deve-se lembrar que estamos trabalhando com um sistema que usa multitarefa preemptiva, portanto essa questão só afeta a nossa própria aplicação, não impede outras aplicações de realizarem suas tarefas.

Veja como fica o código:

Sub AchaArquivos(f As Folder)
Dim a As File
Dim sf As Folder

lblProcurar.Caption = "Procurando em " & f.Path
DoEvents

txtProcurar.Text = UCase(txtProcurar.Text)

For Each a In f.Files
If UCase(a.Name) Like txtProcurar.Text Then
lstArquivos.AddItem a.Name
Doevents
End If
Next

For Each sf In f.SubFolders
AchaArquivos sf
Next
End Sub

Para incrementar um pouco mais nossa pequena aplicação podemos fazer com que ao clicar em um arquivo sejam exibidas informações adicionais sobre ele, por exemplo: Tamanho, data de criação e data da última modificação. Precisaremos de mais labels para isso: lbltamanho,lblcriacao e lblultmodificacao.

Para podermos acessar esses dados após os arquivos já terem sido inseridos na listbox precisaremos guardar os objetos arquivo (File) referente a cada arquivo. Vamos criar uma Collection para guarda-los e adicionar na sub AchaArquivos o código para inseri-los na collection. Veja como fica:

Sub AchaArquivos(f As Folder)

Dim a As File
Dim sf As Folder

lblProcurar.Caption = "Procurando em " & f.Path
DoEvents

For Each a In f.Files
If UCase(a.Name) Like txtProcurar.Text Then
lstArquivos.AddItem a.Name
col.add a
Doevents
End If
Next

For Each sf In f.SubFolders
AchaArquivos sf
Next

End Sub

Então vamos programar o click da listbox para preencher os labels com os dados dos arquivos. Como inserimos o objeto File de cada um na collection teremos que usar o ListIndex da listbox para indexar a collection e assim acessarmos o objeto File do arquivo correto. Não podemos esquecer que o listindex começa em 0 enquanto que o objeto collection começa em 1, dai teremos que corrigir a diferença no código, veja:

Private Sub lstArquivos_Click()
lblTamanho.Caption = col(lstArquivos.ListIndex - 1).Size
lblCriacao.Caption = col(lstArquivos.ListIndex - 1).DateCreated
lblUltModificacao.Caption = col(lstArquivos.ListIndex - 1).DateLastModified
End Sub

Mas não vamos parar por ai, vamos incrementar um pouco mais nossa aplicação: Podemos mostrar o conteúdo do arquivo. Vamos criar um segundo form (chamaremos de frmconteudo) e uma textbox (txtconteudo) com multiline como true.

O melhor evento para realizarmos esta exibição é o duplo clique da listbox. Assim sendo, quando o usuário der um duplo clique sobre o nome de um arquivo abriremos o conteúdo do arquivo para ele examinar.

O objeto File possui um método chamado OpenAsTextStream que abre o arquivo e devolve como resposta um objeto TextStream. O objeto TextStream nos permite navegar através do conteúdo do arquivo. Não precisaremos de tanto em nosso exemplo, apenas obter o conteúdo, mesmo assim precisaremos de uma variável TextStream.

Veja como fica o código:

Private Sub lstArquivos_DblClick()
Dim t As TextStream
Set t = col(lstArquivos.ListIndex + 1).OpenAsTextStream
frmConteudo.txtConteudo.Text = t.ReadAll
t.Close
frmConteudo.Show 1
End Sub

Para completar falta apenas o toque final: Deixar que o usuário selecione a pasta a partir da qual ira ser realizada a busca. O Windows já possui uma caixa "Selecionar Pasta" que permite que o usuário selecione uma determinada pasta do sistema e não um arquivo. Para podermos aproveitar esse recurso do windows devemos utilizar uma chamada a uma função da API SHBrowserForFolder, comentada na dica 202.

Precisaremos de uma textbox na qual ficará a pasta escolhida (chamaremos de txtpasta) e um botão que abrirá a caixa de busca, cmdBuscaPasta. Veja como ficam as declarações para podermos realizar a chamada à API:

Const BIF_RETURNONLYFSDIRS = 1
Const BIF_DONTGOBELOWDOMAIN = 2
Const MAX_PATH = 260

Private Declare Function SHBrowseForFolder Lib "shell32" ( _
lpbi As BrowseInfo) As Long

Private Declare Function SHGetPathFromIDList Lib "shell32" ( _
ByVal pidList As Long, _
ByVal lpBuffer As String) As Long

Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" ( _
ByVal lpString1 As String, _
ByVal lpString2 As String ) As Long

'Tipo para def
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

No botão cmdBuscaPasta precisaremos configurar uma variável do tipo BrowseInfo através da qual passaremos parâmetros para a função SHBrowseForFolder e, enfim, chamar a função. Após chamarmos a função utilizaremos a função SHGetPathFromIdList para transformar o ID que é retornado pela SHBrowseForFolder no caminho da pasta em si e inseri-lo dentro da textbox.

Veja como fica o código:

Private Sub cmdBuscaPasta_Click()
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo

'Personaliza a procura
szTitle = "Indique a pasta a partir da qual será feita a busca: "
With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With

'Abre a janela de procura
'E retorna o caminho da pasta selecionada
lpIDList = SHBrowseForFolder(tBrowseInfo)

'Se existir alguma pasta selecionada
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
'Esta função é chamada para converter o ID retornado no caminho da pasta
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
'Atribuimos o caminho na textbox
txtPasta.Text = sBuffer
End If
End Sub

Por fim os retoques finais. O botão cmdEncontrar só pode estar habilitado se as duas caixas (txtpasta e txtprocurar) estiverem preenchidas. Deveremos então atribuir enabled=false em design e fazer o seguinte código:

Private Sub txtPasta_Change()
cmdEncontrar.Enabled = (Trim(txtPasta.Text) <> "" And Trim(txtProcurar.Text) <> "")
End Sub

Private Sub txtProcurar_Change()
cmdEncontrar.Enabled = (Trim(txtPasta.Text) <> "" And Trim(txtProcurar.Text) <> "")
End Sub

Desta forma o botão será habilitado apenas quando houver conteúdo nas duas pastas. Por fim, detalhes de código fazem os últimos ajustes na aplicação:

• O label lblprocurar só deverá estar visível durante o processo de busca, portanto deverá ser exibido no inicio (visible=true) e escondido no final;
• Os labels com informações sobre o arquivo só deverão ser exibidos quando o usuário clicar em um arquivo pela primeira vez e deverão ser novamente escondidos quando uma nova busca for realizada;
• A collection (COL) precisa ser esvaziada quando uma nova busca estiver se iniciando.