SplitFiles

Private Static Sub SplitUpFile(Fil As String)
Dim x%, Root$, Ext$
Dim hSource%, hDest%
Dim SourceLen&, DestCount%
Dim Dest%, Lenght&
Dim Res%
'Separa i files passati a questa funzione in

'frammenti nominati <nomebase>.000, <nomebase>.001, etc.

Const MaxSize = 1450000 'Spazio libero su floppy da 1.4MB
hSource = FreeFile
Open Fil For Binary As #hSource
SourceLen = LOF(hSource)
'Verifica se sia necessario splittare il file

If SourceLen <= MaxSize Then Exit Sub
'Se il file e' da slpittare allora determina il numero di file necessari.

DestCount = 2 + (SourceLen - MaxSize) / MaxSize
'Crea i files di output.

For Dest = 1 To DestCount
hDest = FreeFile
Open Fil & "." & Trim(Str(Dest)) & ".spf" For Binary As #hDest
If Dest = DestCount Then
Lenght = (SourceLen - MaxSize) Mod MaxSize
Else
Lenght = MaxSize
End If
Res = CopyChunk(hSource, hDest, Lenght)
If Res <> 0 Then
MsgBox "Errore durante la copia: " & Error(Err), 16
Exit Sub
End If
Close #hDest
Next Dest
Close #hSource
End Sub

'Routine per riassemblare i vari frammenti di file splittati

'dalla routine precedente


Private Sub AssembleFile(Root As String)
Dim SourceCount%, Fil$, Ext$, x%
Dim hDest%, Source%
Dim hSource%, Res%

'Riassembla i frammenti <Root>.### nel file <Root>.<Ext>

Root = Left(Root, Len(Root) - 4)
x = InStr(InStr(Root, ".") + 1, Root, ".")
Root = Left(Root, x)
If Right(Root, 1) <> "." Then Root = Root & "."
'Conta i frammenti.

SourceCount = 0
Fil = Dir(Root & "*" & ".spf")

While Len(Fil)
SourceCount = SourceCount + 1
Fil = Dir
Wend

'Se il file non deve essere riassemblato esce.


If SourceCount = 0 Then Exit Sub
'Crea il file di output.

Root = Left(Root, Len(Root) - 1)
hDest = FreeFile

Open Root For Binary As #hDest
'Riunisce i file frammentati in un unico file

For Source = 1 To SourceCount
hSource = FreeFile
Open Root & "." & Trim(Str(Source)) & ".spf" For Binary As #hSource
Res = CopyChunk(hSource, hDest, LOF(hSource))
If Res <> 0 Then
MsgBox "Errore durante la copia: " & Error(Err), 16
Exit Sub
End If
Close #hSource
Next Source
Close #hDest
End Sub

'Funzione utilizzata dalle precedenti routine per compiare

'blocchi di 8k da un file ad un altro


Private Static Function CopyChunk(hSource As Integer, hDest As Integer, Lenght As Long)
Dim BlockSize%, Buffer$
Dim Blocks%, lastBlockSize%
Dim Block%
'Funzione generica che copia blocchi di 8K da un file ad un altro

On Local Error Resume Next
BlockSize = 8192
Buffer = Space(BlockSize)
Blocks = (Lenght \ BlockSize) + 1
lastBlockSize = Lenght Mod BlockSize
Err = 0

For Block = 1 To Blocks
If Block = Blocks Then Buffer = Space(lastBlockSize)
Get #hSource, , Buffer
Put #hDest, , Buffer
Next Block
CopyChunk = Err
End Function