DOS - Divisione File>A1.400 Kb Su Floppy Disk

Api # Questa routine provvede a splittare (dividere) i file in pi� parti
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 � 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

Api # Questa routine provvede a splittare (dividere) i file in piu' parti
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