mfiles.bas

vb做的安装源程序

    'Example: mMoveFile "C:\windows\calc.exe", "C:\windows\desktop\temp\calc.exe"
    Set fs = CreateObject("Scripting.FileSystemObject")
    mCheckPathFolders (mDestination)
    fs.MoveFile mFileName, mDestination
End Sub

Public Sub mRenameFile(mFileName, mNewName As String)
    'Example: nRenameFile "C:\Test.exe", "Tested.exe"
    Dim mRenameFileLen
    Dim mRenameFileChar
    Set fs = CreateObject("Scripting.FileSystemObject")
    If fs.FileExists(mFileName) = False Then
        Exit Sub
    End If
    mRenameFileLen = Len(mFileName) - 1
    Do Until mRenameFileChar = "\"
        mRenameFileChar = Mid(mFileName, mRenameFileLen, 1)
        mRenameFileLen = mRenameFileLen - 1
    Loop
    mNewName = Left(mFileName, mRenameFileLen - 1) + "\" + mNewName
    Name mFileName As mNewName   ' Move and rename file.
End Sub

Public Sub mKillFile(mFileName)
    'Example: mKillFile("C:\testing.exe")
    Set fs = CreateObject("Scripting.FileSystemObject")
    If fs.FileExists(mFileName) = False Then
        Exit Sub
    End If
    Kill mFileName
End Sub

Public Function mGetDir(mFileName)
    'Example: mGetDir "C:\Windows\calc.exe"
    Dim c As String
    Dim i As Integer
    i = Len(mFileName)
    Do Until c = "\"
        i = i - 1
        If i <= 0 Then
            mGetDir = "Not Known"
            Exit Function
        End If
        c = Mid(mFileName, i, 1)
        If c = "\" Then
            mGetDir = Left(mFileName, i)
        End If
    Loop
End Function

Public Sub mCreateFolder(mDestination)
    'Example: mCreateFolder "C:\Temp\Testing\TempFolder1\"
    mCheckPathFolders (mDestination)
End Sub

Public Sub mOpenFolder(mDestination)
    'Example: mOpenFolder "C:\Windows\"
    Call Shell("explorer " & mDestination, vbNormalFocus)
End Sub

Public Sub mCopyFolder(mSource, mDestination, mOverwrite)
    'Example mCopyFolder"C:\Program Files\", "C:\Backup\Program Files\", True
    Set fs = CreateObject("Scripting.FileSystemObject")
    mCheckPathFolders (mDestination)
    fs.CopyFolder mSource, mDestination, mOverwrite
End Sub

Public Sub mCopySubFolders(mSource, mDestination, mOverwrite)
    'Example mCopySubFolders "C:\Program Files\", "C:\Backup\Program Files\", True
    Set fs = CreateObject("Scripting.FileSystemObject")
    mCheckPathFolders (mDestination)
    mSource = mSource + "*"
    fs.CopyFolder mSource, mDestination, mOverwrite
End Sub

Public Sub mEmptyFolder(mDestination)
    'Example: mEmptyFolder ("C:\Windows\Temp\")
    Set fs = CreateObject("Scripting.FileSystemObject")
    mDestination = mDestination + "*"
    fs.DeleteFolder mDestination, True
    fs.deletefile mDestination, True
End Sub

Public Sub mDeleteFolder(mDestination)
    'Example: mDeleteFolder ("C:\Windows\Temp\")
    Set fs = CreateObject("Scripting.FileSystemObject")
    fs.DeleteFolder mDestination, True
End Sub

Function mFolderExists(mDestination)
    'Example: MsgBox mFolderExists ("C:\Windows\")
    Set fs = CreateObject("Scripting.FileSystemObject")
    mFolderExists = fs.folderexists(mDestination)
End Function

Public Function mCheckPath(mDestination)
    'Example: MyFileName = mCheckPath(FilePath)
    If Right(mDestination, 1) = "\" Then
        mCheckPath = mDestination
    Else
        mCheckPath = mDestination & "\"
    End If
End Function



Function mGetIniValue(mSearchFor As String, mDestination)
    'Example: MsgBox mGetIniValue ("Caption= ", "app.path & "\MyFile.ini")
    Dim mTempLine As String
    Set fs = CreateObject("Scripting.FileSystemObject")
    If fs.FileExists(mDestination) = False Then
        MsgBox mDestination & " file does not exist!", vbCritical + vbOKOnly, "File Access Error"
        Exit Function
    End If
    Open mDestination For Input As #1
        Do While Not EOF(1)
            Line Input #1, mTempLine
            If Left(mTempLine, Len(mSearchFor)) = mSearchFor Then
                mGetIniValue = Mid(mTempLine, Len(mSearchFor))
                Exit Function
            End If
        Loop
    Close #1
End Function

Public Sub mShellFile(mFileName, mMaxNormalMin As Integer)
    'Example: mShellFile ("C:\Windows\Calc.exe", 3)
    Dim RetVal

    
    Set fs = CreateObject("Scripting.FileSystemObject")
    If fs.FileExists(mFileName) = False Then
        Exit Sub
    End If
    Select Case mMaxNormalMin
        Case 0
            mMaxNormalMin = 1
        Case 1
            mMaxNormalMin = 3
        Case 2
            mMaxNormalMin = 1
        Case 3
            mMaxNormalMin = 0
    End Select
    
    RetVal = Shell(mFileName, mMaxNormalMin)
End Sub

Public Sub mEmail(mEmailAddress As String)
    'Example: mEmail "[e-mail]"
    mEmailAddress = "mailto:" & mEmailAddress
    ShellExecute hwnd, "open", mEmailAddress, vbNullString, vbNullString, SW_SHOW
End Sub

Public Sub mWeb(mWebAddress As String)
    'Example: mWeb "www.geocities.com/helpingthepoor"
    ShellExecute hwnd, "open", mWebAddress, vbNullString, vbNullString, SW_SHOW
End Sub

Public Function WinDir(Optional ByVal AddSlash As Boolean = False) As String
    Dim t As String * 255
    Dim i As Long
    i = GetWindowsDirectory(t, Len(t))
    WinDir = Left(t, i)


    If (AddSlash = True) And (Right(WinDir, 1) <> "\") Then
        WinDir = WinDir & "\"
    ElseIf (AddSlash = False) And (Right(WinDir, 1) = "\") Then
        WinDir = Left(WinDir, Len(WinDir) - 1)
    End If
End Function


Public Function SysDir(Optional ByVal AddSlash As Boolean = False) As String
    Dim t As String * 255
    Dim i As Long
    i = GetSystemDirectory(t, Len(t))
    SysDir = Left(t, i)


    If (AddSlash = True) And (Right(SysDir, 1) <> "\") Then
        SysDir = SysDir & "\"
    ElseIf (AddSlash = False) And (Right(SysDir, 1) = "\") Then
        SysDir = Left(SysDir, Len(SysDir) - 1)
    End If
End Function