fileprocess.bas

这是一本学习串口编程喝计算机监控的好书里面是用VB开发的源代码

Attribute VB_Name = "FileProcess"
Option Explicit
'no dependence
'Reference: Microsoft Scripting Runtime

Public Function ReadTxtFile(strPath As String) As String
    Dim objFile As New FileSystemObject
    Dim fTxt As TextStream
    On Error Resume Next
    
    If strPath = "" Or objFile.FileExists(strPath) = False Then
        If strPath = "" Then Exit Function
        'MsgBox "Error file name!", vbExclamation + vbOKOnly
        Exit Function
    End If
    
    Set fTxt = objFile.OpenTextFile(strPath, ForReading, False)
    
    ReadTxtFile = fTxt.ReadAll
    If Err Then ReadTxtFile = ""
    fTxt.Close
End Function

Public Function WriteStringToTxt(ByVal strSource As String, strPath As String) As Integer
    Dim objFile As New FileSystemObject
    Dim fTxt As TextStream
    
    If strPath = "" Then
        MsgBox "Path or file name is error!", vbExclamation + vbOKOnly
        WriteStringToTxt = 0
        GoTo EndMark
    End If
    
    Set fTxt = objFile.OpenTextFile(strPath, ForWriting, True)
    
    fTxt.Write strSource
    fTxt.Close
    
    WriteStringToTxt = 1   'Success!
EndMark:
End Function

Public Function CheckFile(strPath As String) As Boolean
    Dim objFile As New FileSystemObject
    
    If strPath = "" Then
        MsgBox "Path or file name is error!", vbExclamation + vbOKOnly
        GoTo EndMark
    End If
    
    If objFile.FileExists(strPath) Then
        CheckFile = True
    End If
EndMark:
End Function

Public Sub KillSpFile(strPath As String)
    Dim objFile As New FileSystemObject
    
    If objFile.FileExists(strPath) Then
        objFile.DeleteFile strPath, True
    End If
End Sub

Public Sub CheckCreateFolder(strPath As String)
    Dim objFile As New FileSystemObject
    
    If objFile.FolderExists(strPath) = False Then
        objFile.CreateFolder strPath
    End If
End Sub

Public Function CheckDrive(strDrive As String) As Boolean
    Dim objFile As New FileSystemObject
    On Error GoTo EndMark
       
    If objFile.DriveExists(strDrive) Then CheckDrive = True
EndMark:
End Function

Public Function CheckFolder(strPath As String) As Boolean
    Dim objFile As New FileSystemObject
    
    If objFile.FolderExists(strPath) Then
        CheckFolder = True
    End If
End Function

Public Sub MyCopyFile(strSource As String, strDestination As String)
    Dim objFile As New FileSystemObject
    objFile.CopyFile strSource, strDestination, True
End Sub


Public Function GenFileName(ByVal strSource As String) As String
    'change these chars: \/:*?"<>|
    Dim strSet As String
    Dim I As Integer
    Dim strTmp As String
    Dim strChar As String
    Dim nLoc As Integer
    Dim strReplaceChar As String
    
    strTmp = strSource
    strSet = "\/:*?<>|" + Chr(&H22)
    I = 1
    
    strChar = Mid(strSet, I, 1)
    Do While strChar <> ""
        nLoc = InStr(1, strTmp, strChar)
        If nLoc <> 0 Then
            Select Case strChar
                Case ":"
                    strReplaceChar = "："
                Case "?"
                    strReplaceChar = "？"
                Case Else
                    strReplaceChar = "-"
            End Select
            strTmp = Mid(strTmp, 1, nLoc - 1) + strReplaceChar + Mid(strTmp, nLoc + 1)
        End If
        
        I = I + 1
        strChar = Mid(strSet, I, 1)
        DoEvents
    Loop
    
    GenFileName = strTmp
End Function