DUPLICAR DISQUETE

POLIZEI 11/12/2003 13:03:24
#701
GOSTARIA DE ALGUM ESQUEMA DE DUPLICAR DISQUETE VIA VB



POLIZEI
polizei@citylar.com.br
USUARIO.EXCLUIDOS 11/12/2003 17:10:36
#728 Resposta escolhida
Boa tarde, sr. Polizei

Boa tarde, Billy, seu cachorrão!!!

Estava aqui à  toa (coisa muuuito rara no funcionalismo público) e resolvi "encarar o desafio. Tinha já um código a meio caminho do que você queria, de modo que peço para não reparar na bagunça...

Detalhe: esse código despreza qualquer pasta dentro do disquete. Grava todos os arquivos, mas não cria as pastas que eventualmente apareciam no disquete original. Batalhe mais um pouco e você terá isso também:

- Na pasta em que for guardado o projeto, inclua uma pasta chamada "temp" (ex: C:\Arquivos de programas\programas do Max cara batuta\duplica disquete    emp). Só rode esse projeto quando já o tiver salvado corretamente na pasta (que seria a C:\Arquivos de programas\programas do Max cara batuta\duplica disquete)
- Um FileListBox com Pattern = *.*
- Um LisBox
- Um DirListBox
- Um CommandButton

Todos, com exceção do commandbutton, tem Visible = False

Private Sub Command1_Click()
    cont = 0
    On Error GoTo ver
    verment = False
    Do While verment = False
        List1.ListIndex = cont
            Dir1.Path = "A:"
        qqu = 0
        Do While qqu  Dir1.ListCount
            List1.AddItem Dir1.List(qqu)
            qqu = qqu + 1
        Loop
        cont = cont + 1
    Loop
    On Error GoTo fim
    For cont = 0 To List1.ListCount - 1
        List1.ListIndex = cont
        File1.Path = List1.Text
        If File1.ListCount  0 Then
                qqu = 0
                Do While qqu  File1.ListCount
                    File1.ListIndex = qqu
                    FileCopy File1.Path & "\" & File1.FileName, App.Path & "    emp" & "\" & File1.FileName  'substitui A: pelo caminho para a pasta "temp" do aplicativo
                    
                    qqu = qqu + 1
                Loop
        End If
    Next

    MsgBox "coloque agora um disquete com espaço suficiente e clique em 'OK'"
    
    For cont = 0 To List1.ListCount - 1
        List1.ListIndex = cont
        If File1.ListCount  0 Then
                qqu = 0
                Do While qqu  File1.ListCount
                    File1.ListIndex = qqu
                    FileCopy App.Path & "    emp" & "\" & File1.FileName, "A:\" & File1.FileName
                    Kill App.Path & "    emp" & "\" & File1.FileName
                    qqu = qqu + 1
                Loop
        End If
    Next
    



Exit Sub
ver:
    verment = True
    Resume Next
Exit Sub
fim:
    MsgBox Err.Description, vbExclamation, "PLP"
    
    
    
    
End Sub
Tópico encerrado , respostas não são mais permitidas
Voltar