Tweet
I keep getting this error about the file is in use by another process.
So I made a LIST of files and am 100% sure I closed all filehandles and hDir's but still no joy.
Any idea why the movefileex function won't work?
Basically sizes up folders until it reaches 4.7 gigs, moves those folders into Disk1, Disk2 etc to be lined up for burning.
So I made a LIST of files and am 100% sure I closed all filehandles and hDir's but still no joy.
Any idea why the movefileex function won't work?
Basically sizes up folders until it reaches 4.7 gigs, moves those folders into Disk1, Disk2 etc to be lined up for burning.
Code:
'#Register None
#Option Version5
#Compile Exe
#Include "WIN32API.INC"
Declare Function GetSizeofFolderinMB(ByVal InputDir As String) As Dword
Declare Function ShellCopyFile(ByVal Source As String, ByVal Destination As String) As Long
Declare Function GetLastErrorDescription( ByVal ErrorCode As Long) As String
'============================================<WINMAIN>==================================================================
Function WinMain (ByVal hInstance As Long, _
ByVal hPrevInstance As Long, _
ByVal lpCmdLine As Asciiz Ptr, _
ByVal iCmdShow As Long) As Long
Local f As Asciiz * %MAX_PATH
Local FindData As WIN32_FIND_DATA
Local hDir As Long
Local DiskNo As Long 'Which DVD folder are we on.
Local sTmp As String
Local FolderSize As Quad
Local TotalinMB As Quad
Local DVDSize As Quad
Local RootDir As String
Local WorkingDir As String
Local ErrType As Long
Local lResult As Long
Local lLoop As Long
Local OldFolderName As String
Local NewFolderName As String
Local DiskFolder As String
Local FolderCount As Long
Dim FolderList(1 To 100) As String
DVDSize = 470000 'mb's
RootDir = "G:\UserData\"
'Read in all folders
FindData.dwFileAttributes = %FILE_ATTRIBUTE_DIRECTORY
f = RootDir & "\*.*" 'Read all files, filter later
hDir = FindFirstFile(f, FindData)
If hDir = %INVALID_HANDLE_VALUE Then
StdOut "Unale to read directory!"
Exit Function
End If
DiskNo = 1
DiskFolder = RootDir & "Disk" & Format$(DiskNo)
MkDir DiskFolder
Do
Select Case Left$(FindData.cFileName,1)
Case ".","_"
Iterate
End Select
DiskFolder = RootDir & "Disk" & Format$(DiskNo) 'ie Disk1, Disk2
If Left$(FindData.cFileName,4) = "Disk" Then Iterate 'It happens..
'Get name of current directory
WorkingDir = RootDir & FindData.cFileName
'Get Size of current directory
FolderSize = GetSizeofFolderinMB(ByVal WorkingDir)
'Check foldersize against size of a DVD, 4.7GB.
If FolderSize > DVDSize Then Iterate 'Have to do it manually for now 'ie VP30
'Check foldersize and total MB to see if we will crest over 4.7 gb
If TotalinMB + FolderSize < DVDSize Then 'OK to move
TotalinMB = TotalinMB + FolderSize
Else ' Not OK to move, create a new disk folder
Incr DiskNo
DiskFolder = RootDir & "Disk" & Format$(DiskNo)
MkDir DiskFolder
StdOut "------------------------------"
StdOut "Disk" & Format$(DiskNo) & " size: " & Format$(TotalInMB)
StdOut "------------------------------"
TotalInMB = FolderSize 'Reset it to current size
End If
OldFolderName = WorkingDir
NewFolderName = RootDir & DiskFolder & "\" & FindData.cFileName
Incr FolderCount
FolderList(FolderCount) = OldFolderName & "|" & NewFolderName
Loop While FindNextFile(hDir, FindData)
FindClose hDir
'Now we have total file sizes, need to create new folders and MOVE folders to fill up to 4.7gb
For lLoop = 1 To FolderCount
OldFolderName = Parse$(FolderList(lLoop),"|",1) & Chr$(0)
NewFolderName = Parse$(FolderList(lLoop),"|",-1) & Chr$(0) & Chr$(0)
StdOut "Moving " & OldFolderName & " to " & NewFolderName
' lResult = ShellCopyFile(ByVal OldFolderName,ByVal NewFolderName) 'This will allow copying folders
lResult = MoveFileEx(ByVal StrPtr(OldFolderName), ByVal StrPtr(NewFolderName), ByVal %MOVEFILE_WRITE_THROUGH)
'If the function fails, the return value is zero
If IsFalse lResult Then
ErrType = GetLastError()
StdOut "There has been an error: " & Format$(ErrType) & " - " & GetLastErrorDescription(ErrType)
End If
Next
End Function
'---------------------------------------------------------------------------------
Function GetSizeofFolderinMB(ByVal InputDir As String) As Dword
Local hDir As Long
Local FolderSize As Quad
Local f As Asciiz * %MAX_PATH
Local FindData As WIN32_FIND_DATA
Local Quadrafrier As Quad
Quadrafrier = %MAXDWORD+1
ChDir InputDir
FindData.dwFileAttributes = %FILE_ATTRIBUTE_DIRECTORY
f = "*.*" 'Read all files, filter later
hDir = FindFirstFile(f, FindData)
If hDir = %INVALID_HANDLE_VALUE Then
Function = -1
Exit Function
Else
FolderSize = (FindData.nFileSizeHigh * (Quadrafrier)) + FindData.nFileSizeLow
End If
Do
FolderSize = FolderSize + (FindData.nFileSizeHigh * (Quadrafrier)) + FindData.nFileSizeLow
Loop While FindNextFile(hDir, FindData)
FindClose hDir
Function = (FolderSize/1074)
End Function
'------------------------------------------------------------------------------------------
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
'Copy file routine, using shell function (with dialog)
'Returns zero if successful, or nonzero otherwise.
'With two exceptions, you cannot use SHFileOperation to move special folders
'from a local drive to a remote computer by specifying a network path.
'--------------------------------------------------------------------
Function ShellCopyFile(ByVal Source As String, ByVal Destination As String) As Long
Local lResult As Long
Local shfos As SHFILEOPSTRUCT
Local ErrType As Long
Local ErMsg As String
'wFlags = %FOF_NOCONFIRMMKDIR Or %FOF_NOCONFIRMATION
shfos.hwnd = %HWND_DESKTOP
shfos.wFunc = %FO_MOVE
shfos.pFrom = StrPtr(Source)
shfos.pTo = StrPtr(Destination)
shfos.fFlags = %FOF_NOCONFIRMMKDIR Or %FOF_NOCONFIRMATION Or %FOF_SILENT Or %FOF_WANTNUKEWARNING
lResult = SHFileOperation(shfos)
If lResult <> %ERROR_SUCCESS Or shfos.fAnyOperationsAborted <> 0 Then
'user aborted, do whatever is needed..
ErrType = GetLastError()
If ErrType <> %ERROR_SUCCESS Then
ErMsg = "There has been an error: " & Format$(ErrType) & " - " & GetLastErrorDescription(ErrType)
MessageBox ByVal %HWND_DESKTOP, ByVal StrPtr(ErMsg), ByVal StrPtr(Source), ByVal %MB_ICONWARNING
End If
End If
SHFreeNameMappings shfos.hNameMappings
Function = lResult
End Function
'------------------------------------------------------------------------------------------
Function GetLastErrorDescription( ByVal ErrorCode As Long) As String
Dim sRtrnCode As Asciiz * 256
Dim lRet As Long
If ErrorCode = %ERROR_SUCCESS Then Exit Function
lRet = FormatMessage( %FORMAT_MESSAGE_FROM_SYSTEM, _
ByVal 0&, _
ErrorCode, _
ByVal 0&, _
sRtrnCode, _
SizeOf( sRtrnCode ), _
ByVal 0& )
If lRet > 0 Then Function = Left$( sRtrnCode, lRet )
End Function
'---------------------------------------------------------------------------------
'---------------------------------------------------------------------------------
'---------------------------------------------------------------------------------
Comment