--2007-6-18 12:47:36
Utf8转换Gb2312的函数
代码功能是实现http转换为GB2312的比如把下面这个转换成GB2312
Function Utf8_Gb2312(Searchstring)
Dim Seachchar1, Seachchar2, MyPos1, MyPos2, string1, string2, i, Output_content
Seachchar1 = "&#x"
Seachchar2 = ";"
While InStr(Searchstring, "&#x") <> 0
i = i + 1 '定义i
MyPos1 = InStr(Searchstring, Seachchar1) + Len(Seachchar1)
string1 = Left(Searchstring, MyPos1 - 1)
Searchstring = Replace(Searchstring, string1, "", 1, 1)
MyPos2 = InStr(Searchstring, Seachchar2) - Len(Seachchar2)
string2 = Left(Searchstring, MyPos2 + Len(Seachchar2) - 1)
Searchstring = Replace(Searchstring, string2, "", 1, 1)
Output_content = Output_content + ChrW(CInt("&H" & string2))
Wend
Utf8_Gb2312 = Output_content
End Function
引用内容上面的代码可以实现把这样的代码<a href="http://" target="_blank">空乘</a>转换成GB2312转换成功,但把<a href=" /a>等也弄掉了.我的意思是要保留HTML标记的,我修改成如下函数,使得不弄掉这几个HTML标识,可是有些问题,请高手帮帮忙看看哪里有问题,或者怎么修改,谢谢
改进成这样,还不行,不知道那里有问题:
Function Utf8_Gb2312(Searchstring)
Dim Seachchar1, Seachchar2, MyPos1, MyPos2, string1, string2, Output_content, Output_Gb2312
Seachchar1 = "&#x"
Seachchar2 = ";"
While InStr(Searchstring, Seachchar1) <> 0
MyPos1 = InStr(Searchstring, Seachchar1)
MyPos2 = InStr(Searchstring, Seachchar1) - InStr(Searchstring, Seachchar2)
Output_content = Mid(Searchstring,MyPos1,abs(MyPos2))
Output_content = Replace(Output_content, Seachchar2, "")
Output_Gb2312 = ChrW(CInt("&H" & Output_content))
Searchstring = Replace(Searchstring, Seachchar1, "", 1, 1)
Searchstring = Replace(Searchstring, Output_content, Output_Gb2312)
Wend
Utf8_Gb2312 = Searchstring
End Function
既然知道转换的方法，重写一下行了啊
一：取出&#x与之间的内容；
二：在取出的内容左边加上&H；
三：用CInt函数将其转换成整数变量型态；
四：再用ChrW转换下就行了
Function Utf8_Gb2312(Content)
Dim sS1,iS1,sS2,iS2,sS
sS1 = "&#x"
sS2 = ";"
Do While InStr(Content,"&#x")<>0
iS1 = InStr(Content,sS1) + Len(sS1)
iS2 = InStr(iS1+1,Content,sS2)
sS = Mid(Content,iS1,iS2-iS1)
Content = Replace(Content,sS1 & sS & sS2,ChrW(CInt("&H" & sS)))
Loop
Utf8_Gb2312 = Content
End Function
相关内容
下列内容与有着内在的联系，建议您一并阅读。