Attribute VB_Name = "Function"
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/09/27
'描 述：电表业645规约的电表485通讯代码
'网 站：http://www.Mndsoft.com/ (VB6源码博客)
'网 站：http://www.VbDnet.com/ (VB.NET源码博客,主要基于.NET2005)
'e-mail ：Mndsoft@163.com
'e-mail ：Mndsoft@126.com
'OICQ ：88382850
' 如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Public Function IsNumber(ByVal Msg As String) As Boolean
IsNumber = ((Len(Msg) > 0) And (InStr("0123456789", Left(Msg, 1)) > 0))
End Function
Public Sub Delay(msValue As Long, Optional AdvanceExit, Optional ByVal WaitFalse As Boolean)
'延时,满足条件(AdvanceExit=Not WaitFalse)时提前退出
Dim EndTime As Long
On Error Resume Next
EndTime = GetTickCount + msValue
Do
DoEvents
If Not IsMissing(AdvanceExit) Then If AdvanceExit = Not WaitFalse Then Exit Sub
Loop Until (GetTickCount >= EndTime)
End Sub
Public Function AddZero(Num As Integer) As String
'在前边加 Num 个 0
AddZero = ""
Dim I As Variant
For I = 1 To Num
AddZero = "0" & AddZero
Next I
End Function
Public Function GetItemNo(ByVal Msg As String, Split As String, Item As String) As Long
'取指定项的序号(0..N),找不到返回-1
Dim SplitLen As Long
Dim S As Long
Dim N As Long
Dim Count As Long
GetItemNo = -1
SplitLen = Len(Split)
If SplitLen > 0 Then '有效的分隔符
S = 1
Do
N = InStr(S, Msg, Split)
If N = 0 Then
If Mid(Msg, S) = Item Then GetItemNo = Count
Else
If Mid(Msg, S, N - S) = Item Then GetItemNo = Count
S = N + SplitLen
Count = Count + 1
End If
Loop Until (N = 0)
End If
End Function
Public Function GetItem(ByVal Msg As String, ByVal Split As String, ByVal Index As Long, Optional ByVal ByValue As Boolean) As Variant
'取指定项,EX: GetItem("1A,5A,10A,20A",",",2) = "10A"
'Index = -1 , Get Items Count
Dim SplitLen As Long
Dim S As Long
Dim N As Long
Dim Count As Long
Dim Item As String
SplitLen = Len(Split)
If Len(Msg) * SplitLen > 0 Then '有效的字符串和分隔符
S = 1
If Index < 0 Then '取项数
Do
N = InStr(S, Msg, Split)
Count = Count + 1
If N > 0 Then S = N + SplitLen
Loop Until (N = 0)
GetItem = Count
Else '取指定项
Do
N = InStr(S, Msg, Split)
If Count = Index Then
Item = Mid(Msg, S, IIf(N = 0, Len(Msg), N - S))
Exit Do
Else
Count = Count + 1
If N > 0 Then S = N + SplitLen
End If
Loop Until (N = 0)
'GetItem = IIf(ByValue, Val(Item), Item)
If ByValue Then
GetItem = Val(Item)
Else
GetItem = Item
End If
End If
End If
End Function
Public Function GetItemNo_SpecialString(ByVal Index As Long, ByVal Msg As String) As Variant
'取特殊字符在字符串中出现的位置
If Index GetItemNo_SpecialString = 0
Exit Function
End If
Dim I, J, K As Variant
Dim TempS As String
J = 1
For I = 1 To Len(Msg)
TempS = Mid(Msg, I, 1)
If IsNumOrStr(TempS) = False Then
If Index = J Then
GetItemNo_SpecialString = I
Exit Function
Else
J = J + 1
End If
End If
Next I
End Function
Public Function IsNumOrStr(ByVal Msg As String) As Boolean
' 用于对特殊字符处理判断
Select Case UCase(Msg)
Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z"
IsNumOrStr = True
Case Else
IsNumOrStr = False
End Select
End Function
Public Function StringFormat(DataMsg As String, StrFormat As String) As String
'字符串格式化处理
'DataMsg : 待格式化的字符串 如 99.9
'StrFormat : 数据格式 如 NNNNNN.NN
'转换后成为 000099.90
Dim I, J, K As Variant
Dim MStr As Variant
Dim TempS, StrTmp As String
Dim SpecialStr As String
Dim P, Q As Variant
Dim S As String
If Len(DataMsg) = Len(StrFormat) Then ' 长度相同直接处理
StringFormat = DataMsg
Exit Function
End If
StrTmp = ""
J = 0
For I = 1 To Len(DataMsg)
TempS = Mid(DataMsg, I, 1)
If IsNumber(TempS) = False Then J = J + 1 ' 有 J 个特殊字符
Next I
Select Case J
Case 0 ' NNNNNN ( 99 -> 000099 )
StrTmp = AddZero(Len(StrFormat) - Len(DataMsg)) & DataMsg
Case 1 ' NNNNNN.NN 零补后 ( 99.99 -> 000099.9900 )
For K = 1 To J
StrTmp = StrTmp & AddZero((GetItemNo_SpecialString(K, StrFormat) - GetItemNo_SpecialString(K - 1, StrFormat)) - (GetItemNo_SpecialString(K, DataMsg) - GetItemNo_SpecialString(K - 1, DataMsg))) & Mid(DataMsg, GetItemNo_SpecialString(K - 1, DataMsg) + 1, GetItemNo_SpecialString(K, DataMsg) - GetItemNo_SpecialString(K - 1, DataMsg))
Next K
StrTmp = StrTmp & Mid(DataMsg, GetItemNo_SpecialString(J, DataMsg) + 1, Len(DataMsg) - GetItemNo_SpecialString(K, DataMsg))
StrTmp = StrTmp & AddZero(Len(StrFormat) - Len(StrTmp))
Case Else ' HH:MM:SS 零补前 ( 2:3:2 -> 02:03:02 )
For K = 1 To J
StrTmp = StrTmp & AddZero((GetItemNo_SpecialString(K, StrFormat) - GetItemNo_SpecialString(K - 1, StrFormat)) - (GetItemNo_SpecialString(K, DataMsg) - GetItemNo_SpecialString(K - 1, DataMsg))) & Mid(DataMsg, GetItemNo_SpecialString(K - 1, DataMsg) + 1, GetItemNo_SpecialString(K, DataMsg) - GetItemNo_SpecialString(K - 1, DataMsg))
Next K
StrTmp = StrTmp & AddZero(Len(StrFormat) - Len(StrTmp) - (Len(DataMsg) - GetItemNo_SpecialString(J, DataMsg)))
StrTmp = StrTmp & Mid(DataMsg, GetItemNo_SpecialString(J, DataMsg) + 1, Len(DataMsg) - GetItemNo_SpecialString(K, DataMsg))
End Select
'输出格式化后的数据
StringFormat = StrTmp
End Function
