ndfweb.cn

用ASP生成BMP图片


2009-08-09 09:27:33 (5980)


BMP图片规则：BMP文件有54个字节的文件头，其中包括了BMP文件标志“BM”，文件大小，位图文件起始位置，长，宽，位图位数1/4/8/24（1,8个像素占1个字节;4，2个像素占1个字节;8，1个像素占1个字节;24,1个像素占3个字节;）等信息。不过最简单的方法是先用画图板做一个相同大小的空图片，把头信息记录下来。
BMP文件实际显示部分，是从左下角开始，到右上角结束，详细记录了文件的每个像素，如果用24位位图表示的话，用3个字节表示RGB。红色表示就是 ff 00 ff，黑色就是00 00 00，白色是ff ff ff...
如果我们要表示一个数字或字母，我们可以用一个10X10的距阵来表示，比如1用下面的距阵表示：
1111011111
1100011111
1111011111
1111011111
1111011111
1111011111
1111011111
1111011111
1111011111
1100000111
当然也可以用一个更大的距阵来表示一个更丰富的样式。
明白了原理，接下来就好用程序实现了，我们用Response.BinaryWrite方法写入文件头，再用程序写入文件体。
下面是一个用程序生成浏览者IP地址的程序：
<%
Response.Expires = -9999
Response.AddHeader "cache-control","no-cache"
Response.ContentType = "Image/BMP"
Const cCode = "0123456789. " '数据值

Dim vColor(2)
vColor(0) = ChrB(0) & ChrB(0) & ChrB(0) '黑
vColor(1) = ChrB(255) & ChrB(255) & ChrB(255) '白

ip=request.ServerVariables("http_x_forwarded_for") '得到IP值
if ip="" then
ip=request.ServerVariables("remote_addr")
end if

ls=split(ip,".",-1,1) '劈开IP
for j=0 to 3 '处理分组
if len(ls(j))<3 then '如果长度少于3
spac=""
for k=1 to 3-len(ls(j)) '加3-len个空格
spac=spac+" "
next
ls(j)=spac+ls(j) '转换长度足够的ls(j)
end if
next

str="" '二次处理IP串,over
for k=0 to 3
str=str+ls(k)+"."
next
str=left(str,15)

dim vCode(15) '三次处理成数组
For x = 0 To 14
vCode(x) = mid(str,x+1,1) '等于什么值?
vCode(x)=instr(1,cCode,vCode(x),1)-1 '值在串中是第几?
'response.write vCode(x)&"<br>"
Next

Dim vNumber(12)
vNumber(0) = "1110000111110111101111011110111101001011110100101111010010111101001011110111101111011110111110000111"
vNumber(1) = "1111011111110001111111110111111111011111111101111111110111111111011111111101111111110111111100000111"
vNumber(2) = "1110000111110111101111011110111111111011111111011111111011111111011111111011111111011110111100000011"
vNumber(3) = "1110000111110111101111011110111111110111111100111111111101111111111011110111101111011110111110000111"
vNumber(4) = "1111101111111110111111110011111110101111110110111111011011111100000011111110111111111011111111000011"
vNumber(5) = "1100000011110111111111011111111101000111110011101111111110111111111011110111101111011110111110000111"
vNumber(6) = "1111000111111011101111011111111101111111110100011111001110111101111011110111101111011110111110000111"
vNumber(7) = "1100000011110111011111011101111111101111111110111111110111111111011111111101111111110111111111011111"
vNumber(8) = "1110000111110111101111011110111101111011111000011111101101111101111011110111101111011110111110000111"
vNumber(9) = "1110001111110111011111011110111101111011110111001111100010111111111011111111101111011101111110001111"
vNumber(10) ="1111111111111111111111111111111111111111111111111111111111111111111111111111111111110011111111001111"
vNumber(11) ="1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111"

Response.BinaryWrite chrB(66)&chrB(77)&chrB(222)&chrB(17)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(54)&_
chrB(0)&chrB(0)&chrB(0)&chrB(40)&chrB(0)&chrB(0)&chrB(0)&chrB(150)&chrB(0)&chrB(0)&chrB(0)&chrB(10)&chrB(0)&chrB(0)&_
chrB(0)&chrB(1)&chrB(0)&chrB(24)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(168)&chrB(17)

Response.BinaryWrite chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&_
chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(0)
dim x,y,z
For x = 9 To 0 step -1 '逐行
For y = 0 To 14 '逐字
For z = 1 To 10 '逐像素的R/G/B，因为vColor()已经定义每个RGB值了，如果是8位位图，使用一个字节即可
Response.BinaryWrite vColor(Mid(vNumber(vCode(y)), x * 10 + z , 1)) '写入流
Next
Next
Response.BinaryWrite vColor(1) '为每一行的增加一个行尾标志
Next
%>

当然，这个程序生成的流和位图定义有点不太符合，图片有点斜，大家慢慢研究吧...
下面是我修改的网上的生成彩色随机验证码的程序, 附件一直提示file1格式不对, 只好粘在下面
<%
Response.ContentType = "Image/BMP"
Call Com_CreatValidCode()
Sub Com_CreatValidCode()
Randomize
Dim i, ii, iii
Const cAmount = 36 '数值个数
Const cCode = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" '数值范围

Dim vColorData(2)
vColorData(0) = "" '黑色点要转为彩色点,暂时不定义
vColorData(1) = ChrB(255) & ChrB(255) & ChrB(255) '白点

Dim vCode(4), vCodes '产生一组任意数
For i = 0 To 3
vCode(i) = Int(Rnd * cAmount) '数组等于总数*随机数
vCodes=vCodes&Mid(cCode,vCode(i)+1,1) '串等于串加上后续值
Next
session("checkcode")=vCodes '记录产生的串值

Dim vNumberData(36)
vNumberData(0) = "1110000111110111101111011110111101001011110100101111010010111101001011110111101111011110111110000111"
vNumberData(1) = "1111011111110001111111110111111111011111111101111111110111111111011111111101111111110111111100000111"
vNumberData(2) = "1110000111110111101111011110111111111011111111011111111011111111011111111011111111011110111100000011"
vNumberData(3) = "1110000111110111101111011110111111110111111100111111111101111111111011110111101111011110111110000111"
vNumberData(4) = "1111101111111110111111110011111110101111110110111111011011111100000011111110111111111011111111000011"
vNumberData(5) = "1100000011110111111111011111111101000111110011101111111110111111111011110111101111011110111110000111"
vNumberData(6) = "1111000111111011101111011111111101111111110100011111001110111101111011110111101111011110111110000111"
vNumberData(7) = "1100000011110111011111011101111111101111111110111111110111111111011111111101111111110111111111011111"
vNumberData(8) = "1110000111110111101111011110111101111011111000011111101101111101111011110111101111011110111110000111"
vNumberData(9) = "1110001111110111011111011110111101111011110111001111100010111111111011111111101111011101111110001111"
vNumberData(10) = "1111011111111101111111101011111110101111111010111111101011111100000111110111011111011101111000100011"
vNumberData(11) = "1000000111110111101111011110111101110111110000111111011101111101111011110111101111011110111000000111"
vNumberData(12) = "1110000011110111101110111110111011111111101111111110111111111011111111101111101111011101111110001111"
vNumberData(13) = "1000001111110111011111011110111101111011110111101111011110111101111011110111101111011101111000001111"
vNumberData(14) = "1000000111110111101111011011111101101111110000111111011011111101101111110111111111011110111000000111"
vNumberData(15) = "1000000111110111101111011011111101101111110000111111011011111101101111110111111111011111111000111111"
vNumberData(16) = "1110000111110111011110111101111011111111101111111110111111111011100011101111011111011101111110001111"
vNumberData(17) = "1000100011110111011111011101111101110111110000011111011101111101110111110111011111011101111000100011"
vNumberData(18) = "1100000111111101111111110111111111011111111101111111110111111111011111111101111111110111111100000111"
vNumberData(19) = "1110000011111110111111111011111111101111111110111111111011111111101111111110111110111011111000011111"
vNumberData(20) = "1000100011110111011111011011111101011111110001111111010111111101101111110110111111011101111000100011"
vNumberData(21) = "1000111111110111111111011111111101111111110111111111011111111101111111110111111111011110111000000011"
vNumberData(22) = "1000100011110010011111001001111100100111110101011111010101111101010111110101011111010101111001010011"
vNumberData(23) = "1000100011110011011111001101111101010111110101011111010101111101100111110110011111011001111000110111"
vNumberData(24) = "1110001111110111011110111110111011111011101111101110111110111011111011101111101111011101111110001111"
vNumberData(25) = "1000000111110111101111011110111101111011110000011111011111111101111111110111111111011111111000111111"
vNumberData(26) = "1110001111110111011110111110111011111011101111101110111110111011111011101001101111011001111110001011"
vNumberData(27) = "1000001111110111011111011101111101110111110000111111010111111101101111110110111111011101111000110011"
vNumberData(28) = "1110000011110111101111011110111101111111111001111111111001111111111011110111101111011110111100000111"
vNumberData(29) = "1000000011101101101111110111111111011111111101111111110111111111011111111101111111110111111110001111"
vNumberData(30) = "1000100011110111011111011101111101110111110111011111011101111101110111110111011111011101111110001111"
vNumberData(31) = "1000100011110111011111011101111101110111111010111111101011111110101111111010111111110111111111011111"
vNumberData(32) = "1001010011110101011111010101111101010111110101011111001001111110101111111010111111101011111110101111"
vNumberData(33) = "1000100011110111011111101011111110101111111101111111110111111110101111111010111111011101111000100011"
vNumberData(34) = "1000100011110111011111011101111110101111111010111111110111111111011111111101111111110111111110001111"
vNumberData(35) = "1100000011110111011111111101111111101111111110111111110111111111011111111011111111101110111100000011"

Response.BinaryWrite ChrB(66) & ChrB(77) & ChrB(230) & ChrB(4) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) &_
ChrB(0) & ChrB(0) & ChrB(54) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(40) & ChrB(0) &_
ChrB(0) & ChrB(0) & ChrB(40) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(10) & ChrB(0) &_
ChrB(0) & ChrB(0) & ChrB(1) & ChrB(0)

Response.BinaryWrite ChrB(24) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(176) & ChrB(4) &_
ChrB(0) & ChrB(0) & ChrB(18) & ChrB(11) & ChrB(0) & ChrB(0) & ChrB(18) & ChrB(11) &_
ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) &_
ChrB(0) & ChrB(0)
For i = 9 To 0 Step -1 '行
For ii = 0 To 3 '字数
For iii = 1 To 10 '像素点
if Mid(vNumberData(vCode(ii)), i * 10 + iii , 1) ="0" then '产生彩色点,减去一个固定值,可使颜色偏深
dim a,b,c
a=abs(Rnd * 256-60)
b=abs(Rnd * 256-128)
c=abs(Rnd * 256-60)
vColorData(0) = ChrB(a) & ChrB(b) & ChrB(c)
Response.BinaryWrite vColorData(Mid(vNumberData(vCode(ii)), i * 10 + iii , 1))
else
dim d,e,f '产生彩色背景，颜色偏浅，也可以随机生成噪点做背景
d=abs(Rnd * 255)
e=abs(Rnd * 255)
f=abs(Rnd * 255)
if d+e+f>580 then
vColorData(1) = ChrB(d) & ChrB(e) & ChrB(f)
Response.BinaryWrite vColorData(Mid(vNumberData(vCode(ii)), i * 10 + iii , 1))
else
Response.BinaryWrite vColorData(Mid(vNumberData(vCode(ii)), i * 10 + iii , 1))
end if
end if
Next
Next
Next
End Sub
%>


------------------------------------------------------------------------------

另做的一个小IP图片
--------------------------------------------------------------------------------
黑白8位位图图片,非常正规,图片非常小:262个字节
注:8位黑白位图,指8个像素占一个字节,第一个点是黑色,另七个点是白色的话,字节值是80;第二点是黑色,其它点是白色,字节值是40,以此类推...多个点是黑色加在一起,8个像素全是黑色,字节值是FF...
<%
Response.Expires = -9999
Response.AddHeader "cache-control","no-cache"
Response.ContentType = "Image/BMP"
Const cCode = "0123456789. " '数据值

Dim vColor(2)
vColor(0) = ChrB(0) '黑
vColor(1) = ChrB(80) '白

ip=request.ServerVariables("http_x_forwarded_for") '得到IP值
if ip="" then
ip=request.ServerVariables("remote_addr")
end if

ls=split(ip,".",-1,1) '劈开IP
for j=0 to 3 '处理分组
if len(ls(j))<3 then '如果长度少于3
spac=""
for k=1 to 3-len(ls(j)) '加3-len个空格
spac=spac+" "
next
ls(j)=spac+ls(j) '转换长度足够的ls(j)
end if
next

str="" '二次处理IP串
for k=0 to 3
str=str+ls(k)+"."
next
str=left(str,15)

Dim vNumber(12)
vNumber(0) = "1110000111110111101111011110111101001011110100101111010010111101001011110111101111011110111110000111"
vNumber(1) = "1111011111110001111111110111111111011111111101111111110111111111011111111101111111110111111100000111"
vNumber(2) = "1110000111110111101111011110111111111011111111011111111011111111011111111011111111011110111100000011"
vNumber(3) = "1110000111110111101111011110111111110111111100111111111101111111111011110111101111011110111110000111"
vNumber(4) = "1111101111111110111111110011111110101111110110111111011011111100000011111110111111111011111111000011"
vNumber(5) = "1100000011110111111111011111111101000111110011101111111110111111111011110111101111011110111110000111"
vNumber(6) = "1111000111111011101111011111111101111111110100011111001110111101111011110111101111011110111110000111"
vNumber(7) = "1100000011110111011111011101111111101111111110111111110111111111011111111101111111110111111111011111"
vNumber(8) = "1110000111110111101111011110111101111011111000011111101101111101111011110111101111011110111110000111"
vNumber(9) = "1110001111110111011111011110111101111011110111001111100010111111111011111111101111011101111110001111"
vNumber(10) ="1111111111111111111111111111111111111111111111111111111111111111111111111111111111110011111111001111"
vNumber(11) ="1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111"

dim x,y,vCode(15) '三次处理成数组
For x = 0 To 14
vCode(x) = mid(str,x+1,1) '等于什么值?
vCode(x)=instr(1,cCode,vCode(x),1)-1 '值在串中是第几?
Next

Response.BinaryWrite chrB(66)&chrB(77)&chrB(8)&chrB(1)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(62)&_
chrB(0)&chrB(0)&chrB(0)&chrB(40)&chrB(0)&chrB(0)&chrB(0)&chrB(150)&chrB(0)&chrB(0)&chrB(0)&chrB(10)&chrB(0)&chrB(0)&_
chrB(0)&chrB(1)&chrB(0)&chrB(1)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(202)
Response.BinaryWrite chrB(0)&chrB(0)&chrB(0)&chrB(18)&chrB(11)&chrB(0)&chrB(0)&chrB(18)&chrB(11)&chrB(0)&chrB(0)&_
chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(0)&chrB(255)&chrB(255)&chrB(255)&chrB(0)&chrB(0)&_
chrB(0)&chrB(0)&chrB(0)

dim points(10)
for x=9 to 0 step -1 '处理成10行150列的像素串
points(x)=""
for y=0 to 14
points(x)=points(x)&mid(vNumber(vCode(y)),x*10+1,10)
next
for z=0 to 18 '劈开像素串，分别处理
lsstr=mid(points(x),z*8+1,8)
byteval=0
if mid(lsstr,1,1)="0" then byteval=byteval+128
if mid(lsstr,2,1)="0" then byteval=byteval+64
if mid(lsstr,3,1)="0" then byteval=byteval+32
if mid(lsstr,4,1)="0" then byteval=byteval+16
if mid(lsstr,5,1)="0" then byteval=byteval+8
if mid(lsstr,6,1)="0" then byteval=byteval+4
if mid(lsstr,7,1)="0" then byteval=byteval+2
if mid(lsstr,8,1)="0" then byteval=byteval+1
response.binarywrite chrb(byteval)
next
Response.BinaryWrite vColor(0) '写行尾标志
next
Response.BinaryWrite vColor(0) '写图尾标志
%>
了解更多请访问：http://www.ndfweb.cn/news-408.html
  NDF俱乐部
• 所有分类
• 公告与动态(24)
• 国际外贸(65)
• 网站优化(SEO)(50)
• 外贸B2C学堂(16)
• 商业摄影(9)
• 美国主机教程(17)
• PHP网站设计(66)
• 科技学堂(14)
• 网站设计技术分享(192)
• 开店创业(26)
• 音乐学堂(6)
• 美食(7)
• 互联网创业(98)
• 安卓程序开发(18)
• Python(11)
• 单片机与无线电(65)
• VB.net程序开发(13)
  国际域名注册
.com英文域名注册

新网.COM域名注册80元/年
  建站咨询
腾讯QQ
QQ		 淘宝旺旺在线
旺旺		 更多联系方式
其他方式
合作伙伴:万网 | 新网 | 新网互联 NDF网站建设淘宝店 | 实用工具 | 外貿網站建設 | 联系我们
鲁公网安备 37110202000336号 鲁ICP备2021027697号-1 Sitemap - RSSRSS订阅