Attribute VB_Name = "mod_BinaryMoveFileData"
' modul for Visual Basic 6
' Copyright (C) 2003-2005 Jan Vorel

' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.

' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.

' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

' This is a shared modul, class modul, usercontrol or form. It is also
' published under the GNU General Public License.

' If you have any questions, suggestions or bug reports about this product,
' contact me: info@ctuser.net; Do not contact me about general B.A.S.I.C.
' language or A.P.I. issues

'#Const BinaryMoveFileData_ProgressExtraLarge = 1


'#BinaryMoveFileData_FlagA
'    1 = Extended
'    2 = (Default)
'    5 (4) = UseAlternateMode
'    8 = UseClearData
'   10 = CanAbort
'   20 = ExtraLarge
' 1000 = Callback ' currently not completely included


Option Explicit
Option Base 0



Public Const BinaryMoveFileData_DefaultBlockSize As Long = &H3FFF00
#If (BinaryMoveFileData_FlagA And &H10&) = &H10& Then
  Public BinaryMoveFileData_AbortCopying As Boolean
  #End If

Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long

#If (BinaryMoveFileData_FlagA And &H1&) = &H1& Then
  #If (BinaryMoveFileData_FlagA And &H20&) = &H20& Then
  Public Function BinaryMoveFileDataEx(ByVal SourceFile As Long, ByVal Size As Long, ByVal StartPos As Long, ByVal NewPos As Long, Optional ByVal DestinationFile As Long = -1&, Optional ByVal BlockSize As Long = BinaryMoveFileData_DefaultBlockSize, Optional ByVal ProgressControl As Long, Optional ByVal ProgressStart As Double = 0#, Optional ByVal ProgressTotal As Double = 0#, Optional ByVal ProgressWidth As Double = -1#) As Boolean
  #Else
  Public Function BinaryMoveFileDataEx(ByVal SourceFile As Long, ByVal Size As Long, ByVal StartPos As Long, ByVal NewPos As Long, Optional ByVal DestinationFile As Long = -1&, Optional ByVal BlockSize As Long = BinaryMoveFileData_DefaultBlockSize, Optional ByVal ProgressControl As Long, Optional ByVal ProgressStart As Long = 0&, Optional ByVal ProgressTotal As Long = 0&, Optional ByVal ProgressWidth As Long = -1&) As Boolean
  #End If

    Dim xLong1 As Long
    Dim xLong2 As Long
    Dim xLong3 As Long
    Dim xLong4 As Long
    'Dim xLong5 As Long
    Dim xChar1 As String
    
'    Stop
    
    If Not Size = 0& Then
      If DestinationFile = -1& Then DestinationFile = SourceFile
      If Not (DestinationFile = SourceFile And StartPos = NewPos) Then
        If ProgressWidth = -1 Then ProgressWidth = Size
        #If (BinaryMoveFileData_FlagA And &H10&) = &H10& Then
          BinaryMoveFileData_AbortCopying = False
          #End If

        If BlockSize > Size Then BlockSize = Size
        xChar1 = String(BlockSize, vbNullChar)
        xLong2 = Size
        BinaryMoveFileDataEx = True
        Do
          If xLong2 > BlockSize Then
            xLong1 = BlockSize
            xLong2 = xLong2 - xLong1
            Else
            xLong1 = xLong2
            xLong2 = 0&
            End If
          'If NewPos > StartPos And SourceFile = DestinationFile Then
          If NewPos > StartPos Then
            'inversion
            xLong4 = xLong2
            Else
            xLong4 = xLong3
            End If
          'Get SourceFile, (StartPos + xLong4), xChar1
          'Put DestinationFile, (NewPos + xLong4), xChar1
          If SetFilePointer(SourceFile, StartPos + xLong4, 0&, 0&) = -1& Then
            BinaryMoveFileDataEx = False
            xLong2 = 0&
            ElseIf ReadFile(SourceFile, ByVal xChar1, xLong1, 0&, ByVal 0&) = 0& Then
            BinaryMoveFileDataEx = False
            xLong2 = 0&
            ElseIf SetFilePointer(DestinationFile, NewPos + xLong4, 0&, 0&) = -1& Then
            BinaryMoveFileDataEx = False
            xLong2 = 0&
            Else
            If WriteFile(DestinationFile, ByVal xChar1, xLong1, 0&, ByVal 0&) = 0& Then
              BinaryMoveFileDataEx = False
              xLong2 = 0&
              End If
            End If
            
          xLong3 = xLong3 + xLong1
#If (BinaryMoveFileData_FlagA And &H10&) = &H20& Then
          If Not ProgressTotal = 0# Then
#Else
          If Not ProgressTotal = 0& Then
#End If
            ctProgressB_SetValue ProgressControl, (ProgressStart + xLong3 / Size * ProgressWidth), ProgressTotal
            End If
          DoEvents
          #If (BinaryMoveFileData_FlagA And &H10&) = &H10& Then
            If BinaryMoveFileData_AbortCopying Then GoTo Rs1
            #End If
          Loop Until xLong2 = 0&
        xChar1 = ""
        BinaryMoveFileDataEx = True
        End If
      End If
    End Function
  #End If

#If (BinaryMoveFileData_FlagA And &H2&) = &H2& Or BinaryMoveFileData_FlagA = &H0& Then
#If (BinaryMoveFileData_FlagA And &H20&) = &H20& Then
  Public Function BinaryMoveFileData(ByVal SourceFile As Long, ByVal DestinationFile As Long, ByVal Size As Long, Optional ByVal StartPosSource As Long, Optional ByVal StartPosDest As Long, Optional ByVal BlockSize As Long = BinaryMoveFileData_DefaultBlockSize, Optional ByVal ProgressControl As Long, Optional ByVal ProgressStart As Double = 0#, Optional ByVal ProgressTotal As Double = 0#, Optional ByVal ProgressWidth As Double = -1#) As Boolean
  #Else
  Public Function BinaryMoveFileData(ByVal SourceFile As Long, ByVal DestinationFile As Long, ByVal Size As Long, Optional ByVal StartPosSource As Long, Optional ByVal StartPosDest As Long, Optional ByVal BlockSize As Long = BinaryMoveFileData_DefaultBlockSize, Optional ByVal ProgressControl As Long, Optional ByVal ProgressStart As Long = 0&, Optional ByVal ProgressTotal As Long = 0&, Optional ByVal ProgressWidth As Long = -1&) As Boolean
  #End If

    Dim xLong1 As Long
    Dim xLong2 As Long
    Dim xChar1 As String
    
    On Error GoTo Er1
    'On Error GoTo 0
    If ProgressWidth = -1 Then ProgressWidth = Size
    
    #If (BinaryMoveFileData_FlagA And &H10&) = &H10& Then
      BinaryMoveFileData_AbortCopying = False
      #End If
    
    StartPosSource = StartPosSource + 1&
    StartPosDest = StartPosDest + 1&
    Do Until xLong1 = Size
      xLong2 = (Size - xLong1)
      If xLong2 > BlockSize Then xLong2 = BlockSize
      xChar1 = String(xLong2, vbNullChar)
      Get SourceFile, (StartPosSource + xLong1), xChar1
      Put DestinationFile, (StartPosDest + xLong1), xChar1
      xLong1 = xLong1 + xLong2
      #If (BinaryMoveFileData_FlagA And &H20&) = &H20& Then
        If Not (ProgressControl = 0& Or ProgressTotal = 0#) Then
        #Else
        If Not (ProgressControl = 0& Or ProgressTotal = 0&) Then
        #End If
        ctProgressB_SetValue ProgressControl, (ProgressStart + xLong1 / Size * ProgressWidth) / ProgressTotal
        End If
      DoEvents
      #If (BinaryMoveFileData_FlagA And &H10&) = &H10& Then
        If BinaryMoveFileData_AbortCopying Then GoTo Rs1
        #End If
      Loop
    BinaryMoveFileData = True
    
Rs1:
    On Error GoTo 0
    Exit Function
    
Er1:
    Resume Rs1
    End Function
  #End If


#If (BinaryMoveFileData_FlagA And &H8&) = &H8& Then
  Public Function BinaryClearFileData(ByVal SourceFile As Long, ByVal Position As Long, ByVal Size As Long, Optional ByVal BlockSize As Long = BinaryMoveFileData_DefaultBlockSize, Optional ByVal ProgressControl As Long, Optional ByVal ProgressStart As Long = 0&, Optional ByVal ProgressTotal As Long, Optional ByVal ProgressWidth As Long = -1&) As Boolean
    Dim xLong1 As Long
    Dim xLong2 As Long
    Dim xChar1 As String
    
    On Error GoTo Er1
    On Error GoTo 0
        
    If ProgressWidth = -1 Then ProgressWidth = Size
        
    #If (BinaryMoveFileData_FlagA And &H10&) = &H10& Then
      BinaryMoveFileData_AbortCopying = False
      #End If
    Do
      If xLong2 = Size Then Exit Do
      xLong1 = Size - xLong2
      If xLong1 > BlockSize Then xLong1 = BlockSize
      xChar1 = String(xLong1, vbNullChar)
      Put SourceFile, Position + xLong2 + 1&, xChar1
      xLong2 = xLong2 + xLong1
      #If (BinaryMoveFileData_FlagA And &H20&) = &H20& Then
        If Not (ProgressControl = 0& Or ProgressTotal = 0#) Then
        #Else
        If Not (ProgressControl = 0& Or ProgressTotal = 0&) Then
        #End If
        ctProgressB_SetValue ProgressControl, (ProgressStart + xLong2 / Size * ProgressWidth), ProgressTotal
        End If
      DoEvents
      #If (BinaryMoveFileData_FlagA And &H10&) = &H10& Then
        If BinaryMoveFileData_AbortCopying Then GoTo Rs1
        #End If
      Loop
    BinaryClearFileData = True
    
Rs1:
    On Error GoTo 0
    Exit Function
    
Er1:
    Resume Rs1
    End Function
  #End If



#If (BinaryMoveFileData_FlagA And &H5&) = &H5& Then
  #If (BinaryMoveFileData_FlagA And &H20&) = &H20& Then
  Public Function BinaryMoveFileDataAlternate(ByVal SourceFile As Long, ByVal Size As Long, ByVal StartPos As Long, ByVal PDifference As Long, ByVal ProgressControl As ctProgressA, Optional ByVal DestinationFile As Long = -1, Optional ByVal BlockSize As Long = BinaryMoveFileData_DefaultBlockSize, Optional ByVal ProgressStart As Double = 0#, Optional ByVal ProgressTotal As Double = 0#, Optional ByVal ProgressWidth As Double = -1#) As Boolean
  #Else
  Public Function BinaryMoveFileDataAlternate(ByVal SourceFile As Long, ByVal Size As Long, ByVal StartPos As Long, ByVal PDifference As Long, ByVal ProgressControl As ctProgressA, Optional ByVal DestinationFile As Long = -1, Optional ByVal BlockSize As Long = BinaryMoveFileData_DefaultBlockSize, Optional ByVal ProgressStart As Long = 0&, Optional ByVal ProgressTotal As Long = 0&, Optional ByVal ProgressWidth As Long = -1&) As Boolean
  #End If
    BinaryMoveFileDataAlternate = BinaryMoveFileData(SourceFile, Size, StartPos, StartPos + PDifference, ProgressControl, DestinationFile, BlockSize, progresstart, ProgressTotal)
    End Function
#End If
