Questo sito utilizza cookies solo per scopi di autenticazione sul sito e nient'altro. Nessuna informazione personale viene tracciata. Leggi l'informativa sui cookies.
Username: Password: oppure
Partiziona file - Partiziona file.frm

Partiziona file.frm

Caricato da: Antometal
Scarica il programma completo

  1. Option Explicit
  2. Public DimFileSorg As Long
  3.  
  4. Private Sub cmdRipartisci_Click()
  5. On Error GoTo Errore
  6. Dim IndexFile As Integer
  7. Dim Data(511) As Byte
  8. Dim Mem As Long
  9. Open txtXcorsoSorg.Text For Binary As 1
  10.     If MsgBox("Partizionare il file: " & txtXcorsoSorg.Text & vbCrLf & "in " & DimFileSorg \ txtDimensioneMax + 1 & " parti da " & txtDimensioneMax.Text & " Kb" & vbCrLf & "nominate " & txtNomeNuovo & vbCrLf & "nel percorso di destinazione: " & txtXcorsoDest.Text & """i"".dat?", vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then
  11.         MkDir (txtXcorsoDest.Text)
  12.         pbrPartizione.Max = LOF(1) \ 1000
  13.             Do While EOF(1) = False
  14.                 Open txtXcorsoDest.Text & "\" & txtNomeNuovo.Text & IndexFile & ".ant" For Binary As 2
  15.                 Mem = Mem + LOF(2) \ 1000
  16.                     Do
  17.                         Get 1, , Data
  18.                         Put 2, , Data
  19.                     Loop Until LOF(2) \ 1000 >= txtDimensioneMax Or EOF(1) = True
  20.                 pbrPartizione.Value = pbrPartizione.Value + LOF(2) \ 1000
  21.                 Close 2
  22.                 IndexFile = IndexFile + 1
  23.             Loop
  24.         Open txtXcorsoDest.Text & "\" & txtNomeNuovo.Text & ".datanto" For Output As 3
  25.         Print #3, Dir(txtXcorsoSorg.Text) & "\" & IndexFile & "\" & DimFileSorg & "\" & txtNomeNuovo.Text
  26.         MsgBox "File ripartito completamente", vbInformation
  27.         pbrPartizione.Value = 0
  28.     End If
  29. Close
  30.  
  31. Exit Sub
  32. Errore:
  33. MsgBox "Errore numero " & Err.Number & vbCrLf & Err.Description, vbExclamation
  34. End Sub
  35.  
  36. Private Sub cmdXcorsoSorg_Click()
  37. CDialog.ShowOpen
  38.     If CDialog.CancelError = False Then
  39.         txtXcorsoSorg.Text = CDialog.FileName
  40.         Open txtXcorsoSorg For Binary As 1
  41.         DimFileSorg = LOF(1) \ 1000
  42.         Close 1
  43.         lblInfoFile.Caption = "Nome file: " & CDialog.FileTitle & "   dimensione file: " & DimFileSorg & " Kb"
  44.     End If
  45. End Sub
  46.  
  47. Private Sub cmdXcorsoDest_Click()
  48. CDialog.ShowSave
  49.     If CDialog.CancelError = False Then txtXcorsoDest.Text = CDialog.FileName
  50. End Sub
  51.  
  52. Private Sub txtDimensioneMax_Change()
  53. txtDimensioneMax.Text = Val(txtDimensioneMax.Text)
  54. End Sub