分享ASP实现的汇率转换，给的是一种思想而已

一把编程的菜刀 2009-06-01 08:49:09

加精

<!--#include file="checked.asp"--> 

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">

<html xmlns="http://www.w3.org/1999/xhtml">

<head>

<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />

<title>无标题文档</title>

<style>

div{

float:left;

width:600px;

border: 1px #009933 solid;

border-bottom:none;

border-right:none;

}

ul{

width:600px;

list-style:none;

height:20px;

margin:0px;

padding:0px;



}

li{

margin:0px;

padding:0px;

width:199px;

float:left;

text-align:center;

border-bottom:1px #009933 solid;

border-right:1px #009933 solid;

}

</style>

</head>



<body>

<form action="index.asp" method="post" target=_top>

<select id=from onmouseover=this.focus(); style="width:200px;background-color:#e9f8d7" size=1 name=from>

		<option value=CNY>人民币 Chinese Yuan Renminbi . CNY</option>

		<option value=HKD>港元 Hong Kong Dollar . HKD</option>

		<option value=TWD>台币 Taiwan Dollar . TWD</option>

		<option value=EUR>欧元 Euro . EUR</option>

		<option value=USD>美元 US Dollar . USD</option>

		<option value=GBP>英镑 British Pound . GBP</option>

		<option value=AUD>澳元 Australian Dollar . AUD</option>

		<option value=KRW>韩元 South-Korean Won . KRW</option>

		<option value=JPY>日元 Japanese Yen . JPY</option>

</select>

兑换

<select id=to onmouseover=this.focus(); style="width:200px;background-color:#e9f8d7" size=1 name=to>

		<option value=CNY>人民币 Chinese Yuan Renminbi . CNY</option>

		<option value=HKD>港元 Hong Kong Dollar . HKD</option>

		<option value=TWD>台币 Taiwan Dollar . TWD</option>

		<option value=EUR>欧元 Euro . EUR</option>

		<option value=USD>美元 US Dollar . USD</option>

		<option value=GBP>英镑 British Pound . GBP</option>

		<option value=AUD>澳元 Australian Dollar . AUD</option>

		<option value=KRW>韩元 South-Korean Won . KRW</option>

		<option value=JPY>日元 Japanese Yen . JPY</option>

</select>

数额：<input id=q name=q size=10 value="100" onkeypress="javascript:{if ((event.keyCode > 27 && event.keyCode < 45) || (event.keyCode > 46 && event.keyCode < 48) || (event.keyCode > 57 && event.keyCode < 127)) event.returnValue = false;}">

<input type=submit value="汇率转换">

</form>

<%

if request.Form("from")<>"" and request.Form("to")<>"" and request.Form("q")<>"" then

if isnumeric(request.Form("q")) then

url="http://qq.ip138.com/hl.asp"

from=request.Form("from")

tto=request.Form("to")

q=request.Form("q")

url=url&"?from=" & from & "&to="& tto & "&q="& q

str=GetHttpPage(url)

re="<td>(\d+|\d+\.\d+)</td><td>(\d+|\d+\.\d+)</td><td>(\d+|\d+\.\d+)</td>"

arr=split(replacetext(str,re,4),",")

response.write "<div><ul><li>"&changstr(from)&"</li><li>当前汇率</li><li>"& changstr(tto)&"</li></ul><ul><li>"&arr(0)&"</li><li>"&arr(1)&"</li><li>"&arr(2)&"</li></ul></div>"

response.write "<br><br><br>"

response.write q&from&"的<font color=red>"&changstr(from)&"</font>兑换<font color=red>"&changstr(tto)&"</font>为："&replacetext(str,re,3)&tto

end if

end if

str = "<table  border='1' cellspacing='0' cellpadding='0'> <tr> <td>1</td> <td>2</td><td>3 </td> </tr> <tr> <td>4</td> <td>5</td> <td>6</td> </tr> <tr> <td>7</td> <td>8</td> <td>9</td> </tr> <tr> <td>10</td> <td>11</td> <td>12</td></tr> <tr> <td>13</td> <td>14</td> <td>15</td> </tr> </table>" 

Set objRegExp = New Regexp 

objRegExp.IgnoreCase = True 

objRegExp.Global = True

objRegExp.Pattern ="<td>(\d+)</td>"

Set Matches =objRegExp.Execute(str) 

For Each Match in Matches

TempStr=TempStr&Match&","

Next 

response.write TempStr



%>

</body>

</html>

checked.asp:

<%'==================================================

'函数名：GetHttpPage

'作 用：获取网页源码

'参 数：HttpUrl ------网页地址

'==================================================

Function GetHttpPage(HttpUrl)

If IsNull(HttpUrl)=True or Len(HttpUrl)<18 or HttpUrl=""  Then

GetHttpPage="请求地址出错"

Exit Function

End If

Dim Http

Set Http=server.createobject("MSXML2.XMLHTTP")

Http.open "post",HttpUrl,False

Http.Send()

If Http.Readystate<>4 then

Set Http=Nothing 

GetHttpPage="请求地址出错"

Exit function

End if

GetHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")

Set Http=Nothing

If Err.number<>0 then

Err.Clear

End If

End Function



'==================================================

'函数名：BytesToBstr

'作 用：将获取的源码转换为中文

'参 数：Body ------要转换的变量

'参 数：Cset ------要转换的类型

'==================================================

Function BytesToBstr(Body,Cset)

Dim Objstream

Set Objstream = Server.CreateObject("adodb.stream")

objstream.Type = 1

objstream.Mode =3

objstream.Open

objstream.Write body

objstream.Position = 0

objstream.Type = 2

objstream.Charset = Cset

BytesToBstr = objstream.ReadText 

objstream.Close

set objstream = nothing

End Function

function replacetext(Svalue,re,n)

Set objRegExp = New Regexp 

objRegExp.IgnoreCase = True 

objRegExp.Global = True

objRegExp.Pattern =re

Set Matches =objRegExp.Execute(Svalue) 

Set objRegExp=nothing

For Each Match in Matches

if n=1 then

TempStr=Match.SubMatches(0)

elseif n=2 then

TempStr=Match.SubMatches(1)

elseif n=3 then

TempStr=Match.SubMatches(2)

elseif n=4 then

TempStr=Match.SubMatches(0)&","& Match.SubMatches(1)&","& Match.SubMatches(2)

end if

if TempStr<>"" then exit for

Next 

replacetext=TempStr

end function

function changstr(str)

if str="HKD" then

changstr="港元("&str&")"

elseif str="CNY" then

changstr="人民币("&str&")"

elseif str="TWD" then

changstr="台币("&str&")"

elseif str="EUR" then

changstr="欧元("&str&")"

elseif str="USD" then

changstr="美元("&str&")"

elseif str="GBP" then

changstr="英镑("&str&")"

elseif str="AUD" then

changstr="澳元("&str&")"

elseif str="KRW" then

changstr="韩元("&str&")"

elseif str="JPY" then

changstr="日元("&str&")"

end if

end function

%>