|
「TESTFILE001.txt」というファイルが C:\FileCopyというフォルダに存在するとします。 VB で「TESTFI~1.txt」というファイルをコピーしてみましょう。 Sub Main() FileCopy "C:\Source\TESTFI~1.txt", "C:\FileCopy\TESTFI~1.txt" End Sub さて、どうなったか?(気づいた方もいるかもしれません。) エクスプローラで確認すると、びっくり仰天! ![]() コピーしたはずのファイルがありません。 コマンドプロンプトで、「Dir /X」と打って確認してみましょう。 C:\FileCopy>Dir /X ドライブ C のボリューム ラベルは OS です ボリューム シリアル番号は 488E-7D9B です C:\FileCopy のディレクトリ 2006/06/30 16:21 <DIR> . 2006/06/30 16:21 <DIR> .. 2006/06/30 16:21 0 TESTFI~1.TXT TestFile001.txt 1 個のファイル 0 バイト 2 個のディレクトリ 47,361,773,568 バイトの空き領域 C:\FileCopy> 「TESTFILE001.txt」というファイルの 8.3形式ファイル名は、「TESTFI~1.txt」となります。 つまり、8.3形式のファイル名と同じものだったために、上書きされてしまったんですね。 ちなみに、CopyFile API を使っても、SHFileOperation API を使ってもダメでした。 ところが、エクスプローラでコピーすると、うまくいきます。 コピーしたあとの状態を Dir コマンドで確認すると、 C:\FileCopy>Dir /X ドライブ C のボリューム ラベルは OS です ボリューム シリアル番号は 488E-7D9B です C:\FileCopy のディレクトリ 2006/06/30 16:21 <DIR> . 2006/06/30 16:21 <DIR> .. 2006/06/30 16:21 0 TESTFI~2.TXT TestFile001.txt 2006/06/30 16:22 0 TestFi~1.txt 1 個のファイル 0 バイト 2 個のディレクトリ 47,361,773,568 バイトの空き領域 C:\FileCopy> 「TESTFILE001.txt」というファイルの 8.3形式ファイル名は、「TESTFI~2.txt」に変わっています。 いろいろ悩んだ挙句、以下のような方法を思いつきました。 コピーしようとするファイルが短いファイル名かどうかチェック †「コピー先にファイルがあるかどうかチェック」で説明します。 コピー先にファイルがあるかどうかチェック †GetShortPathName というAPIを使います。 Private Declare Function GetShortPathNameW _ Lib "kernel32" _ (lpszLongPath As Byte, _ lpszShortPath As Byte, _ ByVal cchBuffeer As Long) As Long '************************************************************************ ' 8.3 形式のファイル名を取得 '************************************************************************ Public Function GetShortFileName(ByVal iSourceFile As String) As String Dim bSourceFile() As Byte Dim bDestFile() As Byte Dim sDestFile As String Dim nSize As Long ' ファイル名を Unicode のバイト型配列に格納 bSourceFile = iSourceFile & vbNullChar ' 必要なバッファサイズを取得 ReDim bDestFile(0) nSize = GetShortPathNameW(bSourceFile(0), bDestFile(0), 0) If nSize > 0 Then ' nSize はTCHAR 単位なので、その2倍の長さを確保 ReDim bDestFile(nSize * 2 - 1) ' 名称を取得 nSize = GetShortPathNameW(bSourceFile(0), bDestFile(0), nSize) sDestFile = bSourceFile ' NULL 文字までを切り出し GetShortFileName = Left(sDestFile, _ InStr(sDestFile & vbNullChar, vbNullChar) - 1) Else GetShortFileName = "" End If End Function コピーして作成しようとするファイル名と、この関数から返ってきたファイル名を比較し、一致すれば、ファイルが存在し、そのファイル名は 8.3形式のファイル名であることがわかります。 '************************************************************************ ' 完全ファイル名からファイルID(ファイル名+拡張子)を取得 '************************************************************************ Public Function GetFileID(ByVal iCFName As String) As String Dim nPos As Long '後ろから「\」をサーチして、それ以降を切り出す nPos = InStrRev(iCFName, "\") If nPos > 0 Then GetFileID = Mid(iCFName, nPos + 1) Else GetFileID = iCFName End If End Function '************************************************************************ ' 完全ファイル名からパスを取得 '************************************************************************ Public Function GetFilePath(ByVal iCFName As String) As String Dim nPos As Long '後ろから「\」をサーチして、それ以前を切り出す nPos = InStrRev(iCFName, "\") If nPos > 0 Then GetFilePath = Left(iCFName, nPos - 1) Else GetFilePath = "" End If End Function 長い形式のファイル名を取得 †GetLongPathNameW というAPIを使います。 このAPI は、ファイルが存在すれば、長い形式のファイル名を返します。 APIを使うために、以下のような、GetLongFileName 関数を作成します。 Private Declare Function GetLongPathNameW _ Lib "kernel32" _ (lpszShortPath As Byte, _ lpszLongPath As Byte, _ ByVal cchBuffeer As Long) As Long '************************************************************************ ' 長い形式のファイル名を取得 '************************************************************************ Public Function GetLongFileName(ByVal iSourceFile As String) As String Dim bSourceFile() As Byte Dim bDestFile() As Byte Dim sDestFile As String Dim nSize As Long ' ファイル名を Unicode のバイト型配列に格納 bSourceFile = iSourceFile & vbNullChar ' 必要なバッファサイズを取得 ReDim bDestFile(0) nSize = GetLongPathNameW(bSourceFile(0), bDestFile(0), 0) If nSize > 0 Then ' nSize はTCHAR 単位なので、その2倍の長さを確保 ReDim bDestFile(nSize * 2 + 1) ' 名称を取得 nSize = GetLongPathNameW(bSourceFile(0), bDestFile(0), nSize) sDestFile = bDestFile ' NULL 文字までを切り出し GetLongFileName = Left(sDestFile, _ InStr(sDestFile & vbNullChar, vbNullChar) - 1) Else GetLongFileName = "" End If End Function ファイル名を別の 8.3形式のファイル名に変更 †ポイントは、変更するファイル名が (1)コピー先のフォルダに存在してはいけない 自前でロジックを作成してもいいのですが、GetTempFileName という便利な API があるので、これを使いましょう。 Private Declare Function GetTempFileNameW _ Lib "kernel32" _ (lpszPath As Byte, _ lpPrefixString As Byte, _ ByVal wUnique As Long, _ lpName As Byte) As Long Private Const MOVEFILE_REPLACE_EXISTING = &H1 Private Const MOVEFILE_DELAY_UNTIL_REBOOT = &H4 Private Const MOVEFILE_COPY_ALLOWED = &H2 Private Declare Function MoveFileEx _ Lib "kernel32" Alias "MoveFileExW" _ (lpExistingFileName As Byte, _ lpNewFileName As Byte, _ ByVal dwFlags As Long) As Long '************************************************************************ ' ファイル名を一時的に変更する '************************************************************************ Public Function RenameTempFile(ByVal iFileName As String) As String Dim bFileName() As Byte Dim bPath() As Byte Dim bTempFile() As Byte Dim bPrefix() As Byte Dim nRet As Long Dim sTempFile As String ' 対象となるパスを取得 bPath = GetFilePath(iFileName) & vbNullChar ' 接頭辞 bPrefix = "_tm" & vbNullChar ' バッファを確保 ReDim bTempFile((Len(iFileName) + 12) * 2) nRet = GetTempFileNameW(bPath(0), bPrefix(0), 0, bTempFile(0)) ' 上書きする bFileName = iFileName & vbNullChar nRet = MoveFileEx(bFileName(0), bTempFile(0), MOVEFILE_REPLACE_EXISTING) ' NULL 文字までを切り出し sTempFile = bTempFile RenameTempFile = Left(sTempFile, InStr(sTempFile & vbNullChar, vbNullChar) - 1) End Function コピーする。 †CopyFile API を使用します。 Private Declare Function CopyFileW _ Lib "kernel32" _ (lpExistingFileName As Byte, _ lpNewFileName As Byte, _ ByVal bFailIfExists As Long) As Long 変更したファイル名を元に戻す †MoveFileEx で元に戻します。 '************************************************************************ ' ファイル名をもとに戻す '************************************************************************ Public Sub RestoreTempFile(ByVal iTempFile As String, ByVal iSourceFile As String) Dim bTempFile() As Byte Dim bSourceFile() As Byte Dim nRet As Long bTempFile = iTempFile & vbNullChar bSourceFile = iSourceFile & vbNullChar nRet = MoveFileEx(bTempFile(0), bSourceFile(0), 0) End Sub 完成 †さて、これでやっと準備が整ったので、いよいよファイルコピーの関数を作成します。 '************************************************************************ ' ファイルコピー '************************************************************************ Public Sub FileCopyEx(ByVal iSourceFile As String, ByVal iDestFile As String) Dim sOrgName As String Dim sShortName As String Dim sLongCFName As String Dim sLongName As String Dim sTempName As String Dim bSourceFile() As Byte Dim bDestFile() As Byte Dim nRet As Long ' 元のファイル名と8.3形式ファイル名を比較 sOrgName = GetFileID(iDestFile) sShortName = GetFileID(GetShortFileName(iDestFile)) If StrComp(sShortName, sOrgName, vbTextCompare) = 0 Then '一致していれば、長い形式のファイル名と比較 sLongCFName = GetLongFileName(iDestFile) sLongName = GetFileID(sLongCFName) If StrComp(sLongName, sShortName, vbTextCompare) <> 0 Then ' 違う場合は、上書きするとまずいので、いったん名称を変更 sTempName = RenameTempFile(sLongCFName) End If End If bSourceFile = iSourceFile & vbNullChar bDestFile = iDestFile & vbNullChar ' コピーする nRet = CopyFileW(bSourceFile(0), bDestFile(0), 0) ' 名前を変更していれば、元に戻す If sTempName <> "" Then Call RestoreTempFile(sTempName, sLongCFName) End If End Sub |
|