VB 6 - Gerando volumes para arquivos de grande tamanho

Imagine a situação :

Você fez precisa fazer a copia de um arquivo de dados com 10 MB de tamanho em disquetes de 1.44. É claro que com a capacidade atual dos discos flexíveis de 1.44 HD , 10 MB não vão caber em um disco.

Uma solução seria dividir o arquivo de 10 MB em pequenos arquivos de tamanho menores ou iguais a 1.44 MB de forma a poder copiar cada arquivo individual para o disco flexível. Você iria precisar de tantos discos quantos forem os volumes gerados , mas seu problema seria resolvido.

Existem no mercado diversos programas que fazem isto , mas você quer fazer isto em seu programa VB de forma a gerar uma rotina de backup de arquivos de tamanho superior a 1.44 MB.

Seria possível você implementar esta funcionalidade usando código Visual Basic ?

A resposta é : é claro que sim.

Neste artigo eu vou mostrar como você pode gerar volumes para arquivos grandes.

Eu poderia ter implementado esta rotina de diferentes formas , mas escolhi a forma mais simples de forma a que todos possam entender. Cada um pode melhorar a rotina a seu critério e de acordo com suas necessidades.

Inicie um novo projeto no VB do tipo Standard EXE e no formulário padrão insira os seguintes componentes (conforme layout da figura):

O projeto deve funcionar assim :

- A idéia é que o usuário informe o nome do arquivo a ser dividido em volumes e informe o destino para onde os volumes serão gerados. (se nada for informado em Destino os volume serão gerados no diretório da aplicação com o sufixo _Volume)

- A seguir o usuário escolhe o tamanho que cada volume deverá possuir

- Ao clicar no botão - Gerar Volumes - os volumes serão gerados e exibidos na caixa de texto : txtVol

- Para mesclar os volumes gerados basta clicar no botão - Mesclar Volumes. Desta forma o arquivo será recuperado a partir dos volumes.

A seguir uma seqüência de telas mostrando o sistema em operação:

- Esta tela mostra a aplicação gerando 3 volumes para o arquivo Northwind.mdb que possui 3.276 KB de tamanho.

-Como cada volume deverá possuir no máximo 1.414 Kb

- Foram gerados os volumes :

  1. Northwind.mdb.000
  2. Northwind.mdb.001
  3. Northwind.mdb.002

a próxima tela mostra uma visão da pasta de destino dos volumes : c:\teste\vol. Nela estão os volumes gerados:

O botão - Mesclar Volumes - irá recompor o arquivo com base nos volumes gerados no mesmo local:

Se você der uma espiada na pasta onde os volumes foram gerados verá o arquivo Nothwind.mdb :

Portanto , você acabou de ver um programa que forma simples pode ser usado para dividir arquivos maiores em volumes de menor tamanho.

Bom proveito !

Ah! ia esquecendo ... O código do projeto é dado abaixo:

Option Explicit
Dim nLen As Double
Dim strNomeArquivo As String
Dim b() As Byte
Dim lblsaida As String

Private Sub cmdProcura_Click()
  'exibe a caixa de diálogo - Procurar Arquivo e atribui o nome do arquivo a caixa de texto
  dlg.ShowOpen
  txtArquivo = dlg.FileName
  strNomeArquivo = dlg.FileTitle
End Sub

'mescla os volumes previamentes gerados para uma pasta especifica
Private Sub cmdMescla_Click()
  Dim n As Double
  Dim i As Long
  Dim bOpen As Boolean
  Dim d As Double


  For i = 0 To File1.ListCount - 1
    If IsNumeric(Right(File1.List(i), 3)) Then
      If Not bOpen Then
        Open lblsaida & "\" & Left(File1.List(i), Len(File1.List(i)) - 4) For Binary As 2
        bOpen = True
      End If
      n = FileLen(lblsaida & "\" & File1.List(i))
      Open lblsaida & "\" & File1.List(i) For Binary As 1
      ReDim b(n - 1)
      Get #1, , b()
      Put #2, d + 1, b()
      Close #1
      d = d + n
    End If
  Next
  Close #2
  File1.Refresh
End Sub

'gera volumes do tamanho especificado
Private Sub cmdVolume_Click()
  
  If Trim(txtArquivo.Text) = "" Or Dir(txtArquivo.Text) = "" Then
    MsgBox "Arquivo não existe ! "
    cmdProcura.SetFocus
    Exit Sub
  End If
  
  If Val(txtTamanho) < 1 Then
    MsgBox "Tamanho de volume incorreto."
    txtTamanho.SetFocus
    Exit Sub
  End If
  
  On Error GoTo er1
  
  If txtDestino.Text = "" Then
     lblsaida = txtArquivo & "_Volume"
  Else
     lblsaida = txtDestino.Text
  End If
  
  MkDir lblsaida
  
  File1.Path = lblsaida
  File1.Visible = True
  txt.Visible = False
  
  If cmb.ListIndex = -1 Then cmb.ListIndex = 2
  
  'numero do arquivo
  Dim i As Long
  'tamanho do volume a ser gerado
  Dim ss As Double
  
  If cmb.ListIndex = 0 Then
    ss = 1024
    ss = ss * 1024
  ElseIf cmb.ListIndex = 1 Then
    ss = 1024
  Else
    ss = 1
  End If
  
  ss = Round(Val(txtTamanho.Text) * ss, 0)
  nLen = FileLen(txtArquivo.Text)
  Open txtArquivo.Text For Binary As 1
  
  While nLen > ss
    ReDim b(ss - 1)
    Get #1, ss * i + 1, b()
    Open lblsaida & "\" & strNomeArquivo & "." & Format(i, "000") For Binary As 2
    Put #2, , b()
    Close #2
    File1.Refresh
    i = i + 1
    nLen = nLen - ss
  Wend
  
  ReDim b(nLen - 1)
  
  Get #1, ss * i + 1, b()
  Open lblsaida & "\" & strNomeArquivo & "." & Format(i, "000") For Binary As 2
  Put #2, , b()
  Close #2
  File1.Refresh
  Beep
  Close #1
  Exit Sub
er1:
  Select Case Err
  Case 75
    If MsgBox("Diretório de destino dos volumes já existe. Deseja sobrescrever os arquivos ?", vbYesNo) = vbYes Then
      Dim j As Long
      File1.Path = lblsaida
      For j = File1.ListCount - 1 To 0 Step -1
        Kill lblsaida & "\" & File1.List(j)
      Next
      RmDir lblsaida
      Resume
    Else
      lblsaida = "DirdestinoVolume"
    End If
  Case Else
    MsgBox Err.Number & ": " & Err.Description
  End Select
End Sub

Private Sub Form_Activate()
  'ativa o foco na caixa de texto txtArquivo
  txtArquivo.SetFocus
End Sub

Private Sub Form_Load()
  'na carga do formulário define o primeiro item da combo como o padrão
  'exibe o componente File
  'e verifica se algum nome de arquivo foi informado. Se foi ativa o botão de comando para gerar volumes
  cmb.ListIndex = 0
  File1.Visible = False
  If txtArquivo.Text = "" Then cmdVolume.Enabled = False
End Sub
Private Sub txtArquivo_Change()
  If txtArquivo.Text <> "" Then
     cmdVolume.Enabled = True
  Else
    cmdVolume.Enabled = False
  End If
End Sub

 

 

Até o próximo artigo VB.

 

Veja os Destaques e novidades do SUPER DVD Visual Basic (sempre atualizado) : clique e confira !

Quer migrar para o VB .NET ?

Quer aprender C# ??

Quer aprender os conceitos da Programação Orientada a objetos ?

Quer aprender o gerar relatórios com o ReportViewer no VS 2013 ?

  Gostou ?   Compartilhe no Facebook   Compartilhe no Twitter

Referências:

José Carlos Macoratti