上一篇
下一篇
一组字符串转换函数
作者:JiaJia 日期:2008-04-23
Public Function chrConvert(strInput As String, Method As Integer) As String
' Method = 0 for Text to vbChr
' Method = 1 for Text to HTML
' Method = 2 for Text to Hex
' Method = 3 for vbChr to Text
' Method = 4 for HTML to Text
' Method = 5 for Hex to Text
If Method = 0 Or Method = 1 Or Method = 2 Then
chrConvert = ToChr(strInput, Method)
ElseIf Method = 3 Or Method = 4 Or Method = 5 Then
chrConvert = ToTxt(strInput, Method)
End If
End Function
Private Function ToChr(strInput As String, Method As Integer) As String
strTmp = ""
For L = 1 To Len(strInput)
A = Asc(Mid(strInput, L, 1))
If Method = 0 Then
strTmp = strTmp & " & Chr(" & A & ")"
ElseIf Method = 1 Then
strTmp = strTmp & "&#" & A & ";"
ElseIf Method = 2 Then
strTmp = strTmp & "%" & Hex(A)
End If
Next L
If Method = 0 Then strTmp = Right(strTmp, Len(strTmp) - 3)
ToChr = strTmp
End Function
Private Function ToTxt(strInput As String, Method As Integer) As String
strTmp = ""
Dim inChr() As String
Dim F As Integer, ForChr As Integer, tmpInput As String
If Method = 3 Then
strInput = Replace(strInput, ")", "")
strInput = Replace(strInput, " & ", "")
strInput = Replace(strInput, "Chr(", "")
ElseIf Method = 4 Then
strInput = Replace(strInput, "&#", "")
strInput = Replace(strInput, ";", "")
ElseIf Method = 5 Then
strInput = Replace(strInput, "%", "")
End If
inChr = Split(strInput, "")
For F = 1 To ChrNum(strInput)
inChr(F) = AddZeros(3 - Len(inChr(F))) & inChr(F)
tmpInput = tmpInput & inChr(F)
Next F
For L = 1 To Len(tmpInput)
A = Mid(tmpInput, L, 3)
If Method = 5 Then A = Val("&H" & A)
strTmp = strTmp & Chr(A)
L = L + 2
Next L
ToTxt = strTmp
End Function
Private Function ChrNum(strInput As String) As Integer
Dim lngLen As Long, lngFound As Long, lngEnd As Long
ChrNum = 0
lngLen& = Len(strInput$)
lngFound& = InStr(strInput$, "")
Do While lngFound& <> 0
ChrNum = ChrNum + 1
lngFound& = InStr(lngFound& + 1, strInput$, "")
Loop
End Function
Private Function AddZeros(Number As Integer) As String
Dim Z As Integer, tmpZeros As String
For Z = 1 To Number
tmpZeros = tmpZeros & "0"
Next Z
AddZeros = tmpZeros
End Function
' Method = 0 for Text to vbChr
' Method = 1 for Text to HTML
' Method = 2 for Text to Hex
' Method = 3 for vbChr to Text
' Method = 4 for HTML to Text
' Method = 5 for Hex to Text
If Method = 0 Or Method = 1 Or Method = 2 Then
chrConvert = ToChr(strInput, Method)
ElseIf Method = 3 Or Method = 4 Or Method = 5 Then
chrConvert = ToTxt(strInput, Method)
End If
End Function
Private Function ToChr(strInput As String, Method As Integer) As String
strTmp = ""
For L = 1 To Len(strInput)
A = Asc(Mid(strInput, L, 1))
If Method = 0 Then
strTmp = strTmp & " & Chr(" & A & ")"
ElseIf Method = 1 Then
strTmp = strTmp & "&#" & A & ";"
ElseIf Method = 2 Then
strTmp = strTmp & "%" & Hex(A)
End If
Next L
If Method = 0 Then strTmp = Right(strTmp, Len(strTmp) - 3)
ToChr = strTmp
End Function
Private Function ToTxt(strInput As String, Method As Integer) As String
strTmp = ""
Dim inChr() As String
Dim F As Integer, ForChr As Integer, tmpInput As String
If Method = 3 Then
strInput = Replace(strInput, ")", "")
strInput = Replace(strInput, " & ", "")
strInput = Replace(strInput, "Chr(", "")
ElseIf Method = 4 Then
strInput = Replace(strInput, "&#", "")
strInput = Replace(strInput, ";", "")
ElseIf Method = 5 Then
strInput = Replace(strInput, "%", "")
End If
inChr = Split(strInput, "")
For F = 1 To ChrNum(strInput)
inChr(F) = AddZeros(3 - Len(inChr(F))) & inChr(F)
tmpInput = tmpInput & inChr(F)
Next F
For L = 1 To Len(tmpInput)
A = Mid(tmpInput, L, 3)
If Method = 5 Then A = Val("&H" & A)
strTmp = strTmp & Chr(A)
L = L + 2
Next L
ToTxt = strTmp
End Function
Private Function ChrNum(strInput As String) As Integer
Dim lngLen As Long, lngFound As Long, lngEnd As Long
ChrNum = 0
lngLen& = Len(strInput$)
lngFound& = InStr(strInput$, "")
Do While lngFound& <> 0
ChrNum = ChrNum + 1
lngFound& = InStr(lngFound& + 1, strInput$, "")
Loop
End Function
Private Function AddZeros(Number As Integer) As String
Dim Z As Integer, tmpZeros As String
For Z = 1 To Number
tmpZeros = tmpZeros & "0"
Next Z
AddZeros = tmpZeros
End Function
文章来自: 
引用通告: 
Tags: 评论: 0 | 引用: 0 | 查看次数: -
发表评论