->如何关闭ScreenSave功能,改变Timeout时间　　此外希望只有本次使用Windows时改变(下次开机时还原原状)，则最後参数改为　SPIF_SENDWININICHANGE(没有SPIF_UPDATEINIFILE)ConstSPI_SETSCREENSAVEACTIVE=17ConstSPI_SETSCREENSAVETIMEOUT=15ConstSPIF_SENDWININICHANGE=&H2ConstSPIF_UPDATEINIFILE=&H1PrivateDeclareFunctionSystemParametersInfoLib"user32"Alias_　　"SystemParametersInfoA"(ByValuActionAsLong,ByValuParamAsLong,_　　ByVallpvParamAsLong,ByValfuWinIniAsLong)AsLongPrivateSubSetScreenSaveTimeout(ByValBySecondAsLong)　CallSystemParametersInfo(SPI_SETSCREENSAVETIMEOUT,BySecond,0,_　　　　　SPIF_UPDATEINIFILE SPIF_SENDWININICHANGE)EndSubPrivateSubEnableScreenSave()　CallSystemParametersInfo(SPI_SETSCREENSAVEACTIVE,1,0,_　　　　　SPIF_UPDATEINIFILE SPIF_SENDWININICHANGE)EndSubPrivateSubDisableScreenSave()　CallSystemParametersInfo(SPI_SETSCREENSAVEACTIVE,0,0,_　　　　　SPIF_UPDATEINIFILE SPIF_SENDWININICHANGE)EndSub->->四篇（共六篇）： 大家好,昨天我休息了一天,所以今天写第4章:循环结构 　　我们先来看一道题:商场进行每日结算,要求累加出今天的营业额,每次输入一个数,这道题其实很简单,但就我们现在学 过的知识要完成这道题相当麻烦,我们来分析一下.首先,我们需要知道买卖的次数,这样才能控制输入的次数,但是,这种设 计是非常低效的,每天都要重新设计程序.假定今天进行了5次交易,以下是源程序: dimsum sum=0'初始化变量 sum=sum+int(inputbox("请输入交易额")) 'sum=sum+x　这种形式是把本身的值取出来,进行一次运算,再放回本身,这种方法很有用处 '这里使用了函数嵌套,把inputbox的返回值直接传给int函数,转化成整数,下同 sum=sum+int(inputbox("请输入交易额")) sum=sum+int(inputbox("请输入交易额")) sum=sum+int(inputbox("请输入交易额")) sum=sum+int(inputbox("请输入交易额")) msgbox(sum) 　　看到了吗,我通过把计算过程复制了5遍才设计好了程序,这种程序在汽车交易所等交易次数少的地方还能凑合着用,如果 放到超市岂不是要复制,粘贴几千遍?我们今天讲的内容就可以克服这种缺陷,首先,我们来讲以下Do...Loop语句. 　　do...loop的结构看上去非常简单,就是:do...loop,仅此而已,这个结构不断执行do和loop之间的语句(学名叫:循环体), 永不停止.举个例子来说: do msgbox("这个信息会不断重复出现,要停止程序请使用任务管理器(Ctrl+Alt+Del)中止wscript进程") loop 　　运行这个程序,当你点销掉一个对话框马上会出来另一个,你永远点不完,总有下一个.谁会运行这样的程序?除非是给 别人捣乱(我就干过这种事),所以在do..loop结构中还有一个语句:exitdo,这个语句将终止循环,跳到loop后面的语句继续 执行.据个例子来说: dima'注意:常量不需要在dim里面声明,否则会引发错误 constpass="123456"'这是一个字符串请用""包裹起来.设定密码为常量,不可变更 do a=inputbox("请输入密码") ifa=passthen msgbox("密码校验成功") exitdo endif loop 　　这个程序会一直不停的问你密码,知道你输入了正确的密码为止.(if可以嵌套在另一个if当中,也可以嵌套在循环体当中 ,所以一定要用缩进,来分清楚程序的各个部分).这个程序是很经典的,早期的程序都是这么做的.但是我们是Hacker,所以 我们了解系统的安全性,这种无限次认证程序很容易被穷举破解,我们要来限定认证的次数.修改程序如下 dima,ctr ctr=0'设置计数器 constpass="pas123_"'上面的那个是弱密码,这次改的强一点 do ifctr=3then msgbox("已经达到认证上限,认证程序关闭") exitdo else a=inputbox("请输入密码") ifa=passthen msgbox("认证成功") msgbox("(你可以在这里加一段成功后得到的信息)") exitdo else ctr=ctr+1'如果密码出错就增加一次错误认证计数 msgbox("认证出错,请检查密码") endif endif loop 　　运行这个程序试试看,当你出了3此错误以后,就会停止再次询问密码,关闭程序.telnet认证用来限制次数的程序与此大 同小异.要注意的是嵌套的if语句,清仔细读一下这个程序,可能比较难懂,也请你试着自己设计一下类似的程序. 　　其实,要在do...loop加上验证的功能,并不一定要用if,我们可以直接利用do.我来介绍一下while关键字,while可以放 在do或者是loop后面,然后再接一个表达式,当表达式的值为true的时候(表达式成立),才运行循环体.我们来看一下修改后的 程序" dima,ctr ctr=0 constpass="pas123_" dowhilectr<3 a=inputbox("请输入密码") ifa=passthen msgbox("认证成功") msgbox("(你可以在这里加一段成功后得到的信息)") exitdo else ctr=ctr+1'如果密码出错就增加一次错误认证计数 msgbox("认证出错,请检查密码") endif loop 　　这样实现的功能和上一个例子完全一样,我们再来看看把while放在loop后面: dima,ctr ctr=0 constpass="pas123_" do a=inputbox("请输入密码") ifa=passthen msgbox("认证成功") msgbox("(你可以在这里加一段成功后得到的信息)") exitdo else ctr=ctr+1'如果密码出错就增加一次错误认证计数 msgbox("认证出错,请检查密码") endif loopwhilectr<3 　　功能是一样的,为什么要放在loop后面呢?你把ctr的值改成3就知道了,while在do后面的程序会直接退出,而在loop后面 还会允许一次认证,到了loop才结束.和while相反的是until,用法和while一样,不过他只有当后面的表达式的值为false(表 达式不成立)的时候才执行循环体,请自己试验一下 　　ok,我们来看另外一种循环结构,for....next,这种循环结构是基于计数的,也是在编程中最常见到的循环结构. dimi fori=0to5 msgbox(i) next 　　看到了吗?每次输出的i都是递增的,但我们没有明确指出i要递增,当i达到5的时候,循环就结束了,因为由0开始,所以 循环体执行了6次,这一点很重要,大部分东西都是从0开始而不是1.这个程序也可以写成 do的形式: dimi i=0 dowhilei<5 msgbox(i) i=i+1'因为do不能自动计数,必须手动加 loop 　　怎么样,还是for比较好用吧.for在编程中很有用途,我们再举一个例子,顺便讲一下嵌套循环. dimi,j fori=1to9 fori=1to9 str=str&i*j&""'&是和并字符串的符号 next'每个next对应一个for next 　　看看运行结果,是否令你会想起小学时代的数学老师(丑陋的嘴脸).要注意,这里有一个"大"的for,和一个小的for,当 小的for执行完一个周期以后,大的for才执行一次(换句话说,大的for执行一次,小的要执行9次),所以一共执行了九九八十 一次.在大的for里可以不仅仅是一个小的for,也可以加上另外的语句.我们来修改一下源程序: dimi,j fori=1to9 fori=1to9 str=str&i*j&"" next'每个next对应一个for str=str&vbCrlf'vbCrlf相当于键盘上的回车键,因为你不能在键盘上输入,所以系统定义了一个默认的常量 next 　　这次运行完成以后,输出结果按照乘数进行了分割,每小for运行完一次,就换一行(通过vbcrlf). 　　这次的内容对菜鸟可能比较难懂,掌握的办法只有一个:多实践.另外,我在论坛看到很多人还是问:"VBScript要用什么工 具编?"我就很气愤,我在第一篇里面已经说明:用记事本编辑源代码,然后保存为以.vbs为扩展名的程序就可以了,请大家不要 再问.另外,国产的一种垃圾软件"超级X霸"抢占了vbs这个扩展名,请把那个垃圾卸载掉. 　　我们总结一下: 要点: 1)do..loop和exitdo的用法 2)while当表达式true的时候执行循环体,until反之 3)for...next是计数循环,每次执行计数器递加 4)嵌套循环的作用和写法 4.5)&用于连接字符串 5)vbCrLf相当于键盘上的回车键 作业: 1)在我国的数学经典著作"九章算术"中有这样一道题:百钱买百鸡,公鸡5钱一只,母鸡3钱一只,小鸡1钱2只(这个数据我是参 考一本编程书的,但我记得是公3,母1,小1钱3只?不管了,就按照书上得来吧)求得是能有多少种办法买这些鸡.如果看不懂的 话我用大白话说说:有人要去买鸡,用100块钱正好买了100只鸡,价格如下:公:5$,母:3$,小:1$for2,让你求一共多少种卖 法(公母小怎么搭配).请用循环解决这个问题. ps:今天要去移民局办事,所以文章写的很仓促.大部分代码都没有实验,请大家帮我找错.另外,上次的作业大家在论坛应该 看到了,我就不重复答案了,不知道大家喜欢做这种题,还是以前那种比较简单的? <scriptlanguage=vbscript> Functionnl() '获取当前系统时间 curTime=Now() DimWeekName(7),MonthAdd(11),NongliData(99),TianGan(9),DiZhi(11),ShuXiang(11),DayName(30),MonName(12) '星期名 WeekName(0)="*" WeekName(1)="星期日" WeekName(2)="星期一" WeekName(3)="星期二" WeekName(4)="星期三" WeekName(5)="星期四" WeekName(6)="星期五" WeekName(7)="星期六" '天干名称 TianGan(0)="甲" TianGan(1)="乙" TianGan(2)="丙" TianGan(3)="丁" TianGan(4)="戊" TianGan(5)="己" TianGan(6)="庚" TianGan(7)="辛" TianGan(8)="壬" TianGan(9)="癸" '地支名称 DiZhi(0)="子" DiZhi(1)="丑" DiZhi(2)="寅" DiZhi(3)="卯" DiZhi(4)="辰" DiZhi(5)="巳" DiZhi(6)="午" DiZhi(7)="未" DiZhi(8)="申" DiZhi(9)="酉" DiZhi(10)="戌" DiZhi(11)="亥" '属相名称 ShuXiang(0)="鼠" ShuXiang(1)="牛" ShuXiang(2)="虎" ShuXiang(3)="兔" ShuXiang(4)="龙" ShuXiang(5)="蛇" ShuXiang(6)="马" ShuXiang(7)="羊" ShuXiang(8)="猴" ShuXiang(9)="鸡" ShuXiang(10)="狗" ShuXiang(11)="猪" '农历日期名 DayName(0)="*" DayName(1)="初一" DayName(2)="初二" DayName(3)="初三" DayName(4)="初四" DayName(5)="初五" DayName(6)="初六" DayName(7)="初七" DayName(8)="初八" DayName(9)="初九" DayName(10)="初十" DayName(11)="十一" DayName(12)="十二" DayName(13)="十三" DayName(14)="十四" DayName(15)="十五" DayName(16)="十六" DayName(17)="十七" DayName(18)="十八" DayName(19)="十九" DayName(20)="二十" DayName(21)="廿一" DayName(22)="廿二" DayName(23)="廿三" DayName(24)="廿四" DayName(25)="廿五" DayName(26)="廿六" DayName(27)="廿七" DayName(28)="廿八" DayName(29)="廿九" DayName(30)="三十" '农历月份名 MonName(0)="*" MonName(1)="正" MonName(2)="二" MonName(3)="三" MonName(4)="四" MonName(5)="五" MonName(6)="六" MonName(7)="七" MonName(8)="八" MonName(9)="九" MonName(10)="十" MonName(11)="十一" MonName(12)="腊" '公历每月前面的天数 MonthAdd(0)=0 MonthAdd(1)=31 MonthAdd(2)=59 MonthAdd(3)=90 MonthAdd(4)=120 MonthAdd(5)=151 MonthAdd(6)=181 MonthAdd(7)=212 MonthAdd(8)=243 MonthAdd(9)=273 MonthAdd(10)=304 MonthAdd(11)=334 '农历数据 NongliData(0)=2635 NongliData(1)=333387 NongliData(2)=1701 NongliData(3)=1748 NongliData(4)=267701 NongliData(5)=694 NongliData(6)=2391 NongliData(7)=133423 NongliData(8)=1175 NongliData(9)=396438 NongliData(10)=3402 NongliData(11)=3749 NongliData(12)=331177 NongliData(13)=1453 NongliData(14)=694 NongliData(15)=201326 NongliData(16)=2350 NongliData(17)=465197 NongliData(18)=3221 NongliData(19)=3402 NongliData(20)=400202 NongliData(21)=2901 NongliData(22)=1386 NongliData(23)=267611 NongliData(24)=605 NongliData(25)=2349 NongliData(26)=137515 NongliData(27)=2709 NongliData(28)=464533 NongliData(29)=1738 NongliData(30)=2901 NongliData(31)=330421 NongliData(32)=1242 NongliData(33)=2651 NongliData(34)=199255 NongliData(35)=1323 NongliData(36)=529706 NongliData(37)=3733 NongliData(38)=1706 NongliData(39)=398762 NongliData(40)=2741 NongliData(41)=1206 NongliData(42)=267438 NongliData(43)=2647 NongliData(44)=1318 NongliData(45)=204070 NongliData(46)=3477 NongliData(47)=461653 NongliData(48)=1386 NongliData(49)=2413 NongliData(50)=330077 NongliData(51)=1197 NongliData(52)=2637 NongliData(53)=268877 NongliData(54)=3365 NongliData(55)=531109 NongliData(56)=2900 NongliData(57)=2922 NongliData(58)=398042 NongliData(59)=2395 NongliData(60)=1179 NongliData(61)=267415 NongliData(62)=2635 NongliData(63)=661067 NongliData(64)=1701 NongliData(65)=1748 NongliData(66)=398772 NongliData(67)=2742 NongliData(68)=2391 NongliData(69)=330031 NongliData(70)=1175 NongliData(71)=1611 NongliData(72)=200010 NongliData(73)=3749 NongliData(74)=527717 NongliData(75)=1452 NongliData(76)=2742 NongliData(77)=332397 NongliData(78)=2350 NongliData(79)=3222 NongliData(80)=268949 NongliData(81)=3402 NongliData(82)=3493 NongliData(83)=133973 NongliData(84)=1386 NongliData(85)=464219 NongliData(86)=605 NongliData(87)=2349 NongliData(88)=334123 NongliData(89)=2709 NongliData(90)=2890 NongliData(91)=267946 NongliData(92)=2773 NongliData(93)=592565 NongliData(94)=1210 NongliData(95)=2651 NongliData(96)=395863 NongliData(97)=1323 NongliData(98)=2707 NongliData(99)=265877 '生成当前公历年、月、日==>GongliStr curYear=Year(curTime) curMonth=Month(curTime) curDay=Day(curTime) GongliStr=curYear&"年" If(curMonth<10)Then GongliStr=GongliStr&"0"&curMonth&"月" Else GongliStr=GongliStr&curMonth&"月" EndIf If(curDay<10)Then GongliStr=GongliStr&"0"&curDay&"日" Else GongliStr=GongliStr&curDay&"日" EndIf '生成当前公历星期==>WeekdayStr curWeekday=Weekday(curTime) WeekdayStr=WeekName(curWeekday) '计算到初始时间1921年2月8日的天数：1921-2-8(正月初一) TheDate=(curYear-1921)*365+Int((curYear-1921)/4)+curDay+MonthAdd(curMonth-1)-38 If((curYearMod4)=0AndcurMonth>2)Then TheDate=TheDate+1 EndIf '计算农历天干、地支、月、日 isEnd=0 m=0 Do If(NongliData(m)<4095)Then k=11 Else k=12 EndIf n=k Do If(n<0)Then ExitDo EndIf '获取NongliData(m)的第n个二进制位的值 bit=NongliData(m) Fori=1TonStep1 bit=Int(bit/2) Next bit=bitMod2 If(TheDate<=29+bit)Then isEnd=1 ExitDo EndIf TheDate=TheDate-29-bit n=n-1 Loop If(isEnd=1)Then ExitDo EndIf m=m+1 Loop curYear=1921+m curMonth=k-n+1 curDay=TheDate If(k=12)Then If(curMonth=(Int(NongliData(m)/65536)+1))Then curMonth=1-curMonth ElseIf(curMonth>(Int(NongliData(m)/65536)+1))Then curMonth=curMonth-1 EndIf EndIf '生成农历天干、地支、属相==>NongliStr NongliStr="农历"&TianGan(((curYear-4)Mod60)Mod10)&DiZhi(((curYear-4)Mod60)Mod12)&"年" NongliStr=NongliStr&"("&ShuXiang(((curYear-4)Mod60)Mod12)&")" '生成农历月、日==>NongliDayStr If(curMonth<1)Then NongliDayStr="闰"&MonName(-1*curMonth) Else NongliDayStr=MonName(curMonth) EndIf NongliDayStr=NongliDayStr&"月" NongliDayStr=NongliDayStr&DayName(curDay) nl=NongliStr&NongliDayStr EndFunction msgboxnl </script>你可曾想过移植Excel工作表中的数据，但是对那些用户来说却不会感觉到工作的复杂？你是否想开发具有报告列表的用户接口，从而使你能够插入Excel工作簿？另外，你是否能够以这样一种方式开发用户接口，即当该接口发生变化时，用户的机器能够自动更新到最新版本？本文将向你展示怎样建立：VisualBasic5.0中的简单ActiveXDLL，从而使用户从Northwind数据库中获得一系列表单

State返加对像状态是否打开'文件名SourceDB.ini文件

　　PrivateDeclareFunctionGetPrivateProfileStringLib"kernel32"Alias

　　"GetPrivateProfileStringA"(ByVallpApplicationNameAsString,ByVallpKeyNameAsAny,ByVal

　　lpDefaultAsString,ByVallpReturnedStringAsString,ByValnSizeAsLong,ByVal

　　lpFileNameAsString)AsLong

　　PrivateDeclareFunctionWritePrivateProfileStringLib"kernel32"Alias

　　"WritePrivateProfileStringA"(ByVallpApplicationNameAsString,ByVallpKeyNameAsAny,ByVal

　　lpStringAsAny,ByVallpFileNameAsString)AsLong

　　

　　'以下两个函数,读/写ini文件,固定节点setting,in_key为写入/读取的主键

　　'仅仅针对是非值

　　'Y：yes,N：no,E：error

　　PublicFunctionGetIniTF(ByValIn_KeyAsString)AsBoolean

　　OnErrorGoToGetIniTFErr

　　GetIniTF=True

　　DimGetStrAsString

　　GetStr=VBA.String(128,0)

　　GetPrivateProfileString"Setting",In_Key,"",GetStr,256,App.Path&"\SourceDB.ini"

　　GetStr=VBA.Replace(GetStr,VBA.Chr(0),"")

　　IfGetStr="1"Then

　　GetIniTF=True

　　GetStr=""

　　Else

　　GoToGetIniTFErr

　　EndIf

　　ExitFunction

　　GetIniTFErr:

　　Err.Clear

　　GetIniTF=False

　　GetStr=""

　　EndFunction

　　

　　PublicFunctionWriteIniTF(ByValIn_KeyAsString,ByValIn_DataAsBoolean)AsBoolean

　　OnErrorGoToWriteIniTFErr

　　WriteIniTF=True

　　IfIn_Data=TrueThen

　　WritePrivateProfileString"Setting",In_Key,"1",App.Path&"\SourceDB.ini"

　　Else

　　WritePrivateProfileString"Setting",In_Key,"0",App.Path&"\SourceDB.ini"

　　EndIf

　　ExitFunction

　　WriteIniTFErr:

　　Err.Clear

　　WriteIniTF=False

　　EndFunction

　　'以下两个函数,读/写ini文件,不固定节点,in_key为写入/读取的主键

　　'针对字符串值

　　'空值表示出错

　　PublicFunctionGetIniStr(ByValAppNameAsString,ByValIn_KeyAsString)AsString

　　OnErrorGoToGetIniStrErr

　　IfVBA.Trim(In_Key)=""Then

　　GoToGetIniStrErr

　　EndIf

　　DimGetStrAsString

　　GetStr=VBA.String(128,0)

　　GetPrivateProfileStringAppName,In_Key,"",GetStr,256,App.Path&"\SourceDB.ini"

　　GetStr=VBA.Replace(GetStr,VBA.Chr(0),"")

　　IfGetStr=""Then

　　GoToGetIniStrErr

　　Else

　　GetIniStr=GetStr

　　GetStr=""

　　EndIf

　　ExitFunction

　　GetIniStrErr:

　　Err.Clear

　　GetIniStr=""

　　GetStr=""

　　EndFunction

　　

　　PublicFunctionWriteIniStr(ByValAppNameAsString,ByValIn_KeyAsString,ByValIn_DataAsString)AsBoolean

　　OnErrorGoToWriteIniStrErr

　　WriteIniStr=True

　　IfVBA.Trim(In_Data)=""OrVBA.Trim(In_Key)=""OrVBA.Trim(AppName)=""Then

　　GoToWriteIniStrErr

　　Else

　　WritePrivateProfileStringAppName,In_Key,In_Data,App.Path&"\SourceDB.ini"

　　EndIf

　　ExitFunction

　　WriteIniStrErr:

　　Err.Clear

　　WriteIniStr=False

　　EndFunction

->

当接收到数据时，会发生DataArrival事件，调用DataArrival事件中的GetData方法就可以获得对方传送的数据

DimxStatus,tStatus,vServer,vHeader,vRsBody GetError=InputBox("请输入网站,例如:","请输入网址","") IfGetError=""Then MsgBox("输入错误，程序结束挖图教学这样，数据虽然驻留在远程数据源上，但在本地的microsoftjet数据库中可以存储与远程数据的永久性连接，同时缓存链接的表结构信息，从而在下一次访问该表时，不用再次从服务器中检索这些结构信息，加快了连接速度（注：不是所有电脑上都注册了Winsock组件）Utf8ToUnicode函数比较长就不贴出来了，以前的文章写过。