Top / TIPS / 短いファイル名

「TESTFILE001.txt」というファイルが C:\FileCopyというフォルダに存在するとします。 VB で「TESTFI~1.txt」というファイルをコピーしてみましょう。

Sub Main()
   FileCopy "C:\Source\TESTFI~1.txt", "C:\FileCopy\TESTFI~1.txt"
End Sub

さて、どうなったか?(気づいた方もいるかもしれません。)

エクスプローラで確認すると、びっくり仰天!

filecopy.gif

コピーしたはずのファイルがありません。

コマンドプロンプトで、「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 単位なので、その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形式のファイル名であることがわかります。
ところで、パス名にも長いファイル名の形式が使えますので、実際にはファイル名のみで比較する必要があります。
ファイル名のみを切り出す、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 単位なので、その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)コピー先のフォルダに存在してはいけない
(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



トップ   編集 凍結 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 単語検索 最終更新   最終更新のRSS
Last-modified: 2009-10-31 (土) 00:08:39 (2847d)