strconv.bas

适合乡镇供电所使用电费处理系统v3 软件

Attribute VB_Name = "StrConv"
Option Explicit
Private Declare Function IsCharAlphaNumeric Lib _
   "user32" Alias "IsCharAlphaNumericA" (ByVal cChar As Byte) As Long
Private Declare Function IsCharAlpha Lib "user32" Alias "IsCharAlphaA" (ByVal cChar As Byte) As Long
'/////////指定删除字符串中字符////////
Function StringCleaner(s As String, _
    Search As String) As String
        Dim i As Integer, res As String
        res = s
        Do While InStr(res, Search)
            i = InStr(res, Search)
            res = Left(res, i - 1) & _
                Mid(res, i + 1)
        Loop
        StringCleaner = res
End Function


'///////////怎样取得一个字符串在另外一个字符串中出现的次数？///////
'//////缺点：无法统计并排的字符如ABCDD中的DD只为一次
Public Function sCount(String1 As String, String2 As String) As Integer
    Dim i As Integer, iCount As Integer
    i = 1
    Do
           If (i > Len(String1)) Then Exit Do
           i = InStr(i, String1, String2, vbTextCompare)
           If i Then
              iCount = iCount + 1
              i = i + 2
              DoEvents
           End If
    Loop While i
    sCount = iCount
End Function

'//////////怎样在一个字符串中删除里面的另外一个字符串？
Public Function sRemove(String1 As String, String2 As String)
    Dim i As Integer
    i = 1
    Do
      If (i > Len(String1)) Then Exit Do
      i = InStr(i, String1, String2)
      If i Then
         String1 = Left$(String1, i - 1) + Mid$(String1, i + Len(String2) + 1)
         i = i + 2
         DoEvents
      End If
     Loop While i
End Function

'/////////怎样在一个字符串中替换里面的另外一个字符串？
Public Sub sReplace(String1 As String, String2 As String, RepString As String)
    Dim i As Integer
    i = 1
    Do
     If (i > Len(String1)) Then Exit Do
     i = InStr(i, String1, String2)
     If i Then
        String1 = Left$(String1, i - 1) + RepString + Mid$(String1, i + Len(String2))
        i = i + 2
        DoEvents
     End If
    Loop While i
End Sub
 
'/////////□ 如何计算一个字符串中的行数？
Function CountStringLine(src_string As String) As Integer
On Error Resume Next
Dim string_flag As Integer
Dim line_cnt As Integer
Dim test_string As String
line_cnt = 0  '初始--> 行数为1
string_flag = 1  '标志为1
test_string = src_string
DoEvents
Do
 line_cnt = line_cnt + 1
 string_flag = InStr(test_string, vbCrLf)  '判断回车换行
 test_string = Right(test_string, Len(test_string) - string_flag - 1)
Loop Until string_flag <= 0
CountStringLine = line_cnt
End Function
 
'//////////□ 如何从一个字符串中读取一行字符？
Function ReadStringLine(src_str As String, lineno As Integer) As String
On Error Resume Next
Dim string_flag As Integer
Dim line_cnt As Integer
Dim test_string As String
Dim ret_string As String
line_cnt = 0  '初始--> 行数为1
string_flag = 1  '标志为1
test_string = Right(src_str, 2)
If test_string <> vbCrLf Then
 test_string = src_str + vbCrLf
Else
 test_string = src_str
End If
DoEvents
Do
 line_cnt = line_cnt + 1
 string_flag = InStr(test_string, vbCrLf)
 ret_string = Left(test_string, string_flag)
 test_string = Right(test_string, Len(test_string) - string_flag - 1)
Loop Until lineno <= line_cnt
'If line_cnt = 1 Then
'  ReadStringLine = ret_string
'Else
ReadStringLine = Left(ret_string, Len(ret_string) - 1)
'End If
End Function

Function FileExists(fname$) As Boolean
On Error Resume Next  '设置错误处理
    Dim X As Integer
 
    X = FreeFile      '取得一个空闲文件句柄
    Open fname$ For Input As X     '试图打开该文件
    If Err = 0 Then        '如果打开成功
        FileExists = True
    Else                   '否则
        FileExists = False
    End If
    Close X
End Function

'
' 如果参数s中的字符全是数字则返回0
' 否则将返回第一个非数字出现的位置
' 例如 IsStringAlpha("asdf12a") = 1
Function IsStringNumeric(s As String) As Long
   Dim i As Long
   Dim j As Byte
   
   For i = 1 To Len(s)
      j = Asc(Mid$(s, i, 1))
      If IsCharAlphaNumeric(j) = 1 Then
         If IsCharAlpha(j) = 1 Then
            IsStringNumeric = i
            Exit Function
         End If
      Else
         IsStringNumeric = i
         Exit Function
      End If
   Next i
   
   IsStringNumeric = 0
End Function

'从包含电价名称中分割出数字电价
Public Function PriceStr(ByVal sString As String, ByVal LocaStr As String)
   Dim n As Integer, m As Integer
   For n = 1 To Len(sString)
       m = InStrRev(sString, LocaStr, -1)
   Next n
   PriceStr = Right(sString, Len(sString) - m + 2)
End Function

'从包含电价名称中分割出字符电价
Public Function PriceName(ByVal sString As String, ByVal LocaStr As String)
   Dim n As Integer, m As Integer
   For n = 1 To Len(sString)
       m = InStrRev(sString, LocaStr, -1)
   Next n
   PriceName = Left(Left(sString, m - 2), convert_str((Left(sString, m - 2))))
End Function