| |
Global FileSystem As Variant
' ******************************************************
' 初期化
' ******************************************************
Public Function FsInit()
If Not IsObject(FileSystem) Then
Set FileSystem = CreateObject("Scripting.FileSystemObject")
End If
End Function
' ******************************************************
' ファイルの読み込みオープン
' ******************************************************
Public Function FsReadOpen(strFileName As String) As Object
Call FsInit
Set FsReadOpen = FileSystem.OpenTextFile(strFileName, 1)
End Function
' ******************************************************
' ファイルの書き込みオープン
' ******************************************************
Public Function FsWriteOpen(strFileName As String) As Object
Call FsInit
Set FsWriteOpen = FileSystem.CreateTextFile(strFileName, 1)
End Function
' ******************************************************
' クローズ
' ******************************************************
Public Function FsClose(ByRef fp As Object)
fp.Close
Set fp = Nothing
End Function
' ******************************************************
' EOF
' ******************************************************
Public Function FsEof(ByRef fp As Object) As Boolean
FsEof = fp.AtEndOfStream
End Function
' ******************************************************
' ファイルの複写
' ******************************************************
Public Function FsCopy(strFrom As String, strTo As String)
Call FsInit
FileSystem.CopyFile strFrom, strTo, True
End Function
' ******************************************************
' テンポラリディレクトリの取得
' ******************************************************
Public Function FsGetTmp() As String
Call FsInit
FsGetTmp = FileSystem.GetSpecialFolder(2)
End Function
' ******************************************************
' 存在チェック
' ******************************************************
Public Function FsExist(Spec As String, nType As Integer) As Boolean
Call FsInit
Select Case nType
Case 0 ' ファイル
FsExist = FileSystem.FileExists(Spec)
Case 1 ' ディレクトリ
FsExist = FileSystem.FolderExists(Spec)
Case 2 ' ドライブ
FsExist = FileSystem.DriveExists(Spec)
End Select
End Function
' ******************************************************
' ディレクトリ作成
' ******************************************************
Public Function FsMkDir(Spec As String)
Call FsInit
Dim i
Dim strParent As String
strParent = Spec
On Error Resume Next
FileSystem.CreateFolder Spec
On Error GoTo 0
If FsExist(Spec, 1) Then
Exit Function
End If
strParent = FileSystem.GetParentFolderName(Spec)
If strParent = "" Then
Exit Function
End If
Do While Not FsExist(strParent, 1)
strParent = FileSystem.GetParentFolderName(strParent)
If strParent = "" Then
Exit Do
End If
On Error Resume Next
FileSystem.CreateFolder strParent
On Error GoTo 0
strParent = Spec
On Error Resume Next
FileSystem.CreateFolder strParent
On Error GoTo 0
Loop
End Function
' ******************************************************
' ディレクトリ削除
' ******************************************************
Public Function FsRmDir(Spec As String, Force As Boolean)
Call FsInit
On Error Resume Next
FileSystem.DeleteFolder Spec, Force
On Error GoTo 0
End Function
' ******************************************************
' カレントディレクトリ取得
' ******************************************************
Public Function FsGetCurDir() As String
Call FsInit
FsGetCurDir = FileSystem.GetAbsolutePathName(".")
End Function
' ******************************************************
' 指定ディレクトリ内のファイル一覧
' ******************************************************
Public Function FsGetFiles(Grid As Object, TargetDir As String)
Call FsInit
Dim oFolder
Dim oFc
Dim oFcw
Set oFolder = FileSystem.GetFolder(TargetDir)
Set oFc = oFolder.Files
Grid.Cols = 3
Grid.Clear
Dim i
i = 1
For Each oFcw In oFc
Grid.Rows = i + 1
Grid.TextMatrix(i, 1) = oFcw.Name
i = i + 1
Next
Grid.Sort = 1
End Function
' ******************************************************
' 使用されていないドライブを取得
' ******************************************************
Public Function FsGetFreeDrive(nType As Long) As String
Call FsInit
Dim i
Dim TargetDrive
If nType = 0 Then
For i = &H44 To &H5A
On Error Resume Next
Set TargetDrive = FileSystem.GetDrive(Chr(i) & ":")
If Err.Number <> 0 Then
FsGetFreeDrive = Chr(i) & ":"
Exit Function
End If
Next
Else
For i = &H5A To &H44 Step -1
On Error Resume Next
Set TargetDrive = FileSystem.GetDrive(Chr(i) & ":")
If Err.Number <> 0 Then
FsGetFreeDrive = Chr(i) & ":"
Exit Function
End If
Next
End If
End Function
' ******************************************************
' ファイルの削除
' ******************************************************
Public Function FsDeleteFile(TargetFile) As String
Call FsInit
Call FileSystem.DeleteFile(TargetFile, True)
End Function
| |