|
「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を使います。
このAPI は、ファイルが存在すれば、8.3形式の短いファイル名を返します。
APIを使うために、以下のような、GetShortFileName 関数を作成します。
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 単位なので、その２倍の長さを確保
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形式のファイル名であることがわかります。
ところで、パス名にも長いファイル名の形式が使えますので、実際にはファイル名のみで比較する必要があります。
ファイル名のみを切り出す、GetFileID 関数を作成しておきましょう。
ついでにパスを取得する関数も作っておきます。
'************************************************************************
' 完全ファイル名からファイル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 単位なので、その２倍の長さを確保
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)コピー先のフォルダに存在してはいけない
(2)コピーしようとするファイル名と一致してはいけない
自前でロジックを作成してもいいのですが、GetTempFileName という便利な API があるので、これを使いましょう。
このAPI は、存在しないファイルを作成してくれますので、返ってきたファイル名に MoveFileEx API で上書きしてやります。
これらを使うために、RenameTempFile という関数を作成します。
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
