asp生成帶參數的二維碼並合成推廣海報圖片，asp合並合成推廣海報圖片asp代碼

最近做的一個項目中，客戶要求用asp生成二維碼，然后合並到一張背景圖片上，合並生成一張推廣海報來，可把我愁壞了，經過一個晚上的努力，成功了，下面把這個：asp生成帶參數的二維碼並合成推廣海報，asp合並合成推廣海報asp代碼，發下面來，給有需要的朋友用：

<div class="content content_bottom">
	<div class="btitle">
		<div class="box1 iconfont"><a href="javascript:history.go(-1);"></a></div>
		<div class="box2"><%=haibao_title%></div>
	</div>
<!--#include file="qrcode.asp"-->
<%
'=====圖片名字生成
Function getRnd()
	Dim rndnum,filename
	Randomize Timer 
	rndnum = Int(899999 * Rnd + 100000)
	filename = year(now())&month(now())&day(now())&rndnum
	getRnd = filename
End Function

'b64=base64數據  tname=bmp/gif imgname="img/1.gif"
function base64toimage(b64,tname,imgname)
	if b64="" then base64toimage="" : exit function
	if imgname="" then base64toimage="" : exit function
	if tname="" then tname="gif"
	b64=replace(b64,"data:image/"&tname&";base64,","")
	b64=replace(b64," ","+")	
	Dim xml : Set xml=Server.CreateObject("MSXML2.DOMDocument") 
	Dim stm : Set stm=Server.CreateObject("ADODB.Stream") 
	xml.resolveExternals=False
	xml.loadXML("<?xml version=""1.0"" encoding=""gb2312""?><data><![CDATA["&b64&"]]></data>") 
	xml.documentElement.setAttribute "xmlns:dt","urn:schemas-microsoft-com:datatypes" 
	xml.documentElement.dataType = "bin.base64" 
	stm.Type=1
	stm.Open 
	stm.Write xml.documentElement.nodeTypedValue 
	stm.SaveToFile Server.MapPath(imgname),2
	stm.Close 
	Set xml=Nothing 
	Set stm=Nothing
	base64toimage=imgname
end function

'outqr(版本,糾錯級別,圖片格式,待生成的數據,放大倍數,邊距,保存本地圖片路徑及名稱格式)
'版本0-10  : 簡易版本，編碼字符不宜過多;版本越高，容納的字符數越多
'糾錯級別|[LMQH])
'圖片格式: gif / bmp  : bmp的圖片大一些
'待生成的數據  如：世界！你好
'放大倍數 純數字 如：5 ： 數字越大生成的二維碼越大 不建議過大影響速度
'邊距 純數字 如：10
'保存本地圖片路徑及名稱格式  如：qr/100.gif   ：  如果為空將不保存本地圖片，返回base64圖片  重名將覆蓋
function outqr(a,b,c,d,e,f,g)
		dim qr,b64img
		set qr = ASPQrcode(a,b)
		qr.useBestMaskPattern = false '如果為false，生成速度會快很多，二維碼復雜點；
		qr.output =c
		b64img=qr.getBase64(d,e,f)
		set qr=nothing
		if g<>"" then  : outqr=base64toimage(b64img,c,g) : else : outqr="data:image/"&c&";base64,"&b64img : end if
end function

dim imgname,picname
picname = getRnd
ewmpic = "UploadFile/ewm/"&picname&".jpg"
website = ""&anco_site_http&"/share.asp?hyid="&newhyid&""
'看看二維碼是不是入庫了
if hy_wxewm<>"" then
else
Conn.ExeCute("update [member] set ewm='"&ewmpic&"' where id="&newhyid&"")
imgname=outqr(0,"M","jpg",""&website&"",13,5,"UploadFile/ewm/"&picname&".jpg")
end if
'end會員表
%>
<div class="main_95 pt10">
	<center><span class="mod"><a href="member_hb.asp">下載<%=haibao_title%></a></span></center>
	<div class="conte_text pt10">
	<%=haibao_gsl%>
	</div>
</div>