分类目录归档:VBscript

ASP版本 文件转十六进制

最近接了一个彩信接口的网站,需要将 文本文件、图片文件 转换成 HexString,通过Form提交,.net、php、javascript的函数网上一抓一大把,asp的却不好找,今天我就来写一个asp版本的hexstring转换函数,为了方便以后用,直接写成类。

  class bin2txt
    dim adostream
    private sub class_initialize
      set adostream = server.createobject("ADODB.Stream")
      adostream.type = 1
      adostream.mode = 3
    end sub
    
    public sub open(fn)
      adostream.open
      adostream.LoadFromFile fn
    end sub
    
    public function getHex(t)
      dim tmp,hexstr,binstr
      binstr = adostream.read()
      for i = 1 to lenB(binstr)
        tmp = hex(ascB(midB(binstr,i,1)))
        if len(tmp) = 1 then tmp = "0" & tmp
        hexstr = hexstr & tmp & t
      next
      getHex = hexstr
    end function
    
    public function getOct(t)
      dim tmp,octstr,binstr
      binstr = adostream.read()
      for i = 1 to lenB(binstr)
        tmp = (ascB(midB(binstr,i,1)))
        if len(tmp) = 2 then tmp = "0" & tmp
        if len(tmp) = 1 then tmp = "00" & tmp
        octstr = octstr & tmp & t
      next
      getOct = octstr
    end function

  end class

使用方法,很简单,代码如下:

  set f = new bin2txt
  f.open server.mappath("sms/1.jpg")
  response.write f.getHex()

彩信添加桢也添加玩函数

'addpage
'pid:帧编号
'showtime:帧展示时间
function addpage(pid,showtime,ttype,tfile,ptype,pfile,mtype,mfile)
  addpage = "&d" & pid & "=" & showtime
  if ttype <> "" and ptype <> "" then
    f.open server.mappath(tfile)
    addpage = addpage & "&tt" & pid & "=" & ttype &_
                        "&tv" & pid & "=" & f.getHex()
  end if
  if ptype <> "" and ptype <> "" then
    f.open server.mappath(ptype)
    addpage = addpage & "&pt" & pid & "=" & ptype &_
            "&pv" & pid & "=" & f.getHex()
  end if
  if mtype <> "" and mtype <> "" then
    f.open server.mappath(mtype)
    addpage = addpage & "&mt" & pid & "=" & mtype &_
            "&mv" & pid & "=" & f.getHex()
  end if
end function

set f = new bin2txt
f.open server.mappath("sms/title.txt")
sendstr = "id=***&pwd=***&subject=" & f.getHex()
sendstr = sendstr & addpage(1,5,"txt","sms/1.txt","jpg","sms/1.jpg","","")
sendstr = sendstr & addpage(2,5,"txt","sms/2.txt","jpg","sms/2.jpg","","")
response.write openApi("http://118.144.76.79:8080/mmsServer/sendMms",sendstr)

vbs写的IIS日志分析工具

vbs写的IIS日志分析工具

IIS日志分析系统

为什么要开发vbs写的IIS日志分析工具?

在网上找了很多IIS日志分析工具,功能实在太有限,有的仅能分析百度、谷歌等搜索引擎爬虫的来访次数,远远达不到我们的用户的需求。作为一个小站长,有的时候也要分析一下自己站点的广告点击情况,静态页面的还好说,下载类的业务就不好统计了。耗时一晚上写出来本工具分享给大家,同时申请落伍,请大家帮顶。申请地址:http://www.im286.com/thread-5021543-1-1.html 。

IIS日志分析工具的使用方法

本工具对于初次接收vbs脚本的用户来说,可能有点麻烦。下面我们就一步一步来说说该工具的使用方法。
1、如果 vbscript 默认引擎非cscript,需要修改称cscript。修改方法很简单,直接在运行中输入:cscript //Nologo //H:Cscript 即可切换

2、下载IIS日志分析工具 压缩包 http://www.miaoqiyuan.cn/products/iis-log.rar,解压,打开log.vbs,修改dbpath为您当前解压的路径。

3、下载您的log日志文件,删掉前三行和第四行的#Fields: ,保存文件名为test.txt,保存到解压目录。

4、在开始运行中用cmd命令打开命令提示符,直接把 log.vbs拖拽到命令提示符中,回车即可开始分析。

以后会出软件版本吗?

会的,不过最近不会,其实现在的代码,直接拿到vb中,套个界面就比市面上的iis日志工具强大,但是现在实际还没有成熟,等正式发布时,功能绝对的强大。

IIS日志分析工具是免费的吗?

是的,本工具供站长免费使用,但是传播请保留我们的版权信息。也许您的建议将会出现在我们未来的软件版中。

vbs写的IIS日志分析工具代码如下:

'=============================================================
'=             Copyright (c) 2010 猫七(QQ:77068320)          =
'=                  All rights reserverd.                    =
'=============================================================
'=               IIS日志分析系统 v_1.10.0828                 =
'=      使用说明:http://www.miaoqiyuan.cn/p/iis-log-tools   =
'=      作者博客:http://www.miaoqiyuan.cn                   =
'=      版权声明:本代码供站长免费使用,传播请保留版权信息   =
'=============================================================
'=   程序简介:在网上找了很多IIS日志分析工具,功能简单,只能 =
'= 分析爬虫来访次数。有时候我们小站长也想分析下广告点击情况  =
'= ,这时候市面上的IIS统计工具就无能为力了。耗时一晚上写出来 =
'= 分享给大家,同时申请落伍,请大家帮顶。                    =
'=   申请地址:http://www.im286.com/thread-5021543-1-1.html  =
'=============================================================
'=  文件:log.vbs                                            =
'=  功能:IIS日志分析,懂程序的朋友可扩展,功能不可限量      =
'=============================================================

dbpath = "D:\log"                  '日志文件所在目录
tblna = "test.txt"                 '日志文件名,如果修改请同时修改 Schema.ini 中相关节点

function getuag(str)
  if instr(str,"+MSIE+7.0;")>0 then
    getuag = "Internet Explore 7.0"
  elseif instr(str,"+MSIE+8.0;")>0 then
    getuag = "Internet Explore 8.0"
  elseif instr(str,"+MSIE+6.0;")>0 then
    getuag = "Internet Explore 6.0"
  elseif instr(str,"MSIE")>0 then
    getuag = "Internet Explore(Other)"
  elseif instr(str,"curl")>0 then
    getuag = "CUrl"
  else
    getuag = str
  end if
end function

wscript.echo string(60,"=")
wscript.echo "         IIS日志分析工具 By 苗启源(MiaoQiyuan.cn)"
wscript.echo string(60,"=")

set conn = createobject("ADODB.Connection")
conn.open "provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath & ";Extended Properties=""text;HDR=YES;FMT=Delimited;"""

set rs = createobject("ADODB.Recordset")

'统计 链接访问次数
statime = timer()
rs.open "select [cs-uri-stem],count([c-ip]) from [" & tblna & "] group by [cs-uri-stem]",conn,1,1
ga = rs.getrows()
rs.close
wscript.echo " = 访问次数 = | = 独立访客 = | = 访问路径 = "
wscript.echo string(60,"-")
for i = 0 to ubound(ga,2)
  rsid = rsid + 1
  tme = ga(1,i)
  uri = ga(0,i)
  
  '不支持 COUNT DISTINCT 郁闷,使用笨拙的方法
  rs.open "select DISTINCT [c-ip] from [" & tblna & "] where [cs-uri-stem]='" & uri & "'",conn,1,1
  aip = rs.recordcount
  rs.close
  
  wscript.echo string(10 - len(tme)," ") & tme & "    | " & string(8 - len(aip)," ") & aip & "     | " & uri
next
wscript.echo string(60,"-")
wscript.echo "   统计:" & rsid & "条记录  查询用时:" & formatnumber((timer() - statime) * 1000,3)  & "毫秒"
wscript.echo string(60,"-") & vbCrlf


'统计 访问详情
for i = 0 to ubound(ga,2)
  rsid = 0
  uri = ga(0,i)
  wscript.echo string(60,"=")
  wscript.echo "         访问详情:" & uri
  wscript.echo string(60,"=")
  statime = timer()
  wscript.echo " = 编号 = | = IP地址 = | = 浏览器类型 = "
  rs.open "select DISTINCT [c-ip],[cs(User-Agent)] from [" & tblna & "] where [cs-uri-stem]='" & uri & "'",conn,1,1
  do while not rs.eof
    rsid = rsid + 1
    'IP 自动变成了数字,还没有找到解决方法
    cip = rs(0)
    uag = getuag(rs(1))
    wscript.echo string(8 - len(rsid)," ") & rsid & "  | " & string(8 - len(cip)," ") & cip & "  | " & uag
    rs.movenext
  loop
  rs.close
  wscript.echo string(60,"-")
  wscript.echo "   统计:" & rsid & "条记录  查询用时:" & formatnumber((timer() - statime) * 1000,3)  & "毫秒"
  wscript.echo string(60,"-") & vbCrlf
next

asp通过域名查IP

     最近有个工作,知道了域名,把ip导出来,大约800多条记录,一个一个查麻烦了。有没有其他方法能让asp通过域名查IP呢?

在网上搜索了一下,asp通过域名查ip需要安装一个TCPIP.DNS的组件。我下载了一个测试了一下,效率并不是很高。

一般查询域名的ip的方法是ping一下,得到一个ip。我们先用VBScript测试。

Function strCut(strContent,StartStr,EndStr,CutType) 
    Dim strHtml,S1,S2
    strHtml = strContent 
    On Error Resume Next 
    Select Case CutType
    Case 1 
        S1 = InStr(strHtml,StartStr) 
        S2 = InStr(S1,strHtml,EndStr)+Len(EndStr) 
    Case 2 
        S1 = InStr(strHtml,StartStr)+Len(StartStr) 
        S2 = InStr(S1,strHtml,EndStr) 
    End Select
    If Err Then 
        strCute = "0.0.0.0" 
        Err.Clear 
        Exit Function 
    Else
        strCut = Mid(strHtml,S1,S2-S1) 
    End If
End Function

Function getIP(Domain)
	Set objWShell=CreateObject("WScript.Shell")
	Set objCmd=objWShell.Exec("ping "&Domain)
	StrPResult=objCmd.StdOut.Readall()
	Set objCmd=nothing
	Set objWShell=nothing
	getIP=strCut(StrPResult,"[","]",2)   
End Function

startTme=timer
Wscript.echo getIP("www.baidu.com")
wscript.echo timer-startTme

不过效率很低哦,大约三秒钟的时间才能得到结果。通过域名查ip还有一个快速的方法,nslookup,我们修改一下上边的函数:


Function strCut(strContent)
	ipsta=1
	strLineArr=split(strContent,vbCrlf)
	for each strLine in strLineArr
		if instr(strLine,":")>0 then
			getArr=split(strLine,":")
			if LCase(getArr(0))="address" then
				ipsta=1
			end if
			if ipsta=1 then
				if LCase(getArr(0))="address" then
					strCut=split(Trim(getArr(1)),",")(0)
					exit function
				end if
			end if
		end if
	next
	strCut="err"
End Function

Function getIP(Domain)
	Set objWShell=CreateObject("WScript.Shell")
	Set objCmd=objWShell.Exec("nslookup "&Domain)
	StrPResult=objCmd.StdOut.Readall()
	Set objCmd=nothing
	Set objWShell=nothing
	getIP=strCut(StrPResult)
End Function


startTme=timer
Wscript.echo getIP("www.baidu.com")
wscript.echo timer-startTme

现在速度快了,0.3秒即可搞定。vbscript是解决了,那asp通过域名查ip还是不可以的,一个最大的问题是虚拟主机一般都不给执行asp脚本运行WScript.Shell的权限,所以虚拟主机用户可以不用考虑了,TCPIP.DNS这种空间商肯定是不给用的。第二个问题也是安全问题,自己用的服务器,一般都不给web用户访问系统目录的权限,asp访问nslookup.exe的权限一般都没有?解决方法就是修改一下相关文件的权限即可。

< %
Function strCut(strContent) 
	strLineArr=split(strContent,vbCrlf)
	for each strLine in strLineArr
		if instr(strLine,":")>0 then
			getArr=split(strLine,":")
			if LCase(getArr(0))="addresses" then
				strCut=split(Trim(getArr(1)),",")(0)
				exit function
			end if
		end if
	next
	strCut="err"
End Function

Function getIP(Domain)
	Set objWShell=Server.CreateObject("WScript.Shell")
	Set objCmd=objWShell.Exec(server.mappath("nslookup.exe")&" "&Domain)
	StrPResult=objCmd.StdOut.Readall()
	Set objCmd=nothing
	Set objWShell=nothing
	getIP=strCut(StrPResult)
End Function

response.write getIP("www.baidu.com")
%>

浅谈数据转换(导入,导出)的快速解决方法

因为工作需要,经常需要操作数据转换的工作。比如:从dz导入到pw,或从新云导入到5ucms,把数据从这个表导入到那个表。操作的多了,认为自己对数据库转化还是有一定的研究的,今天写出了,希望能对做同样工作的朋友一些帮助或者启发。

一般我完成数据库转换的脚本选择vbscript。原因吗,简单当然是一个很重要的因素,更重要的常用的数据库(如:MySQL)都有ADO的驱动。

数据库转化第一步,先要确定目的数据库的类型和当前数据库的类型。如果access数据库转换成mysql数据库。则需要先去下载MySQL ADO的驱动。

第二步,连接好数据库了,现在要分析数据库对应的字段之间的关系。如果能把需要操作的数据表的字段导出来应该能快很多。既然选择了vbscript脚本,我们就让他来帮忙。

'Auth:猫七(Miaoqiyuan.cn)
'outTableCol(表名)
'Desc:返回某表的所有字段
function outTableCol(tbl)
	tablesCol=""
	set rs=createobject("ADODB.Recordset")
	rs.open "select top 1 * from "&tbl,conn,1,1
	for i=0 to rs.fields.count-1
		tablesCol=tablesCol & rs.fields(i).name & ","
	next
	outTableCol=tablesCol
	rs.close
	set rs=nothing
end function

直接使用Wscript.echo outTableCol(表名),哈哈,表明全输出来了(最好将vbscript的脚本宿主改成cscript)。

第三步,字段的对应关系分析好了,自然要进入实质性的过程了-插入数据。
insert into 语句?No,我们用ADODB.Recordset。使用MySQL数据库的使用ADODB也可以使用哦,这也是我使用vbscript的另一个原因,vbscript对ado的兼容性不用我说了吧。。。确定了用ADODB.Recordset,写这种Rs(..)=Rs(..)的方式也是挺麻烦的,现在我们再次请vbscript出山。

'Auth:猫七(Miaoqiyuan.cn)
'CreateRsStr(字段名,用','分隔,两个字段间的转换用=>)
'例如:
'CreateRsStr "d_id,d_dme"  #Rs1("d_id")=Rs2("d_id")
'CreateRsStr "d_id=>c_id"  #Rs1("c_id")=Rs2("d_id")
'生成Rs1到Rs2的复制字符串

function CreateRsStr(str)
	strDb=split(str,",")
	StrOut=""
	for each Col in strDb
		if Trim(Col) <>"" then
			if instr(Col,"=>")>0 then
				ColDb=Split(Col,"=>")
				if Trim(ColDb(0)) <> "" and Trim(ColDb(1)) <> "" then
					StrOut=StrOut & "Rs1(""" & ColDb(1) & """)=Rs2(""" & ColDb(0) & """)" & VbCrlf
				end if
			else
				StrOut=StrOut & "Rs1(""" & Col & """)=Rs2(""" & Col & """)" & VbCrlf
			end if
		end if
	next
	CreateRsStr=StrOut
end function

Wscript.echo CreateRsStr(“d_id,d_regstt,d_cpr,d_cprnme,d_urlpri,d_dnspri,d_prd”)一下,看看出来了什么?哈哈,是不是出现了

		'Rs1("d_id")=Rs2("d_id")
		Rs1("d_regstt")=Rs2("d_regstt")
		Rs1("d_cpr")=Rs2("d_cpr")
		Rs1("d_cprnme")=Rs2("d_cprnme")
		Rs1("d_urlpri")=Rs2("d_urlpri")
		Rs1("d_dnspri")=Rs2("d_dnspri")
		Rs1("d_prd")=Rs2("d_prd")

我们直接把他复制到程序中就可以了。上边的是相同字段名的情况,如果字段名不相同,CreateRsStr也可以处理,Wscript.echo CreateRsStr(“d_id=>a_id,d_regstt=>a_regstt”)。

然后update更新就可以了,导数据简单吧,如果您有更好的方法,欢迎和我联系,我的博客是http://www.miaoqiyuan.cn

PushWeb 采集站点信息发布的最佳方案

PushWeb,应该算是我自造的一个词,Push发送,PushWeb则是把采集到的数据发送到站点的一个方案,临时使用vbscript脚本编写。那有的朋友可能会说CMS后台之类的,或者采集软件直接发上来不更好吗?原因如下:

CMS后台,来回复制好麻烦,而且容易出错。复制一篇两篇还可以,如果1000,10000呢?

采集软件发送,这个呢?如果信息都是采集的,按原来的列表顺序原封不动的发上来,恐怕。。。。而且在采集软件了并不是很方便的控制。

PushWeb的好处,可以同时发送数据到同一台服务器上的多个站点。为什么不用asp?因为一般iis站点,我习惯每个站点权限独立,假如pushWeb拥有所有站点的权限,安全性可能会降低。而且同时查询较多数据时,可能占用cpu过多,而影响web站点,而wscript可以通过累了sleep一下。另外后期准备为站点加些计划任务(比如自动生成,现在还是Beta0.1,仅供发布信息),这样只需要一个进程就可以了。

实现方法:

'pushWeb beta0.1

'刷新时间
const pushWeb_flush_Time=10000
'数据库路径
const pushWeb_dbPath="D:\WebDesign\Products\pushWeb\pushWebDB.mdb"


function pushWeb()
	dim conn,rs,push_id,push_webid,push_sql
	dim web_db,web_name
	dim push_Arr,push_str
	
	set conn=createobject("ADODB.connection")
	conn.open "provider=microsoft.jet.oledb.4.0;data source="&pushWeb_dbPath
	set rs=conn.execute("select push_id,push_webid,push_sql from push")
	if rs.eof then
		push_id=0
		wscript.echo "没有更新,"&pushWeb_flush_Time/1000&"秒后再检查..."
	else
		push_id=rs(0)
		push_webid=rs(1)
		push_sql=rs(2)
	end if
	rs.close
	set rs=nothing
	
	if push_id<>0 then
		conn.execute("delete from push where push_id="&push_id)
		set rs=conn.execute("select web_name,web_db from web where web_id="&push_webid)
		if not rs.eof then
			web_name=rs(0)
			web_db=rs(1)
		else
			wscript.echo "错误的任务请求,"&pushWeb_flush_Time/1000&"秒后再检查..."
		end if
		rs.close
		set rs=nothing
		conn.close
		
		if web_db<>"" and push_sql<>"" then
			wscript.echo "找到一个任务[站点名="&web_name&"],导入中..."
			
			conn.open web_db
			push_sql=replace(push_sql,vbCrlf,";")
			push_Arr=split(push_sql,";")
			for each push_str in push_Arr
				if trim(push_str)<>"" then conn.execute(trim(push_str))
			next
			
			conn.close
			set conn=nothing
			
			wscript.echo "导入完毕,"&pushWeb_flush_Time/1000&"秒后检查是否有新任务..."
		end if
	else
		wscript.sleep pushWeb_flush_Time
	end if
	wscript.echo string(60,"=")
	call pushWeb()
end function


wscript.echo string(60,"=")
wscript.echo "pushWeb version:beta 0.1"
wscript.echo "pushWeb Design:苗启源"
wscript.echo "pushWeb Home:miaoqiyuan.cn"
wscript.echo string(60,"=")
wscript.echo "pushWeb Starting..."
wscript.echo string(60,"=")
call pushWeb()

数据库设置:

push
push_id push_webid push_sql
1 1 insert into t(t,c)values(‘push_web_test’,’push_web_test’);insert into t(t,c)values(‘push_web_test’,’push_web_test’);
2 1 insert into t(t,c)values(‘push_web_test’,’push_web_test’)
insert into t(t,c)values(‘push_web_test’,’push_web_test’)
web
web_id web_name web_db
1 测试站点 provider=microsoft.jet.oledb.4.0;data source=D:\WebDesign\Products\pushWeb\test.mdb

生成静态页,文章标题拼音命名重复的解决方法。

刚才发布了一篇文章:ASP/VBScript 汉字转拼音程序,只支持GBK(http://www.miaoqiyuan.cn/p/vbscript-gbk-pinyin)。你可能已经猜出来了,为了SEO优化而转换为拼音的路径,用这个函数可以很方便的解决了。但是中国文字博大精深,相同读音的字太多了,那么上边说的方法生成的路径可能就要冲突了,怎么办呢?在此,我给大家提供一个解决方法。因为是windows平台,使用vbscript脚本来实现。
实际很简单。先用like查询是否有类似的路径,并记录结果数tms。如果tms=0怎用拼音,如果结果数大于1,则用拼音&结果数的方法。很简单吧,给出的代码如下:

'cscript [thisScriptName.vbs]

set conn=createobject("ADODB.connection")
conn.open "provider=microsoft.jet.oledb.4.0;data source=D:\miaoqiyuan\Products\labs\故事\dat\db.mdb"

'table c
'n 故事名称
'd 标题读音
'g 故事
'c 出处
'p 标题首写字母
'u 故事路径
set rs=createobject("ADODB.recordset")
rs.open "select * from c",conn,3,2
do while not rs.eof
	staTme=timer
	tms=conn.execute("select count(u) from c where u like '"&rs("p")&"%'")(0)
	wscript.echo "正在整理"&rs("n")&"中..."
	if tms=0 then
		rs("u")=rs("p")
	else
		rs("u")=rs("p")&tms
	end if
	rs.update
	wscript.echo "整理"&rs("n")&"完毕,用时"&(Timer()-staTme)*1000&"毫秒。"
	rs.movenext
loop