じゃんぬねっと日誌

ネタと雑記と時々プログラミング

目次

Blog 利用状況

ニュース

マッド・ロックの伝道士を始めました。

スポンサードリンク

運営サイト

  • C# と VB.NET の入門サイト

書庫

VB6 で .NET Framework!?

ネタ記事です。

次のコードはどの言語で書かれたものでしょうか?

問題のコード

Private Sub MosaMosaAA()
    Dim sourcePath As String
    sourcePath = System.IO.Path.Combine("C:\Hoge\Foo\Bar", "Piyo.txt")

    Dim destPath As String
    destPath = System.IO.Path.Combine("C:\Fuga", "Hage.txt")

    Call System.IO.File.Copy(sourcePath, destPath)
    Call System.IO.File.Delete(sourcePath)
End Sub

Visual Basic .NET っぽいですね。実際 VB.NET ならば上記のコードがそのまま使えるでしょう。しかし実際には Visual Basic 6.0 のコードです。もちろんお遊びコードです。.NET Framework 好きにはたまらない (!?) のではないでしょうか。以下はタネ明かしです。

System.cls クラス モジュール

'/** System 擬似名前空間 */
Option Explicit

' プロパティ変数
Private mIo As System_IO

' System.IO プロパティ - Getter
Public Property Get IO() As System_IO
    Set IO = mIo
End Property

' コンストラクタ
Private Sub Class_Initialize()
    Set mIo = New System_IO
End Sub

System_IO.cls クラス モジュール

'/** System.IO 擬似名前空間 */
Option Explicit

' プロパティ変数
Private mPath      As System_IO_Path
Private mFile      As System_IO_File
Private mDirectory As System_IO_Directory

' System.IO.Path プロパティ - Getter
Public Property Get Path() As System_IO_Path
    Set Path = mPath
End Property

' System.IO.File プロパティ - Getter
Public Property Get File() As System_IO_File
    Set File = mFile
End Property

' System.IO.Directory プロパティ - Getter
Public Property Get Directory() As System_IO_Directory
    Set Directory = mDirectory
End Property

' コンストラクタ
Private Sub Class_Initialize()
    Set mPath = New System_IO_Path
    Set mFile = New System_IO_File
    Set mDirectory = New System_IO_Directory
End Sub

System_IO_Directory.cls クラス モジュール

' /** System.IO.Directory 擬似クラス */
Option Explicit

' ラッパ対象オブジェクト
Private mFso As Scripting.FileSystemObject

' コンストラクタ
Private Sub Class_Initialize()
    Set mFso = New FileSystemObject
End Sub

' デストラクタ
Private Sub Class_Terminate()
    Set mFso = Nothing  '意味はない
End Sub

' ディレクトリが存在しているか確認
Public Function Exists(ByVal stPath As String) As Boolean
    Let Exists = mFso.FolderExists(stPath)
End Function

' ディレクトリをコピーする
Public Sub Copy(ByVal stSourcePath As String, ByVal stDestinationPath As String)
    Call mFso.CopyFolder(stSourcePath, stDestinationPath)
End Sub

' ディレクトリを移動する
Public Sub Move(ByVal stSourcePath As String, ByVal stDestinationPath As String)
    stSourcePath = RemoveFilePathLastPathSeparatorChar(stSourcePath)
    Call mFso.MoveFolder(stSourcePath, stDestinationPath)
End Sub

' ディレクトリを削除する
Public Sub Delete(ByVal stPath As String)
    Call mFso.DeleteFolder(stPath, True)
End Sub

' ディレクトリの名前を変更する
Public Sub Rename(ByVal stPath As String, ByVal stNewDirectoryName As String)
    Dim stParentDirectory As String
    stParentDirectory = mFso.GetParentFolderName(stPath)

    Dim stNewPath As String
    stNewPath = mFso.BuildPath(stParentDirectory, stNewDirectoryName)

    Call Me.Move(stPath, stNewPath)
End Sub

' ディレクトリを作成する
Public Function Create(ByVal stPath As String) As Scripting.Folder
    Set Create = mFso.CreateFolder(stPath)
End Function

' 指定されたファイルパスの Folder クラスのインスタンスを取得する
Public Function GetFolderObject(ByVal stPath As String) As Scripting.Folder
    Set GetFolderObject = mFso.GetFolder(stPath)
End Function

' このパスに含まれるファイルをすべて列挙する
Public Function GetFiles(ByVal stPath As String) As String()
    Dim cFolder As Scripting.Folder
    Set cFolder = Me.GetFolderObject(stPath)

    Dim cFiles As Scripting.Files
    Set cFiles = cFolder.Files

    Dim lLength As Long
    lLength = cFiles.Count - 1

    Dim stReturns() As String
    ReDim stReturns(lLength)

    Dim i As Long
    For i = 0 To lLength
        stReturns(i) = cFiles(i).Path
    Next

    Let GetFiles = stReturns()
End Function

' このパスに含まれるディレクトリをすべて列挙する
Public Function GetDirectories(ByVal stPath As String) As String()
    Dim cFolder As Scripting.Folder
    Set cFolder = Me.GetFolderObject(stPath)

    Dim cSubFolders As Scripting.Folders
    Set cSubFolders = cFolder.SubFolders

    Dim lLength As Long
    lLength = cSubFolders.Count - 1

    Dim stReturns() As String
    ReDim stReturns(lLength)

    Dim i As Long
    For i = 0 To lLength
        stReturns(i) = cSubFolders(i).Path
    Next

    Let GetDirectories = stReturns()
End Function

' 属性を取得する
Public Function GetAttribute(ByVal stPath As String) As Scripting.FileAttribute
    Dim cFolder As Scripting.Folder
    Set cFolder = Me.GetFolderObject(stPath)

    If Not cFolder Is Nothing Then
        Let GetAttribute = cFolder.Attributes
    End If
End Function

' 属性を設定する
Public Sub SetAttributes(ByVal stPath As String, ByVal uAttributes As Scripting.FileAttribute)
    Dim cFolder As Scripting.Folder
    Set cFolder = Me.GetFolderObject(stPath)

    If Not cFolder Is Nothing Then
        cFolder.Attributes = uAttributes
    End If
End Sub

' 作成日を取得する
Public Function GetCreateTime(ByVal stPath As String) As Date
    Dim cFolder As Scripting.Folder
    Set cFolder = Me.GetFolderObject(stPath)

    If Not cFolder Is Nothing Then
        Let GetCreateTime = cFolder.DateCreated
    End If
End Function

' 更新日を取得する
Public Function GetUpdateTime(ByVal stPath As String) As Date
    Dim cFolder As Scripting.Folder
    Set cFolder = Me.GetFolderObject(stPath)

    If Not cFolder Is Nothing Then
        Let GetUpdateTime = cFolder.DateLastModified
    End If
End Function

' 最終アクセス日を取得する
Public Function GetLastAccessTime(ByVal stPath As String) As Date
    Dim cFolder As Scripting.Folder
    Set cFolder = Me.GetFolderObject(stPath)

    If Not cFolder Is Nothing Then
        Let GetLastAccessTime = cFolder.DateLastAccessed
    End If
End Function

' ファイルパスの最後のパス区切り文字を削除する
Private Function RemoveFilePathLastPathSeparatorChar(ByVal stPath As String) As String
    Dim lLength As Long
    lLength = CLng(Len(stPath))

    Do While (ExistsLastPathSeparatorChar(stPath))
        lLength = lLength - 1
        stPath = Left$(stPath, lLength)
    Loop

    RemoveFilePathLastPathSeparatorChar = stPath
End Function

' ファイルパスの最後がパス区切り文字かどうかを確認
Private Function ExistsLastPathSeparatorChar(ByVal stPath As String) As Boolean
    Const PATH_SEPARATOR_CHAR As String = "\"

    Let ExistsLastPathSeparatorChar = (Right$(stPath, 1) = PATH_SEPARATOR_CHAR)
End Function

System_IO_File.cls クラス モジュール

' /** System.IO.File 擬似クラス */
Option Explicit

' ラッパ対象オブジェクト
Private mFso As Scripting.FileSystemObject

' コンストラクタ
Private Sub Class_Initialize()
    Set mFso = New FileSystemObject
End Sub

' デストラクタ
Private Sub Class_Terminate()
    Set mFso = Nothing  '意味はない
End Sub

' ファイルが存在しているか確認
Public Function Exists(ByVal stPath As String) As Boolean
    Let Exists = mFso.FileExists(stPath)
End Function

' ファイルをコピーする
Public Sub Copy(ByVal stSourcePath As String, ByVal stDestinationPath As String)
    Call mFso.CopyFile(stSourcePath, stDestinationPath)
End Sub

' ファイルを移動する
Public Sub Move(ByVal stSourcePath As String, ByVal stDestinationPath As String)
    Call mFso.MoveFile(stSourcePath, stDestinationPath)
End Sub

' ファイルを削除する
Public Sub Delete(ByVal stPath As String)
    Call mFso.DeleteFile(stPath, True)
End Sub

' ファイルの名前を変更する
Public Sub Rename(ByVal stPath As String, ByVal stNewFileName As String)
    Dim stParentDirectory As String
    stParentDirectory = mFso.GetParentFolderName(stPath)

    Dim stNewPath As String
    stNewPath = mFso.BuildPath(stParentDirectory, stNewFileName)

    Call mFso.MoveFile(stPath, stNewPath)
End Sub

' ファイルを作成する
Public Function Create(ByVal stPath As String) As Scripting.File
    Dim cTextStream As Scripting.TextStream
    Set cTextStream = mFso.CreateTextFile(stPath)

    If Not cTextStream Is Nothing Then
        Call cTextStream.Close
        Set cTextStream = Nothing
    End If

    Set Create = Me.GetFileObject(stPath)
End Function

' ファイルを開く
Public Function OpenText(ByVal stPath As String, Optional ByVal uOpenMode As IOMode = ForReading, Optional ByVal bCreate As Boolean = False) As Scripting.TextStream
    Set OpenText = mFso.OpenTextFile(stPath, uOpenMode, bCreate)
End Function

' 指定されたファイルパスの File クラスのインスタンスを取得する
Public Function GetFileObject(ByVal stPath As String) As Scripting.File
    Set GetFileObject = mFso.GetFile(stPath)
End Function

' ファイルの属性を取得する
Public Function GetAttributes(ByVal stPath As String) As Scripting.FileAttribute
    Dim cFile As Scripting.File
    Set cFile = Me.GetFileObject(stPath)

    If Not cFile Is Nothing Then
        Let GetAttributes = cFile.Attributes
    End If
End Function

' ファイルの属性を設定する
Public Sub SetAttributes(ByVal stPath As String, ByVal uAttributes As Scripting.FileAttribute)
    Dim cFile As Scripting.File
    Set cFile = Me.GetFileObject(stPath)

    If Not cFile Is Nothing Then
        cFile.Attributes = uAttributes
    End If
End Sub

' 作成日を取得する
Public Function GetCreateTime(ByVal stPath As String) As Date
    Dim cFile As Scripting.File
    Set cFile = Me.GetFileObject(stPath)

    If Not cFile Is Nothing Then
        Let GetCreateTime = cFile.DateCreated
    End If
End Function

' 更新日を取得する
Public Function GetUpdateTime(ByVal stPath As String) As Date
    Dim cFile As Scripting.File
    Set cFile = Me.GetFileObject(stPath)

    If Not cFile Is Nothing Then
        Let GetUpdateTime = cFile.DateLastModified
    End If
End Function

' 最終アクセス日を取得する
Public Function GetLastAccessTime(ByVal stPath As String) As Date
    Dim cFile As Scripting.File
    Set cFile = Me.GetFileObject(stPath)

    If Not cFile Is Nothing Then
        Let GetLastAccessTime = cFile.DateLastAccessed
    End If
End Function

' ファイルバージョンを取得する
Public Function GetFileVersion(ByVal stPath As String) As String
    Let GetFileVersion = mFso.GetFileVersion(stPath)
End Function

System_IO_Path.cls

' /** System.IO.Path 擬似クラス */
Option Explicit

' ラッパ対象オブジェクト
Private mFso As Scripting.FileSystemObject

' コンストラクタ
Private Sub Class_Initialize()
    Set mFso = New FileSystemObject
End Sub

' デストラクタ
Private Sub Class_Terminate()
    Set mFso = Nothing  '意味はない
End Sub

' ファイル名を取得する
Public Function GetFileName(ByVal stPath As String) As String
    Let GetFileName = mFso.GetFileName(stPath)
End Function

' 拡張子なしファイル名を取得する
Public Function GetFileNameWithoutExtension(ByVal stPath As String) As String
    Let GetFileNameWithoutExtension = mFso.GetBaseName(stPath)
End Function

' 拡張子名を取得する
Public Function GetExtensionName(ByVal stPath As String) As String
    Let GetExtensionName = mFso.GetExtensionName(stPath)
End Function

' 親ディレクトリ名を取得する
Public Function GetParentDirectoryName(ByVal stPath As String) As String
    Let GetParentDirectoryName = mFso.GetParentFolderName(stPath)
End Function

' ファイルパスを結合して返す
Public Function Combine(ByVal stPath1 As String, ByVal stPath2 As String) As String
    Let Combine = mFso.BuildPath(stPath1, stPath2)
End Function

' 指定されたパスの絶対パスを取得する
Public Function GetFullPath(ByVal stPath As String) As String
    Let GetFullPath = mFso.GetAbsolutePathName(stPath)
End Function

' システムパスを取得する
Public Function GetSystemPath(ByVal uSpecialFolder As SpecialFolderConst)
    Let GetSystemPath = mFso.GetSpecialFolder(uSpecialFolder)
End Function

' 一時ファイル名を取得する
Public Function GetTemporaryFileName() As String
    Let GetTemporaryFileName = mFso.GetTempName()
End Function

本格的 (?) にやるならタイプ ライブラリを作った方が良いと思います... って、誰もやらねーよw

投稿日時 : 2008年5月27日 11:45

コメントを追加

# re: VB6 で .NET Framework!? 2008/05/27 12:14 ちゃっぴ

よりによってなぜ使えない System.IO を選ぶ!

ちなみに wrapper なんぞ使わなくても、VB 6.0 から扱える .NET Framework の class ありますね。

# re: VB6 で .NET Framework!? 2008/05/27 12:18 じゃんぬねっと

> よりによってなぜ使えない System.IO を選ぶ!

有名 && 楽だったからw

> ちなみに wrapper なんぞ使わなくても、VB 6.0 から扱える .NET Framework の class ありますね。

ありますね。
どこぞの掲示板で似たような質問があって、少し驚きました。

# re: VB6 で .NET Framework!? 2008/05/27 12:39 HiJun

ここまで書かなければいけないのであれば、
開発者は絶対に.NETを選ぶと思う...

# re: VB6 で .NET Framework!? 2008/05/27 12:51 癒耶

System_IO_Directory.clsが2つあるような。
ごめんなさい。
VB6.0でどこまでVB.NETぽく出来るかって面白そうですね。
ほぼ全て実装!とか。

# re: VB6 で .NET Framework!? 2008/05/27 13:28 ネタ好き未記入

じゃんぬさんナイス!
これはいいネタだと思います。
プログラミングには遊び精神が大事ですよねw

# re: VB6 で .NET Framework!? 2008/05/27 14:22 ネタ好き未記入

これをさらに進めて、カーネルレベルからVB6でエ謬レートすれば大傑作だと思います。
「すごく能力と時間の無駄ずかいだ!」ってね。

# re: VB6 で .NET Framework!? 2008/05/27 14:40 ネタ好き未記入

マジレスすると、このじゃんぬさんが提示したSystem.IOの見本はVB6から移行できない人にとっては大変ためになると思います。

タイトル  
名前  
URL
コメント