Translate this page now :



»Programação
»Programação.NET
»Banco de Dados
»Webdesign
»Office
» Certificações Microsoft 4
»Treinamentos4
»Programação 4
»Webdesign«
»Office & User Tips«
»Grupos de Usuários
»Células Acadêmicas«
intcontpiada : 118
Os 3 Porquinhos
Você já está cadastrado e participa do grupo de usuários de sua cidade ? Se não, comente o porque.
 
 
Faça um pequeno teste com 10 questões de VB
.:.
Teste seus conhecimentos em Visual Basic, SQL Server e ASP 3.0 com nossas provas on-line
.:.
Aprimore seus conhecimentos em programação com nosso treinamento on-line de lógica de programação
.:.
Veja nosso calendário de treinamentos
Gostou da Página?
Então

para um amigo!
 







Pesquisa personalizada
Pesquisar Dicas:

 







Quer saber mais?
Torne-se um MCP em Visual Basic
Faça um treinamento na Búfalo Informática



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. Veja como ficará o desenho do formulário :

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 funo  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 :

Em nossa área de download você encontrará o código completo desta pequena aplicação.

Dennes Torres
MCSD,MCSE,MCDBA



� Búfalo Informática, Treinamento e Consultoria - Rua Álvaro Alvim, 37 Sala 920 - Cinelândia - Rio de Janeiro / RJ
Tel.: (21)2262-1368 (21) 9240-5134 (21) 9240-7281 e-Mail:
contato@bufaloinfo.com.br