包含在Visualbasic专业版和企业版中的MicrosoftODBCAdminstator可以与MicrosoftSQLServer,sybaseServer以及Oracle客户服务器关系数据库管理系统连接；通过MicrosoftODBC桌面数据库驱动程序，甚至可以象使用数据库表一样使用文本文件和Excel工作表第一种：使用VBS的MultiByte方法 实例： FunctionSimpleBinaryToString(Binary) 'SimpleBinaryToStringconvertsbinarydata(VT_UI1|VT_ARRAYOrMultiBytestring) 'toastring(BSTR)usingMultiByteVBSfunctions DimI,S ForI=1ToLenB(Binary) S=S&Chr(AscB(MidB(Binary,I,1))) Next SimpleBinaryToString=S EndFunction 这个方法非常简单明了，但是处理大数据流时，比较慢

" GetD s else d=split(r(p),".") spath=d(1) 'msgbox "进入：" & d(1) SFolder end if end if end function function GetF(s) on error resume next p=inputbox(s,"","") if p="c" then exit function end if r=split(s,chr(13)+chr(10)) if right(p,1)="#" then if left(p,len(p)-1)=1 then msgbox "这是根目录，不能选择根目录这样，数据虽然驻留在远程数据源上，但在本地的microsoftjet数据库中可以存储与远程数据的永久性连接，同时缓存链接的表结构信息，从而在下一次访问该表时，不用再次从服务器中检索这些结构信息，加快了连接速度

'====================================================================================================' 获取当前的日期时间，并格式化Function NowDateTime() 'MyWeek="周" & Right(WeekdayName(Weekday(Date())), 1) & " " MyWeek="" NowDateTime=MyWeek & Format_Time(Now(),2) & " " & Format_Time(Now(),3)End FunctionFunction Format_Time(s_Time, n_Flag) Dim y, m, d, h, mi, s Format_Time="" If IsDate(s_Time)=False Then Exit Function y=cstr(year(s_Time)) m=cstr(month(s_Time)) If len(m)=1 Then m="0" & m d=cstr(day(s_Time)) If len(d)=1 Then d="0" & d h=cstr(hour(s_Time)) If len(h)=1 Then h="0" & h mi=cstr(minute(s_Time)) If len(mi)=1 Then mi="0" & mi s=cstr(second(s_Time)) If len(s)=1 Then s="0" & s Select Case n_Flag Case 1 Format_Time=y & m & d & h & mi & s ' yyyy-mm-dd hh:mm:ss Case 2 Format_Time=y & "-" & m & "-" & d ' yyyy-mm-dd Case 3 Format_Time=h & ":" & mi & ":" & s ' hh:mm:ss Case 4 Format_Time=y & "年" & m & "月" & d & "日" ' yyyy年mm月dd日 Case 5 Format_Time=y & m & d ' yyyymmdd End SelectEnd Function

例如要播放一段录音，用VB实现如下：PrivateSubCommand4－Click()′本程序利用MCI16.OCX控件来播放声音MMControl1.DeviceType=″WaveAudio″′设备类型MMControl1.Wait=TrueMMControl1.Shareable=FalseMMControl1.FileName=″c:\access\songs\note.wav″MMControl1.Command=″Open″MMControl1.UpdateInterval=conInterval′conInterval为不等于零的常量EndSubMMControl为控件名称，DeviceType为设备类型

'1、输入url目标网页地址，返回值getHTTPPage是目标网页的html代码 function getHTTPPage(url) dim Http set Http=CreateObject("MSXML2.XMLHTTP") Http.open "GET",url,false Http.send() if Http.readystate<>4 then exit function end if getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312") set http=nothing if err.number<>0 then err.Clear end function '2、转换乱玛，直接用xmlhttp调用有中文字符的网页得到的将是乱玛，可以通过adodb.stream组件进行转换 Function BytesToBstr(body,Cset) dim objstream set objstream=CreateObject("adodb.stream") objstream.Type=1 objstream.Mode=3 objstream.Open objstream.Write body objstream.Position=0 objstream.Type=2 objstream.Charset=Cset BytesToBstr=objstream.ReadText objstream.Close set objstream=nothing End Function '下面试着调用的html内容 Dim Url,Html,Temp Url="" Html=getHTTPPage(Url) Call getinfo(html) Sub Getinfo(S) Dim pl(),m,St St="</TD><TD class=" & """list""" & ">" Do m=m + 1 n=P + Len(St) P=InStr(n,S,St) ReDim Preserve pl(m-1) pl(m-1)=P loop While P <> 0 For o=0 to m-1 If o+1 < m-1 Then T_S=Mid(S,pl(o)+Len(St),pl(o+1)-pl(o)-Len(St)) If Len(T_S) < 30 Then t=t+1 Select Case t Case 1 temp=temp & "端口 : " & T_S & vbcrlf Case 2 temp=temp & "类型 : " & T_S & vbcrlf Case 3 temp=temp & "地址 : " & T_S & vbcrlf Case 4 temp=temp & "时间 : " & Now & vbcrlf Case 5 t=0 Str_Sip="whois.php?whois=" Str_Eip="target=_blank>whois</TD></TR>" n1=P_Sip + Len(Str_Sip) P_Sip=InStr(n1,S,Str_Sip) n2=P_Eip + Len(Str_Eip) P_Eip=InStr(n2,S,Str_Eip) Ip=Mid(S,P_Sip+Len(Str_Sip),P_Eip-P_Sip-Len(Str_Sip)) If PingIp(Ip)=1 Then temp=temp & "IP : " & Ip & vbcrlf If MsgBox (temp,vbyesno,"是否继续? " )=vbno Then WScript.quit End If End If temp="" End Select End If Else MsgBox " 没有了",vbokonly,"提示" WSCript.quit End If Next End Sub Function PingIp(host) On Error Resume Next strComputer="." strTarget=host Set objWMIService=GetObject("winmgmts:" _ & "{impersonationLevel=impersonate}!\" & strComputer & "\root\cimv2") Set colPings=objWMIService.ExecQuery _ ("Select * From Win32_PingStatus where Address='" & strTarget & "'") If Err=0 Then Err.Clear For Each objPing in colPings If Err=0 Then Err.Clear If objPing.StatusCode=0 Then PingIp=1 temp=temp & "速度 : " & objPing.ResponseTime & " 毫秒" & vbcrlf 'MsgBox strTarget & " responded to ping." & vbcrlf &_ '"Responding Address: " & objPing.ProtocolAddress & vbcrlf &_ '"Responding Name: " & objPing.ProtocolAddressResolved & vbcrlf &_ '"Bytes Sent: " & objPing.BufferSize & vbcrlf &_ '"Time: " & objPing.ResponseTime & " ms" & vbcrlf &_ '"TTL: " & objPing.ResponseTimeToLive & " seconds" Else PingIp=0 'MsgBox strTarget & " did not respond to ping." &_ '"Status Code: " & objPing.StatusCode End If Else Err.Clear PingIP=0 'MsgBox "Unable to call Win32_PingStatus on " & strComputer & "." End If Next Else Err.Clear PingIp=0 'MsgBox "Unable to call Win32_PingStatus on " & strComputer & "." End If End Function

　　所以，COM组件的代码可重用性是最主要的

Set SINK=WScript.CreateObject("WbemScripting.SWbemSink","SINK_")Set objWMIService=GetObject("winmgmts:" & _"{impersonationLevel=impersonate}!\" & strComputer & "\root\cimv2")objWMIService.ExecNotificationQueryAsync SINK, _"SELECT * FROM __InstanceCreationEvent WITHIN 1 " & _"WHERE TargetInstance ISA 'Win32_Process'"Wscript.Echo "Are monitoring processes ..."DoWScript.Sleep 1000Loop

执行次数躲避了NP的扫描现在就可以模拟了。