One the criticisms and praises I often hear about Visual Basic (my language of choice) is that it makes things very easy to do. You'd be surprised, though: not all VB developers go the "easy" route to do simple tasks, such as copying files. I think most of us would use the FileCopy method. Or the FileSystemObject.CopyFile method. Or even come close the WTF-line by issuing a "copy" command with the Shell method. But for those really dedicated (such as a certain Angry DBA's colleague), they'll find yet another way of accomplishing what they need to do ...
Function CopyFile(ByVal Source As String, ByVal Destination As String) As Long Dim I As Long, ptr As Long Dim shfo As SHFILEOPSTRUCT Dim ByteArray() As Byte Dim buff1() As Byte, buff2() As Byte, buff3() As Byte 'Private variables Dim cSourcefiles As Collection Dim cDestFiles As Collection m_bAllowUndo = DEFAULT_ALLOWUNDO m_bConfirmMakeDir = DEFAULT_CONFIRMMAKEDIR m_bConfirmOperation = DEFAULT_CONFIRMOPERATION m_sCustomText = DEFAULT_CUSTOMTEXT m_bIncludeDirectories = DEFAULT_INCLUDEDIRECTORIES m_hParentWnd = DEFAULT_PARENTWND m_bRenameOnCollision = DEFAULT_RENAMEONCOLLISION m_bSilentMode = DEFAULT_SILENTMODE Set cSourcefiles = New Collection Set cDestFiles = New Collection cSourcefiles.Add Source cDestFiles.Add Destination 'Parent window of dialog box--just use 0 shfo.hwnd = m_hParentWnd 'Operation to perform shfo.wFunc = FO_COPY 'Operation flags shfo.fFlags = 0 If m_bAllowUndo Then shfo.fFlags = shfo.fFlags Or FOF_ALLOWUNDO End If If m_bSilentMode Then shfo.fFlags = shfo.fFlags Or FOF_SILENT End If If m_bRenameOnCollision Then shfo.fFlags = shfo.fFlags Or FOF_RENAMEONCOLLISION End If If Not m_bConfirmOperation Then shfo.fFlags = shfo.fFlags Or FOF_NOCONFIRMATION End If If Not m_bConfirmMakeDir Then shfo.fFlags = shfo.fFlags Or FOF_NOCONFIRMMKDIR End If If Not m_bIncludeDirectories Then shfo.fFlags = shfo.fFlags Or FOF_FILESONLY End If If Len(m_sCustomText) > 0 Then shfo.lpszProgressTitle = m_sCustomText shfo.fFlags = shfo.fFlags Or FOF_SIMPLEPROGRESS End If 'Build 'From' string If cSourcefiles.Count = 0 Then Err.Raise vbObjectError + 1000, , "No source files specified file operation" End If For I = 1 To cSourcefiles.Count shfo.pFrom = shfo.pFrom & cSourcefiles(I) & Chr$(0) Next I 'Build 'To' string For I = 1 To cDestFiles.Count shfo.pTo = shfo.pTo & cDestFiles(I) & Chr$(0) Next I 'Test if more than one destination files If cDestFiles.Count > 1 Then shfo.fFlags = shfo.fFlags Or FOF_MULTIDESTFILES End If 'Note: Windows packs the SHFILEOPSTRUCT structure but '32-bit Visual Basic does not. Therefore, all members 'following the two-byte fFlags member are offset by '2 bytes. To deal with this, we copy structure members 'to a byte array with the proper alignment and pass 'the byte array to SHFileOperation. ReDim ByteArray(LenB(shfo) - 2) CopyMemory ByteArray(0), shfo.hwnd, Len(shfo.hwnd) CopyMemory ByteArray(4), shfo.wFunc, Len(shfo.wFunc) 'Variable-length strings require extra work buff1 = StrConv(shfo.pFrom & Chr$(0), vbFromUnicode) ptr = VarPtr(buff1(0)) CopyMemory ByteArray(8), ptr, LenB(ptr) buff2 = StrConv(shfo.pTo & Chr$(0), vbFromUnicode) ptr = VarPtr(buff2(0)) CopyMemory ByteArray(12), ptr, LenB(ptr) CopyMemory ByteArray(16), shfo.fFlags, Len(shfo.fFlags) CopyMemory ByteArray(18), shfo.fAnyOperationsAborted, Len(shfo.fAnyOperationsAborted) CopyMemory ByteArray(22), shfo.hNameMappings, Len(shfo.hNameMappings) buff3 = StrConv(shfo.lpszProgressTitle & Chr$(0), vbFromUnicode) ptr = VarPtr(buff3(0)) CopyMemory ByteArray(26), ptr, LenB(ptr) 'Call SHFileOperation I = SHFileOperation(ByteArray(0)) 'Retrieve fAnyOperationsAborted flag CopyMemory shfo.fAnyOperationsAborted, ByteArray(18), Len(shfo.fAnyOperationsAborted) 'Return True if SHFileOperation succeeded and no operations aborted CopyFile = Not CBool(I Or shfo.fAnyOperationsAborted) Set cSourcefiles = Nothing Set cDestFiles = Nothing End Function
[Advertisement]
BuildMaster allows you to create a self-service release management platform that allows different teams to manage their applications. Explore how!