frog.raindrop.jp.knowledge

タスクトレイにアイコンを表示するユーザーコントロールで使用した pDllErrRaise を呼び出している場所があるので、ご利用の際はそちらも参照。

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CFileFind"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'******************************************************************
'CommonClass.vbp
'CFileFind
'ファイル検索クラス
'2005/06/23
'******************************************************************
Option Explicit

'' ----------------------------------------
''    定数定義
'' ----------------------------------------
Private Const CNST_MODULE_NAME          As String = "CFileFind"
Private Const INVALID_HANDLE_VALUE      As Long = -1&
Private Const ERROR_FILE_NOT_FOUND      As Long = 2&
Private Const ERROR_NO_MORE_FILES       As Long = 18&
Private Const MAX_PATH                  As Long = 260


'' ----------------------------------------
''    型定義
'' ----------------------------------------
Private Type FILETIME
        dwLowDateTime                   As Long
        dwHighDateTime                  As Long
End Type
Private Type WIN32_FIND_DATA
        dwFileAttributes                As Long
        ftCreationTime                  As FILETIME
        ftLastAccessTime                As FILETIME
        ftLastWriteTime                 As FILETIME
        nFileSizeHigh                   As Long
        nFileSizeLow                    As Long
        dwReserved0                     As Long
        dwReserved1                     As Long
        cFileName(MAX_PATH - 1&)        As Byte
        cAlternate(13)                  As Byte
End Type

Private Type BY_HANDLE_FILE_INFORMATION
        dwFileAttributes                As Long
        ftCreationTime                  As FILETIME
        ftLastAccessTime                As FILETIME
        ftLastWriteTime                 As FILETIME
        dwVolumeSerialNumber            As Long
        nFileSizeHigh                   As Long
        nFileSizeLow                    As Long
        nNumberOfLinks                  As Long
        nFileIndexHigh                  As Long
        nFileIndexLow                   As Long
End Type

'' ----------------------------------------
''    外部ライブラリ関数
'' ----------------------------------------
Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (dest As Any, ByVal numBytes As Long)
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function GetFullPathName Lib "kernel32" Alias "GetFullPathNameA" (lpFileName As Any, ByVal nBufferLength As Long, lpBuffer As Any, lpFilePart As Any) As Long
Private Declare Function GetFileInformationByHandle Lib "kernel32" (ByVal hFile As Long, lpFileInformation As BY_HANDLE_FILE_INFORMATION) As Long

'' ----------------------------------------
''    変数定義
'' ----------------------------------------
Private mstrFileName                    As String
Private menmAttribute                   As Long

Private mhFindFile                      As OLE_HANDLE
Private mudtFindData                    As WIN32_FIND_DATA

'******************************************************************
'プロパティ名:    :Get Attributes
'説明:            :最後に見つかったファイルの属性値を返します
'戻り値           :VbFileAttribute型    属性値の組み合わせ
'******************************************************************
Public Property Get Attributes() As VbFileAttribute
'============= Declare ==============
'============= Initiarize ===========
On Error GoTo ERR_HANDLER_00

'============= Main =================

    Attributes = mudtFindData.dwFileAttributes

'============= Release ==============
RESUME_00:
    Exit Property
'============= Error ================
ERR_HANDLER_00:
    Call Err.Raise(Err.Number, CNST_MODULE_NAME & ".Get Attributes ← " & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)

End Property

'******************************************************************
'プロパティ名:    :Get FileName
'説明:            :最後に見つかったファイルのファイル名を返します
'戻り値           :String型 ファイル名
'******************************************************************
Public Property Get FileName() As String
'============= Declare ==============
'============= Initiarize ===========
On Error GoTo ERR_HANDLER_00

'============= Main =================

    FileName = mstrFileName

'============= Release ==============
RESUME_00:
    Exit Property
'============= Error ================
ERR_HANDLER_00:
    Call Err.Raise(Err.Number, CNST_MODULE_NAME & ".Get FileName ← " & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)

End Property

'******************************************************************
'プロシージャ名:  :FirstFile
'説明:            :指定条件に一致する最初のファイルを検索する
'引数:            :pstrFileSpec       I   検索対象のファイル ワイルドカード可
'戻り値           :Boolean型    True ならファイルあり
'******************************************************************
Public Function FirstFile(pstrFileSpec As String) As Boolean
'============= Declare ==============
'============= Initiarize ===========
On Error GoTo ERR_HANDLER_00
    FirstFile = False
'============= Main =================
    
    ' 初期化
    Call Release
        
    ' 検索を開始する
    mhFindFile = FindFirstFile(pstrFileSpec, mudtFindData)
    If (INVALID_HANDLE_VALUE = mhFindFile) Then
        If (ERROR_FILE_NOT_FOUND = Err.LastDllError) Then
            Exit Function
        End If
        
        ' 対象ファイルなし以外の例外
        Call pDllErrRaise(Err.LastDllError, "FindFirstFile")
    End If
    
    ' 検索結果を取得する
    Call SetResult
    If ("." = mstrFileName) Or (".." = mstrFileName) Then
        ' 再検索
        FirstFile = NextFile()
    Else
        ' 検索結果有効
        FirstFile = True
    End If
    
'============= Release ==============
RESUME_00:
    Exit Function
'============= Error ================
ERR_HANDLER_00:
    Call Err.Raise(Err.Number, CNST_MODULE_NAME & ".FirstFile ← " & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)

End Function

'******************************************************************
'プロシージャ名:  :NextFile
'説明:            :指定条件に一致する次のファイルを検索します
'戻り値           :Boolean型    True ならファイルあり
'******************************************************************
Public Function NextFile() As Boolean
'============= Declare ==============
'============= Initiarize ===========
On Error GoTo ERR_HANDLER_00
    NextFile = False
'============= Main =================

    Do
        ' 次のファイルを検索する
        If (0& = FindNextFile(mhFindFile, mudtFindData)) Then
            If (ERROR_NO_MORE_FILES = Err.LastDllError) Then
                Exit Function
            End If
            
            ' これ以上ファイルなし以外の例外
            Call pDllErrRaise(Err.LastDllError, "FindNextFile")
        End If
        
        ' 結果を設定する
        Call SetResult
        
        ' カレントディレクトリと親ディレクトリはスキップ
        If ("." = mstrFileName) Then
        ElseIf (".." = mstrFileName) Then
        Else
            NextFile = True
        End If
        
    Loop Until (NextFile)

'============= Release ==============
RESUME_00:
    Exit Function
'============= Error ================
ERR_HANDLER_00:
    Call Err.Raise(Err.Number, CNST_MODULE_NAME & ".NextFile ← " & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)

End Function

'******************************************************************
'プロシージャ名:  :Release
'説明:            :検索ハンドルを解放し、パラメータを初期化する
'******************************************************************
Public Sub Release()
'============= Declare ==============
'============= Initiarize ===========
On Error GoTo ERR_HANDLER_00

'============= Main =================

    If (INVALID_HANDLE_VALUE <> mhFindFile) Then
        Call FindClose(mhFindFile)
    End If
    mhFindFile = INVALID_HANDLE_VALUE
    mstrFileName = ""
    mstrPath = ""
    Call ZeroMemory(mudtFindData, Len(mudtFindData))

'============= Release ==============
RESUME_00:
    Exit Sub
'============= Error ================
ERR_HANDLER_00:
    Call Err.Raise(Err.Number, CNST_MODULE_NAME & ".Release ← " & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)

End Sub

'------------------------------------------------------------------
'プロシージャ名:  :SetResult
'説明:            :検索結果をプロパティに設定する
'------------------------------------------------------------------
Private Sub SetResult()
'============= Declare ==============
Dim lngRet              As Long
Dim strTemp             As String
Dim bytBuffer(MAX_PATH) As Byte

'============= Initiarize ===========
On Error GoTo ERR_HANDLER_00

'============= Main =================

    ' ファイル名を取り出す
    strTemp = StrConv(mudtFindData.cFileName, vbUnicode)
    strTemp = Left$(strTemp, InStr(strTemp, vbNullChar) - 1&)
    mstrFileName = strTemp
    
'============= Release ==============
RESUME_00:
    Exit Sub
'============= Error ================
ERR_HANDLER_00:
    Call Err.Raise(Err.Number, CNST_MODULE_NAME & ".SetResult ← " & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)

End Sub

'------------------------------------------------------------------
'プロシージャ名:  :Class_Initialize
'説明:            :オブジェクトの初期化を行う
'------------------------------------------------------------------
Private Sub Class_Initialize()
'============= Declare ==============
'============= Initiarize ===========
On Error GoTo ERR_HANDLER_00

'============= Main =================

    mhFindFile = INVALID_HANDLE_VALUE
    Call Release

'============= Release ==============
RESUME_00:
    Exit Sub
'============= Error ================
ERR_HANDLER_00:
    Call HandleError(Err.Number, Err.Source, Err.Description, CNST_MODULE_NAME & ".Class_Initialize")

    Resume RESUME_00
End Sub

'------------------------------------------------------------------
'プロシージャ名:  :Class_Terminate
'説明:            :リソースの解放等を行う
'------------------------------------------------------------------
Private Sub Class_Terminate()
'============= Declare ==============
'============= Initiarize ===========
On Error GoTo ERR_HANDLER_00

'============= Main =================

    Call Release
    
'============= Release ==============
RESUME_00:
    Exit Sub
'============= Error ================
ERR_HANDLER_00:
    Call HandleError(Err.Number, Err.Source, Err.Description, CNST_MODULE_NAME & ".Class_Terminate")

    Resume RESUME_00
End Sub