[原创]VB程序 - 处理字符和文件名称的代码模块

'*************************************************************************
'名称：GetRowNum()
'说明：获取指定字符串中内容有多少列
'调用格式：GetRowNum("Source String"[,"Mark char"])
'参数： SStr - 源字串
'       [MarkS] - 字符型，可选，默认为","，长度不可超过1字符
'返回值类型：整型
'返回值：字串被某一分隔符分隔成的列数
'-------------------------------------------------------------------------
'程序：任晓垒              日期：05/09/2005
'*************************************************************************
Function GetRowNum(ByVal SStr As String, Optional MarkS As String = ",") As Integer
Dim I, N As Integer
 
  For I = 1 To Len(SStr)
    If Mid(SStr, I, 1) = MarkS Then N = N + 1
  Next I
  GetRowNum = N + 1
End Function

'*************************************************************************
'名称：GetRowValue()
'说明：获取指定列中字符内容的函数
'调用格式：GetRowValue("Source String",RowNumber [,"Mark char"])
'参数： SStr - 字符型，源字串
'       LocalNum - 数值型，被选取的列数
'       [MarkS] - 字符型，可选，默认为","，长度不可超过1字符
'返回值类型：字符串型
'返回值：源字串中指定列的字符内容，处于分隔符之间部分，不包括分隔符
'        任何原因导致的失败都会返回空串
'-------------------------------------------------------------------------
'程序：任晓垒              日期：04/27/2005
'*************************************************************************
Function GetRowValue(ByVal SStr As String, ByVal LocalNum As Integer, Optional MarkS As String = ",") As String
  '只允许用一个字符做为分隔符
  If Len(MarkS) > 1 Then
    GetRowValue = vbNullString
    Exit Function
  End If
 
  '检查列位置会不会超出字符串末尾
  If LocalNum > GetRowNum(SStr, MarkS) Then
    GetRowValue = vbNullString
    Exit Function
  End If

 
  '定位起始点
  Dim Ts As String
  Dim N, Begin, EndMove As Integer
  N = LocalNum: Begin = 1
 
  While N > 1
    Ts = Mid(SStr, Begin, 1)
    If Ts = MarkS Then N = N - 1
    Begin = Begin + 1
  Wend
 
  '定位结束点
 
  Dim I As Integer
  Ts = ""
 
  Do While Ts <> MarkS
    Ts = Mid(SStr, Begin + I, 1)
    I = I + 1
    If Begin + I > Len(SStr) Then Exit Do
  Loop
 
  If LocalNum = GetRowNum(SStr, MarkS) Then
    EndMove = I       '取最末列
  Else
    EndMove = I - 1   '取中间列，回滚1个字符
  End If
 
  '分隔符之间没有内容
  If EndMove = 0 Then
    GetRowValue = vbNullString
    Exit Function
  End If
   
  '函数返回值
  GetRowValue = Mid(SStr, Begin, EndMove)

End Function

'***************************************************************************************
'名称：RowReplaceEx()
'说明：替换一字串中指定某一列的内容
'调用格式：RowReplace("Source String",RowNumber,"Source String" [,"Mark char"])
'参数： SStr - 字符型，源字串
'       LocalNum - 数值型，被选取的列数
'       RStr - 字符型，替换字串
'       [MarkS] - 字符型，可选，默认为","，长度不可超过1字符'
'返回值：修改过后的字串
'返回值类型：字符型
'---------------------------------------------------------------------------------------
'
'***************************************************************************************
Public Function RowReplaceEx(ByVal SStr As String, ByVal LocalNum As Integer, ByVal RStr As String, Optional MarkS As String = ",") As String
  Dim ReplStr, Ts As String
  Dim L, C As Integer
 
  ReplStr = GetRowValue(SStr, LocalNum)
  C = Len(ReplStr)
 
  '检索长度变化（不足原长度补以对应数量空格）
  If C > Len(RStr) Then RStr = RStr & Space(C - Len(RStr))
 
  'All same string will be replaced
  RowReplaceEx = Replace(SStr, ReplStr, RStr)
 
End Function

'***************************************************************************************
'名称：RowReplace()
'说明：替换一字串中指定某一列的内容
'调用格式：RowReplace("Source String",RowNumber,"Source String" [,"Mark char"])
'参数： SStr - 字符型，源字串
'       LocalNum - 数值型，被选取的列数
'       RStr - 字符型，替换字串
'       [MarkS] - 字符型，可选，默认为","，长度不可超过1字符'
'返回值：修改过后的字串
'返回值类型：字符型
'---------------------------------------------------------------------------------------
'
'***************************************************************************************
Public Function RowReplace(ByVal SStr As String, ByVal LocalNum As Integer, ByVal RStr As String, Optional MarkS As String = ",") As String
  Dim ReplStr, Ts As String
  Dim L, C As Integer
 
  ReplStr = GetRowValue(SStr, LocalNum)
  C = Len(ReplStr)
 
  '检索长度变化（不足原长度补以对应数量空格）
  If C > Len(RStr) Then RStr = RStr & Space(C - Len(RStr))
 
  Dim S, f As Integer
  S = InStr(1, SStr, ReplStr) - 1
  f = S + Len(ReplStr) + 1
  '替换串
  RowReplace = Mid(SStr, 1, S) & RStr & Mid(SStr, f, Len(SStr))
 
End Function

'文件，文件名，扩展名，及文件路径  函数功能索引
'************************************************************************
'例如路径文名为：“C:/full/path/Filename.ext”
'
'GetFileName()    取得 文件名          返回 Filename.ext
'GetPath()        取得 文件路径        返回 C:/full/path
'NameOfFile()     取得 文件名称部分    返回 filename
'ExtOfFile()      取得 文件扩展名部分  返回 ext
'************************************************************************

'-------------------------------------------------------
'功能：返回一个完整路径中的文件名部分。
'名称：GetFileName()
'参数：一个完整的全路径
'类型：字符型
'返回值类型：字符型
'-------------------------------------------------------
'程序：任晓垒       日期：2005-7-8    修改：-
'-------------------------------------------------------
Public Function GetFileName(ByVal FullPath As String) As String
  If FullPath = "" Then GetFileName = "": Exit Function
 
  Dim N As Integer
 
  N = GetRowNum(FullPath, "/")
  GetFileName = GetRowValue(FullPath, N, "/")

End Function

'-------------------------------------------------------
'功能：返回一个完整路径中的路径部分。
'名称：GetPath()
'参数：一个完整的全路径
'类型：字符型
'返回值类型：字符型
'-------------------------------------------------------
'程序：任晓垒       日期：2005-7-8    修改：-
'-------------------------------------------------------
Public Function GetPath(ByVal FullPath As String) As String
  If FullPath = "" Then GetPath = "": Exit Function

  Dim FN As String
  Dim Sit1 As Integer
 
  FN = GetFileName(FullPath)
  Sit1 = InStr(1, FullPath, FN)
 
  GetPath = Mid(FullPath, 1, Sit1 - 2)

End Function

'--------------------------------------------------------------------
'功能：返回一个完整“文件名+扩展名”中的文件名部分。
'名称：NameOfFile()
'参数：一个字符型完整的全路径
'类型：字符型
'返回值类型：字符型
'--------------------------------------------------------------------
'程序：任晓垒       日期：2005-7-8    修改：-
'--------------------------------------------------------------------
Public Function NameOfFile(ByVal FullPath As String) As String
  If FullPath = "" Then NameOfFile = "": Exit Function
 
  Dim FN As String
  Dim Sit1 As Integer
 
  FN = GetFileName(FullPath)
  Sit1 = InStr(1, FN, ".")
 
  If Sit1 = 0 Then
    NameOfFile = FN
  Else
    NameOfFile = Mid(FN, 1, Sit1 - 1)
  End If
End Function

'--------------------------------------------------------------------
'功能：返回一个完整“文件名+扩展名”中的扩展名部分。
'名称：ExtOfFile()
'参数：一个字符型完整的全路径
'类型：字符型
'返回值类型：字符型
'--------------------------------------------------------------------
'程序：任晓垒       日期：2005-7-8    修改：-
'--------------------------------------------------------------------
Public Function ExtOfFile(ByVal FullPath As String) As String
  If FullPath = "" Then ExtOfFile = "": Exit Function
 
  Dim FN As String
  Dim Sit1 As Integer
 
  FN = GetFileName(FullPath)
  Sit1 = InStr(1, FN, ".")

  If Sit1 = 0 Then
    ExtOfFile = ""
  Else
    ExtOfFile = Mid(FN, Sit1 + 1, Len(FN))
  End If
End Function