手机版内容调用处理（图片大小，排版过虑）

原创

wgq_star 2012-06-21 15:39:51 博主文章分类：ASP ©著作权

©著作权归作者所有：来自51CTO博客作者wgq_star的原创作品，请联系作者获取转载授权，否则将追究法律责任

<%
Function ReplaceContent(ContentStr)
Dim ClsTempLoseStr,regEx
If Isnull(ContentStr) Or Trim(ContentStr)="" Then
ReplaceContent=""
Exit Function
End If
ContentStr = Replace(ContentStr, " ", "[br]")
ContentStr = Replace(ContentStr, " ", "[br]")
ContentStr = Replace(ContentStr, " ", "[br]")

ContentStr = Replace(ContentStr, " ", "[br]")
ContentStr = Replace(ContentStr, " ", "[br]")
ContentStr = Replace(ContentStr, " ", "[br]")

ContentStr = Replace(ContentStr, " ", "[br]")
ContentStr = Replace(ContentStr, " ", "[br]")
ContentStr = Replace(ContentStr, " ", "[br]")

ContentStr = Replace(ContentStr, "", "[p]")
ContentStr = Replace(ContentStr, "", "[/p]")

ContentStr = Replace(ContentStr, "", "[p]")
ContentStr = Replace(ContentStr, "", "[/p]")
ClsTempLoseStr = Cstr(ContentStr)

Set regEx = New RegExp
regEx.Pattern = "<[^>]+>"
regEx.IgnoreCase = True
regEx.Global = True
ClsTempLoseStr = regEx.Replace(ClsTempLoseStr,"")

ClsTempLoseStr = Replace(ClsTempLoseStr, "[br]", " ")
ClsTempLoseStr = Replace(ClsTempLoseStr, "[p]", "")
ClsTempLoseStr = Replace(ClsTempLoseStr, "[/p]", "")
ReplaceContent = ClsTempLoseStr
Set regEx = Nothing
End Function

Function RemoveP(strText)
Dim RegEx
Set RegEx=New RegExp
RegEx.IgnoreCase=True
RegEx.Global=True
RegEx.Pattern="]*>"
RemoveP=RegEx.Replace(strText,"[p]")
End Function

Function RemoveImg(strText)
Dim RegEx
Set RegEx=New RegExp
RegEx.IgnoreCase=True
RegEx.Global=True
'RegEx.Pattern="<img [^<]*src=""(.*)""[^>]*>"
'RemoveImg=RegEx.Replace(strText,"{img src=""$1"" border=0}")
RegEx.Pattern="<img (.*?)src=(.[^\[^>]*)(.*?)>"
RemoveImg=RegEx.Replace(strText,"{img src=$2}")
End Function

Function ImgRemove(strText)
Dim RegEx
Set RegEx=New RegExp
RegEx.IgnoreCase=True
RegEx.Global=True
'RegEx.Pattern="{img [^{]*src=""(.*)""[^}]*}"
'ImgRemove=RegEx.Replace(strText,"<img src='$1' border='0'>")
RegEx.Pattern="{img (.*?)src=(.[^\[^}]*)(.*?)}"
ImgRemove=RegEx.Replace(strText,"<img src=$2>")
End Function

'==========================
'Define Class imgInfo
'==========================
Class imgInfo
Dim aso
Private Sub Class_Initialize
set aso=CreateObject("Adodb.Stream")
aso.Mode=3
aso.Type=1
aso.Open
End Sub
Private Sub Class_Terminate
'err.clear
set aso=nothing
End Sub

Private Function Bin2Str(Bin)
Dim I, Str
For I=1 to LenB(Bin)
 clow=MidB(Bin,I,1)
 If ASCB(clow)<128 Then
 Str = Str & Chr(ASCB(clow))
 Else
 I=I+1
 If I <= LenB(Bin) Then
 Str = Str & Chr(ASCW(MidB(Bin,I,1)&clow))
 End If
 End If
Next
Bin2Str = Str
End Function

Private Function Num2Str(num,base,lens)
Dim ret
ret = ""
While(num>=base)
 ret = (num mod base) & ret
 num = (num - num mod base)/base
Wend
Num2Str = right(string(lens,"0") & num & ret,lens)
End Function

Private Function Str2Num(str,base)
Dim ret
ret = 0
For i=1 to len(str)
 ret = ret *base + cint(mid(str,i,1))
Next
Str2Num=ret
End Function

Private Function BinVal(bin)
Dim ret
ret = 0
For i = lenb(bin) to 1 step -1
 ret = ret *256 + ascb(midb(bin,i,1))
Next
BinVal=ret
End Function

Private Function BinVal2(bin)
Dim ret
ret = 0
For i = 1 to lenb(bin)
 ret = ret *256 + ascb(midb(bin,i,1))
Next
BinVal2=ret
End Function

Private Function getImageSize(filespec)
Dim ret(3)
aso.LoadFromFile(filespec)
bFlag=aso.read(3)
Select Case hex(binVal(bFlag))
Case "4E5089":
 aso.read(15)
 ret(0)="PNG"
 ret(1)=BinVal2(aso.read(2))
 aso.read(2)
 ret(2)=BinVal2(aso.read(2))
Case "464947":
 aso.read(3)
 ret(0)="GIF"
 ret(1)=BinVal(aso.read(2))
 ret(2)=BinVal(aso.read(2))
Case "535746":
 aso.read(5)
 binData=aso.Read(1)
 sConv=Num2Str(ascb(binData),2 ,8)
 nBits=Str2Num(left(sConv,5),2)
 sConv=mid(sConv,6)
 While(len(sConv)<nBits*4)
 binData=aso.Read(1)
 sConv=sConv&Num2Str(ascb(binData),2 ,8)
 Wend
 ret(0)="SWF"
 ret(1)=int(abs(Str2Num(mid(sConv,1*nBits+1,nBits),2)-Str2Num(mid(sConv,0*nBits+1,nBits),2))/20)
 ret(2)=int(abs(Str2Num(mid(sConv,3*nBits+1,nBits),2)-Str2Num(mid(sConv,2*nBits+1,nBits),2))/20)
Case "FFD8FF":
 do
 do: p1=binVal(aso.Read(1)): loop While p1=255 and not aso.EOS
 If p1>191 and p1<196 Then exit do Else aso.read(binval2(aso.Read(2))-2)
 do:p1=binVal(aso.Read(1)):loop While p1<255 and not aso.EOS
 loop While true
 aso.Read(3)
 ret(0)="JPG"
 ret(2)=binval2(aso.Read(2))
 ret(1)=binval2(aso.Read(2))
Case Else:
 If left(Bin2Str(bFlag),2)="BM" Then
 aso.Read(15)
 ret(0)="BMP"
 ret(1)=binval(aso.Read(4))
 ret(2)=binval(aso.Read(4))
 Else
 ret(0)=""
 End If
End Select
ret(3)="width=""" & ret(1) &""" height=""" & ret(2) &""""
getp_w_picpathsize=ret
End Function

Public Function imgW(pic_path)
Set fso1 = server.CreateObject("Scripting.FileSystemObject")
If (fso1.FileExists(pic_path)) Then
 Set f1 = fso1.GetFile(pic_path)
 ext=fso1.GetExtensionName(pic_path)
 Select Case ext
 Case "gif","bmp","jpg","png":
 arr=getImageSize(f1.path)
 imgW = arr(1)
 End Select
 Set f1=nothing
Else
 imgW = 0
End If
Set fso1=nothing
End Function

Public Function imgH(pic_path)
Set fso1 = server.CreateObject("Scripting.FileSystemObject")
If (fso1.FileExists(pic_path)) Then
 Set f1 = fso1.GetFile(pic_path)
 ext=fso1.GetExtensionName(pic_path)
 Select Case ext
 Case "gif","bmp","jpg","png":
 arr=getImageSize(f1.path)
 imgH = arr(2)
 End Select
 Set f1=nothing
Else
 imgH = 0
End If
Set fso1=nothing
End Function
End Class
'========================
'End of class
'========================

Function RegExp_Pic_Old(strng)
Dim regEx, Match, Matches '建立变量。
Set regEx = New RegExp '建立正则表达式。

regEx.Pattern = "<img (.*?)src=(.[^\[^>]*)(.*?)>" '设置模式。

regEx.IgnoreCase = true '设置是否区分字符大小写。
regEx.Global = True '设置全局可用性。
Set Matches = regEx.Execute(strng) '执行搜索。

For Each Match in Matches '遍历匹配集合。
If INSTR(Match.Value,"http://ehuanw.com")<>0 Or INSTR(Match.Value,"http://www.ehuanw.com")<>0 Or INSTR(Match.Value,"http://www1.ehuanw.com")<>0 Or INSTR(Match.Value,"http://www2.ehuanw.com")<>0 Or INSTR(Match.Value,"p_w_picpaths/Emotions/")<>0 Then
values=values&Match.Value&"$"
Else
values_out=values_out&Match.Value&"$"
End If
Next
RegExp_Pic_Old = values&"|"&values_out
End Function

Function RegExp_Src(strng)
Dim regEx, Match, Matches,values '建立变量。
Set regEx = New RegExp '建立正则表达式。

regEx.Pattern = "src\=.+?\.(jpg|gif|png|bmp|jpeg)" '设置模式。

regEx.IgnoreCase = true '设置是否区分字符大小写。
regEx.Global = True '设置全局可用性。
Set Matches = regEx.Execute(strng) '执行搜索。

For Each Match in Matches '遍历匹配集合。
src=replace(Match.Value,"src=""","")
src=replace(src,"src='","")
src=replace(src,"src=","")

If INSTR(src,"http://ehuanw.com")<>0 Or INSTR(src,"http://www.ehuanw.com")<>0 Or INSTR(src,"http://www1.ehuanw.com")<>0 Or INSTR(src,"http://www2.ehuanw.com")<>0 Or INSTR(src,"p_w_picpaths/Emotions/")<>0 Then
 src=replace(src,"http://ehuanw.com","")
 src=replace(src,"http://www.ehuanw.com","")
 src=replace(src,"http://www1.ehuanw.com","")
 src=replace(src,"http://www2.ehuanw.com","")

 values=values&src&"$"
Else
 values_out=values_out&src&"$"
End If
Next
RegExp_Src = values&"|"&values_out
End Function

Function RegExp_Pic_New(strng)
'object.imgw() 图片宽
'object.imgH() 图片高

imgpath=strng '定义为你的数据库路径
'response.Write imgpath
set pp=new imgInfo '建立新对象
imgwidth = pp.imgW("d:\wwwroot"&imgpath) '定义图片宽
imgheight = pp.imgH("d:\wwwroot"&imgpath) '定义图片高
set pp=nothing

If imgwidth>175 Then
imgheight=round(imgheight*(175/imgwidth))
imgwidth=175
End If

RegExp_Pic_New = "<A href=""&""" target=""_blank""><img src=""&""" width="""&imgwidth&""" height="""&imgheight&""" border=""0""></a>"
End Function

Function RegExp_Text(strng)
Text=replace(strng,"width>","width]")
Text=replace(Text,"height>","height]")
Text=ImgRemove(ReplaceContent(RemoveImg(RemoveP(Text))))

pic_olds=split(RegExp_Pic_Old(Text),"|")

If ubound(pic_olds)>=0 Then
pic_old=split(pic_olds(0),"$")
End If

If ubound(pic_olds)>=1 Then
pic_old_out=split(pic_olds(1),"$")
End If

srcs=split(RegExp_Src(Text),"|")

If ubound(srcs)>=0 Then
src=split(srcs(0),"$")
End If

If ubound(srcs)>=1 Then
src_out=split(srcs(1),"$")
End If

For num=0 to ubound(pic_old)-1
Text=Replace(Text, pic_old(num), RegExp_Pic_New(src(num)))
Next

For num_out=0 to ubound(pic_old_out)-1
Text=Replace(Text, pic_old_out(num_out), "<A href="""&src_out(num_out)&""" target=""_blank""><img src="""&src_out(num_out)&""" width=""175"" height=""131"" border=""0""></a>")
Next

RegExp_Text=Text
End Function