Option Explicit



Private Declare Sub FatalAppExit Lib "kernel32.dll" Alias "FatalAppExitA" ( _

     ByVal uAction As Long, _

     ByVal lpMessageText As String)



Private Sub EndAll() 'siehe dazugehöriger Tipp

Dim frm As Form



For Each frm In VB.Forms

    Unload frm

    Set frm = Nothing

Next frm



End Sub



Private Sub SecCopyFile(Optional StartPos As Currency)

Dim FF1 As Integer, FF2 As Integer, FF3 As Integer

Dim strChars As String

Dim intPaket As Long

Dim i As Currency



intPaket = Val(txtPaket.Text)



'### Speichern des Status

SaveSetting App.Title, "Recovery", "Status", "1"

SaveSetting App.Title, "Recovery", "FileIn", txtFileIn.Text

SaveSetting App.Title, "Recovery", "FileOut", txtFileOut.Text

SaveSetting App.Title, "Recovery", "PaketSize", txtPaket.Text

'### Dateien öffnen

FF1 = FreeFile

Open txtFileIn.Text For Binary Access Read As #FF1

    FF2 = FreeFile

    Open txtFileOut.Text For Binary Access Write As #FF2

        '### Daten schreiben

        For i = 1 To LOF(FF1) Step intPaket 'Pakete einlesen

            If i = 1 And StartPos > 0 Then i = StartPos 'Forsetzen?

            Me.Caption = i & " / " & LOF(FF1) & " Bytes kopiert" 'optional

            SaveSetting App.Title, "Recovery", "Position", i

            If (LOF(FF1) - intPaket) < (LOF(FF2)) Then 'Wenn kein ganzes Paket mehr zum Auslesen

                strChars = Space(LOF(FF1) - LOF(FF2))  'auf restliche Zeichen beschränken

            Else

                strChars = Space(intPaket) 'sonst Paketgröße einlesen

            End If

            Get #FF1, i, strChars   'Auslesen aus Quelldatei

            Put #FF2, i, strChars   'Schreiben in Zieldatei

            DoEvents

        Next i

        Me.Caption = LOF(FF2) & " / " & LOF(FF1) & " Bytes kopiert" 'optional

Close #FF3, #FF2, #FF1

SaveSetting App.Title, "Recovery", "Status", "0"



End Sub



Private Sub cmdCancel_Click()

FatalAppExit 0&, "Laufendender Kopiervorgang wirksam unterbrochen"



End Sub



Private Sub cmdCopy_Click()

SecCopyFile



End Sub



Private Sub cmdEnd_Click()

EndAll



End Sub



Private Sub Form_Load()

If GetSetting(App.Title, "Recovery", "Status") = "1" Then 'Wenn abgestürzt...

    If MsgBox("Letzten Transfer fortsetzen?", vbYesNo + vbQuestion) = vbNo Then

    'Transfer fortsetzen

    

        SaveSetting App.Title, "Recovery", "Status", "0"

        Exit Sub

    End If

    Me.Show

    '### Alten Status ins Programm übertragen

    txtFileIn.Text = GetSetting(App.Title, "Recovery", "FileIn")

    txtFileOut.Text = GetSetting(App.Title, "Recovery", "FileOut")

    txtPaket.Text = GetSetting(App.Title, "Recovery", "PaketSize")

    SecCopyFile CCur(GetSetting(App.Title, "Recovery", "Position"))

Else

    txtPaket.Text = "10240"

End If



End Sub



Private Sub txtFileIn_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, _

    Shift As Integer, X As Single, Y As Single)



On Error Resume Next

If (Data.Files.Count > 0) And _

    (Dir(Data.Files(1)) <> "") Then 'Auf gültige Datei prüfen

    

    txtFileIn.Text = Data.Files(1)  'und einfügen

End If



End Sub