Class FileDB
  Dim fso,IdxKey,DBPath
  Private Sub Class_Initialize
    Set fso = Server.CreateObject("Scripting.FileSystemObject")
    idxKey = "demo::test"
    DBPath = "DataCenter/File_DB/"
  End Sub

  Private Function getPath()
    Dim tmp
    getPath = replace(idxKey,"::","/") & ".html"
  End Function

  Private Function checkFile(byref fname)
    fname = Server.Mappath(DBPath & getPath())
    checkFile = fso.fileexists(fname)
  End Function

  Private Sub createPathName(byval idxKey)
    Dim TmpPa
    TmpPa = Server.Mappath(DBPath & idxKey)
    if not fso.folderexists(TmpPa) then
      if instr(idxKey,"\") > 0 then Call createPathName(left(idxKey,instrrev(idxKey,"\")-1))
      fso.createfolder(TmpPa)
    end if
  End Sub

  Public Function getTxt()
    if checkFile(fname) then
      set Txt = fso.getfile(fname)
      if Txt.size = 0 then
        Tmp = ""
      else
        Tmp = fso.opentextfile(fname).readall
      end if
      set Txt = Nothing
      getTxt = Tmp
    else
      getTxt = ""
    end if
  End Function

  Public Function remove()
    if checkFile(fname) then
      fso.deletefile fname
    end if
  End Function

  Public Function Save(byval content)
    if checkFile(fname) then
      set fpo = fso.opentextfile(fname,2)
    else
      idxKey = replace(idxKey,"::","\")
      if instr(idxKey,"\")>0 then Call createPathName(left(idxKey,instrrev(idxKey,"\")-1))
      set fpo = fso.createtextfile(fname)
    end if
    fpo.write content
    fpo.close
    set fpo = nothing
  End Function
End Class

因为时间比较紧，而且代码比较简单，就不加注释了，实际就是简化了文本文件的操作方法。

<% Server.ScriptTimeOut=10000 %>
<%
  '数据库链接代码

  set fdb = new FileDB
  fdb.DBPath = "../DataCenter/sms_DB/"

  conn.open constr
  set rs = server.createobject("ADODB.Recordset")
  '得到所有没有转换的数据
  rs.open "select * from sendlog where send_mob not like '%::%'",conn,3,2
  do while not rs.eof
    'FileDB 数据存放路径，日期::MD5(ID)
    idxStr = split(Rs("send_date")," ")(0) & "::" & md5(Rs("send_id"))
    fdb.IdxKey = idxStr
    fdb.Save(Rs("send_mob"))
    Rs("send_mob") = idxStr
    rs.update
    rs.movenext
  loop
  rs.close
  conn.close

  '数据库压缩过程，不是重点，再次不再多述
  compactdata(DataPath)
%>
减肥成功，所有数据转存到FileDB中。

执行一下，所有数据就转存好了，读取的时候很简单，指定了 idxStr，用getTxt()即可得到内容。

  set fdb = new FileDB
  fdb.DBPath = "../DataCenter/sms_DB/"
  '../DataCenter/sms_DB/aaa/1111.txt
  fdb.idxKey = "aaa::1111"
  str1 = fdb.getTxt()
  '../DataCenter/sms_DB/bbb/ccc/ddd/eee.txt
  fdb.idxKey = "bbb:ccc::ddd:eee"
  str2 = fdb.getTxt()
  '删除 ../DataCenter/sms_DB/bbb/ccc/ddd/eee.txt
  fdb.remove()
  '因为文件不存在，得到的值就是空字符串
  str3 = fdb.getTxt()
  '将内容保存到../DataCenter/sms_DB/bbb/ccc/ddd/eee.txt，因为不存在则创建，如果存在，则修改。
  fdb.save("11111")

2010年10月24日更新小Bug，修复了idxKey 定于数据存放在根目录，就会报错的错误

'pushWeb 1.01

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

function pushWeb()
	on error resume next
	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_webid from push")
	if rs.eof then
		push_id=0
		wscript.echo "没有更新，"&pushWeb_flush_Time/1000&"秒后再检查..."
	else
		push_webid=rs(0)
	end if
	rs.close
	set rs=nothing

	if push_webid<>0 then
		'载入站点信息
		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&"秒后再检查..."
			exit function
		end if
		rs.close
		set rs=nothing

		'如果是合法的站点
		if web_db<>"" and web_name<>"" then
			wscript.echo "找到一个任务[站点名="&web_name&"]，导入中..."
			'创建新的连接对象
			set newConn=CreateObject("ADODB.Connection")
			newConn.open web_db

			set rs=conn.execute("select push_sql from push where push_webid="&push_webid)

			do while not rs.eof
				push_sql=rs(0)
				push_Arr=split(push_sql,vbCrlf)
				for each push_str in push_Arr
					wscript.echo "插入一条数据..."
					if trim(push_str)<>"" then newConn.execute(trim(push_str))
				next
				rs.movenext
			loop

			'清空该站点下的所有任务
			conn.execute("delete from push where push_webid="&push_webid)

			wscript.sleep 100
			wscript.echo "开始修复数据..."
			'修复数据
			set repairRs=createobject("ADODB.recordset")
			repairRs.open "select * from NC_softList",newConn,3,2
			do while not repairRs.eof
				if not isnull(repairRs("Content")) then repairRs("Content")=replace(replace(repairRs("Content"),"{’}","'"),"{\n}",vbCrlf)
				repairRs.update
				repairRs.movenext
			loop
			repairRs.close
			set repairRs=nothing
			wscript.sleep 100
		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:1.01"
wscript.echo "pushWeb Design:苗启源"
wscript.echo "pushWeb Home:miaoqiyuan.cn"
wscript.echo string(60,"=")
wscript.echo "pushWeb Starting..."
wscript.echo string(60,"=")
call pushWeb()

通过YQYStudio助手功能，即使不懂批处理命令，仅需点几下鼠标，也可以写出功能强大的批处理工具。

复杂的逻辑命令，点击即可获得简单的使用说明。

可以通过菜单或者快捷键(Ctrl+E)关闭源奇缘助手，通过(Ctrl+Y)开启源奇缘助手

可以通过菜单修改背景颜色，字体颜色，字体大小，文字字体。

通过批处理辅助(Alt+C)即可打开批处理辅助菜单，可以通过简单的选择菜单，即可生成相应的批处理命令。

下载CMDPad 批处理辅助工具

CMDPad 批处理辅助工具文档

CMDPad 批处理辅助工具源码

定义一个miaoqiyuan协议。实现什么功能的，哦，多了，miaoqiyuan:你好。这样来实现弹出对话框，弹出你好。

Windows Registry Editor Version 5.00
 
[HKEY_CLASSES_ROOT\miaoqiyuan]
@="miaoqiyuan Protocol"
"URL Protocol"="D:\\miaoqiyuan\\miaoqiyuan.exe"
 
[HKEY_CLASSES_ROOT\Smiaoqiyuan\DefaultIcon]
@="D:\\miaoqiyuan\\miaoqiyuan.exe,0"
 
[HKEY_CLASSES_ROOT\miaoqiyuan\shell]
 
[HKEY_CLASSES_ROOT\miaoqiyuan\shell\open]
 
[HKEY_CLASSES_ROOT\miaoqiyuan\shell\open\command]
@=\"D:\\miaoqiyuan\\miaoqiyuan.exe\" %1"

这样，通过miaoqiyuan:链接的文件都可以通过miaoqiyuan.exe打开了

下面说说怎样来弹出对话框。

在VB中新建一个标准的EXE程序，新建一个按钮，改名为Showmsg，双击，输入END(点击退出程序)

然后添加

Private Sub Form_Load()
    showmsg.Caption = Replace(Command(), "miaoqiyuan:", "")
End Sub

这样就可以通过输入miaoqiyuan:1234弹出1234的警告了

这样就可用通过一个自定义的协议来执行程序了

    在Baidu上找了下，看到一篇通过导入纯真查询程序生成IP的数据库的文本格式到表A，然后再次用一个ASP文件来访问数据表A，把A表的IP转换到B表，这种方法我不是很赞成，而且有一定的局限行，比如要将纯真IP数据库转换成MDB格式，必须装Access，将纯真IP数据库转换成MSSQL必须安装MSSQL，转换城MYSQL必须安装MYSQL。即使安装了数据库还要安装IIS，对与新手操作可能有些麻烦了~

    我写了一个VBS的脚本，通过ADODB.Connection链接数据库，然后用ADODB保存到将纯真IP数据库转MDB数据库

Function Mappath(n)
	Mappath=Fso.getabsolutepathname(n)
End Function
 
Function IpToNum(Ip)
	IpNs=split(ip,".")
	IpN=IpNs(0)*S4+IpNs(1)*S3+IpNs(2)*S2+IpNs(3)*S1
	if err<>0 then IpN=0
	err.clear
	IpToNum=IpN
End Function
 
S1=256
S2=256*S1
S3=256*S2
S4=256*S3
on error resume next
Set Fso=CreateObject("Scripting.FileSystemObject")
Set Conn=CreateObject("ADODB.Connection")
Conn.open "provider=microsoft.jet.oledb.4.0;data source="&Mappath("dat.mdb")
 
Set Rs=CreateObject("ADODB.Recordset")
Rs.open "Select * from d",Conn,2,3
 
Set Fto=Fso.OpenTextFile(Mappath("dat.txt"))
Do while not Fto.atendofstream
	Rs.addnew
	Res=Split(Replace(Replace(Fto.Readline,"	",""),"  "," ")," ")
	Rs("s")=IpToNum(Res(0))
	Rs("e")=IpToNum(Res(1))
	Rs("c")=Res(2)
	Rs("h")=Res(3)
	Wscript.Echo "From "&Res(0)&" To "&Res(1)&" Updated."
	Rs.update
Loop
Rs.close

将纯真数据库转MSSQL数据库也很简单，只需改
Conn.open “driver={SQL Server}; server=(local);database= ;uid= ;pwd= ”

将纯真数据库转MYSQL数据库，只需改
Conn.open “Driver={mysql};database=[yourdatabase];uid=[username];pwd=[yourpassword];option=16386;”

直接打开软件界面

调试颜色界面

帮助界面

程序特点：
1.可以输入16进制颜色
2.可以通过滑动条调整某色(如红色)的值改变该颜色值，也可在滚动条后文本框直接输入
3.点击复制即可直接获取颜色的16进制值
4.右侧显示该色作为前景色，作为背景色，与反色搭配的预览效果
5.下方显示相似色的16进制值，并且背景为该色
6.下方显示相似色的反色16进制值，并且背景为该色

呵呵，这样说这个颜色调试工具有点像在下载站复制的了，实际上他是我在学校时写的，绝对原创

下面时它的部分代码，如果像要完整代码，可以在下面留言，或者Q我:77068320

Sub coloredit()
For i = 0 To 2
If Not IsNumeric(color(i).Text) Then color(i).Text = 0
If color(i).Text > 255 Then color(i).Text = 255
If color(i).Text < 0 Then color(i).Text = Abs(color(i).Text)
Next
a = color(0).Text
b = color(1).Text
c = color(2).Text
Text1(0).Text = a
HScroll1(0).Value = a
Text1(1).Text = b
HScroll1(1).Value = b
Text1(2).Text = c
HScroll1(2).Value = c
yulan(0).BackColor = RGB(a, b, c)
fan(1).BackColor = RGB(a, b, c)
fan(0).ForeColor = RGB(a, b, c)
qian.ForeColor = RGB(a, b, c)
banquan.ForeColor = RGB(a, b, c)
fan(1).ForeColor = RGB(255 - a, 255 - b, 255 - c)
fan(0).BackColor = RGB(255 - a, 255 - b, 255 - c)
If a < 16 Then e = "0" & Hex(a) Else e = Hex(a)
If b < 16 Then f = "0" & Hex(b) Else f = Hex(b)
If c < 16 Then g = "0" & Hex(c) Else g = Hex(c)
rgbok.Text = e & f & g
For i = 0 To 7
d = 12
a = color(0).Text - 3 * d + d * i
b = color(1).Text - 3 * d + d * i
c = color(2).Text - 3 * d + d * i
If a < 0 Then a = 0
If b < 0 Then b = 0
If c < 0 Then c = 0
If a > 255 Then a = 255
If b > 255 Then b = 255
If c > 255 Then c = 255
xiangsi(i).BackColor = RGB(a, b, c)
Text2(i).BackColor = RGB(255 - a, 255 - b, 255 - c)
If a < 16 Then e = "0" & Hex(a) Else e = Hex(a)
If b < 16 Then f = "0" & Hex(b) Else f = Hex(b)
If c < 16 Then g = "0" & Hex(c) Else g = Hex(c)
xiangsi(i).Text = "#" & e & f & g
If 255 - a < 16 Then e = "0" & Hex(255 - a) Else e = Hex(255 - a)
If 255 - b < 16 Then f = "0" & Hex(255 - b) Else f = Hex(255 - b)
If 255 - c < 16 Then g = "0" & Hex(255 - c) Else g = Hex(255 - c)
Text2(i).Text = "#" & e & f & g
Next
Timer2.Enabled = False
Timer2.Enabled = True
End Sub