Option Explicit
Public DimFileSorg As Long
Private Sub cmdRipartisci_Click()
On Error GoTo Errore
Dim IndexFile As Integer
Dim Data(511) As Byte
Dim Mem As Long
Open txtXcorsoSorg.Text For Binary As 1
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
MkDir (txtXcorsoDest.Text)
pbrPartizione.Max = LOF(1) \ 1000
Do While EOF(1) = False
Open txtXcorsoDest.Text & "\" & txtNomeNuovo.Text & IndexFile & ".ant" For Binary As 2
Mem = Mem + LOF(2) \ 1000
Do
Get 1, , Data
Put 2, , Data
Loop Until LOF(2) \ 1000 >= txtDimensioneMax Or EOF(1) = True
pbrPartizione.Value = pbrPartizione.Value + LOF(2) \ 1000
Close 2
IndexFile = IndexFile + 1
Loop
Open txtXcorsoDest.Text & "\" & txtNomeNuovo.Text & ".datanto" For Output As 3
Print #3, Dir(txtXcorsoSorg.Text) & "\" & IndexFile & "\" & DimFileSorg & "\" & txtNomeNuovo.Text
MsgBox "File ripartito completamente", vbInformation
pbrPartizione.Value = 0
End If
Close
Exit Sub
Errore:
MsgBox "Errore numero " & Err.Number & vbCrLf & Err.Description, vbExclamation
End Sub
Private Sub cmdXcorsoSorg_Click()
CDialog.ShowOpen
If CDialog.CancelError = False Then
txtXcorsoSorg.Text = CDialog.FileName
Open txtXcorsoSorg For Binary As 1
DimFileSorg = LOF(1) \ 1000
Close 1
lblInfoFile.Caption = "Nome file: " & CDialog.FileTitle & " dimensione file: " & DimFileSorg & " Kb"
End If
End Sub
Private Sub cmdXcorsoDest_Click()
CDialog.ShowSave
If CDialog.CancelError = False Then txtXcorsoDest.Text = CDialog.FileName
End Sub
Private Sub txtDimensioneMax_Change()
txtDimensioneMax.Text = Val(txtDimensioneMax.Text)
End Sub