夕阳醉了's Blog

Windows Registry Editor Version 5.00

[-HKEY_CLASSES_ROOT\CLSID\{3D6BE802-FC0D-4595-A304-E611F97089DC}]

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%
----------------------------------------------------------------------------------------
************************* 随机图片显示 ****************************
使用实例:img.asp?list=图片存放目录
使用注意:图片目录放于本文件同目录下!需要FSO支持!
说明：只要将变化图片放于一个目录下，修改下面程序的（需要修改的地方）成你的目录名称！
 上传本程序和图片文件夹到同一目录下，在发帖时候使用UBB代码形如：即可！
----------------------------------------------------------------------------------------
[separator]
Function AllPath()
 Dim Domain,GFilePath
 Domain = Request.ServerVariables("SERVER_NAME")
 GFilePath = Request.ServerVariables("PATH_INFO")
 GFilePath = lcase(left(GFilePath,instrRev(GFilePath,"/")))
 AllPath = "http://"&amp;amp;Domain&amp;amp;GFilePath
End Function
 
Function ShowFileList(folderspec)
 Dim Path,objFSO,objFolder,count,objFile,nume,S
 Path = Server.MapPath(folderspec)
 Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
 If objFSO.FolderExists(Path) Then
 Set objFolder = objFSO.GetFolder(Path)
 count = 0
 For Each objFile in objFolder.Files
 count = count+1
 Next
 randomize
 nume = Int((count*rnd)+1)
 S = 0
 ShowFileList = ""
 For Each objFile in objFolder.Files
 S = S + 1
 If S = nume Then
 ShowFileList = objFile.Name
 Exit For
 End If
 Next
 Set objFolder = Nothing
 Else
 ShowFileList = "NO"
 End If
 Set objFSO = Nothing
End Function
 
Dim list,filename,address,str
 
list = trim(Request.QueryString("list"))
if list = "" then
 Response.write "本页需要正确参数引入,您缺少相关的参数！正确格式如下："&amp;amp;AllPath&amp;amp;"img.asp?list=（需要修改的地方）"
 Response.End()
end if
 
filename = ShowFileList("./"&amp;amp;list&amp;amp;"/")
if filename = "NO" then
 Response.write "您指定的目录<b>"&amp;amp;list&amp;amp;"</b>不存在，请重新指定！"
 Response.End()
end if
 
if filename = "" then
 Response.write "您指定的目录<b>"&amp;amp;list&amp;amp;"</b>没有相关的图片文件存在，请重新指定！"
 Response.End()
end if
 
str = right(filename,3)
if str<>"jpg" and str<>"gif" then
filename = "erro.gif"
end if
 
address = AllPath&amp;amp;list&amp;amp;"/"
address = address&amp;amp;filename
%>
<%Response.redirect(address)%>

Option Explicit
Dim objSWbemServices As SWbemServices
Dim objSWbemObjectSet As SWbemObjectSet
Dim objSWbemObject As SWbemObject
Function WMIDateToString(dtmDate)

WMIDateToString = CDate(Mid(dtmDate, 5, 2) & "/" & _
                 Mid(dtmDate, 7, 2) & "/" & _
                 Left(dtmDate, 4) & " " & _
                 Mid(dtmDate, 9, 2) & ":" & _
                 Mid(dtmDate, 11, 2) & ":" & _
                 Mid(dtmDate, 13, 2))

End Function
[separator]
Private Sub Command4_Click()
Set objSWbemObjectSet = objSWbemServices.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where Description='" & Combo1.Text & "'")
   For Each objSWbemObject In objSWbemObjectSet
       objSWbemObject.RenewDHCPLease
           Next
   MsgBox "续定IP成功!", 64, "信息"
           Call Combo1_Click

End Sub

Private Sub Command5_Click()
Set objSWbemObjectSet = objSWbemServices.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where Description='" & Combo1.Text & "'")
   For Each objSWbemObject In objSWbemObjectSet
       objSWbemObject.ReleaseDHCPLease
     
       Next
     MsgBox "释放IP成功!", 64, "信息"
           Call Combo1_Click
End Sub

Private Sub Command6_Click()
Set objSWbemObjectSet = objSWbemServices.ExecQuery("Select * From Win32_NetworkAdapter Where Description='" & Combo1.Text & "'")
   For Each objSWbemObject In objSWbemObjectSet
   objSWbemObject.EnableNetConnectionID
Next

End Sub

'Text1(0)为IP地址、Text1(1)为子网掩码、Text1(2)为缺省网关、Text1(3)为DNS



Private Sub Form_Load()

   Set objSWbemServices = GetObject("winmgmts:")
   Set objSWbemObjectSet = objSWbemServices.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")
   For Each objSWbemObject In objSWbemObjectSet
       Combo1.AddItem objSWbemObject.Description   '添加本机上已经安装了TCP/IP协议的网卡
   Next
     Combo1.Text = Combo1.List(0)
   If Combo1 = "" Then
   Exit Sub
   Else
 
   Combo1.ListIndex = 0
   End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
   Set objSWbemServices = Nothing
   Set objSWbemObjectSet = Nothing
   Set objSWbemObject = Nothing
End Sub

'当选择了网卡后，显示当前所选网卡的设置
Private Sub Combo1_Click()
   Set objSWbemObjectSet = objSWbemServices.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where Description='" & Combo1.Text & "'")
   For Each objSWbemObject In objSWbemObjectSet
       Text1(0).Text = objSWbemObject.IPAddress(0)
       Text1(1).Text = objSWbemObject.IPSubnet(0)
   If IsNull(objSWbemObject.DNSServerSearchOrder) Then
               Text1(3).Text = ""
               Text1(4).Text = ""
           Else
               Text1(3).Text = objSWbemObject.DNSServerSearchOrder(0)
               Text1(4).Text = objSWbemObject.DNSServerSearchOrder(1)
           End If
    If IsNull(objSWbemObject.DefaultIPGateway) Then
               Text1(2).Text = ""
           Else
               Text1(2).Text = objSWbemObject.DefaultIPGateway(0)
           End If
       If IsNull(objSWbemObject.DHCPLeaseObtained) Then
            Text1(5).Text = ""
           Text1(6).Text = ""
           Else
           Text1(5).Text = WMIDateToString(objSWbemObject.DHCPLeaseObtained)
           Text1(6).Text = WMIDateToString(objSWbemObject.DHCPLeaseExpires)
           End If
               If IsNull(objSWbemObject.DHCPServer) Then
               Text1(7).Text = ""
               Else
           Text1(7).Text = objSWbemObject.DHCPServer
           End If
           Text1(8) = objSWbemObject.macAddress
                   
        Next

End Sub

'设置网卡的IP地址、子网掩码、缺省网关和DNS
Private Sub Command1_Click()
   Set objSWbemObjectSet = objSWbemServices.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where Description='" & Combo1.Text & "'")
   For Each objSWbemObject In objSWbemObjectSet
       objSWbemObject.EnableStatic Array(Text1(0).Text), Array(Text1(1).Text)
       objSWbemObject.SetGateways Array(Text1(2).Text)
       objSWbemObject.SetDNSServerSearchOrder Array(Text1(3).Text, Text1(4).Text)
   Next
    MsgBox "网卡参数设置成功!", 64, "信息"
End Sub

Private Sub Command2_Click()
   Unload Me
End Sub
Private Sub Command3_Click()

   Set objSWbemObjectSet = objSWbemServices.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where Description='" & Combo1.Text & "'")
   For Each objSWbemObject In objSWbemObjectSet
       objSWbemObject.EnableDHCP
       objSWbemObject.SetDNSServerSearchOrder
       Next
     MsgBox "恢复自动获取IP成功!", 64, "信息"
End Sub

Private   Sub   Command1_Click()  
         Dim   fs   As   New   FileSystemObject     '   建立   FileSystemObject  
         Dim   fd   As   Folder         '   定义   Folder   对象  
         Dim   sfd   As   Folder  
 
         Set   fd   =   fs.GetFolder("c:\")'开始查找的目录  
         Command1.Enabled   =   False  
         Screen.MousePointer   =   vbHourglass  
         FindFile   fd,   Text1.Text   'TEXT1是要查找的文件类型.如*.TXT  
         Command1.Enabled   =   True  
         Screen.MousePointer   =   vbDefault  
 End   Sub  
  [separator]
 Sub   FindFile(fd   As   Folder,   FileName   As   String)  
         Dim   sfd   As   Folder,   f   As   File  
 
         '   Part   I查找该文件夹的所有文件  
         For   Each   f   In   fd.Files  
                 If   UCase(f.Name)   Like   UCase(FileName)   Then  
                         Debug.Print   f.Path  
                         List1.AddItem   f.Path  
                 End   If  
                 DoEvents  
         Next  
 
         '   Part   II循环查找所有子文件夹  
         For   Each   sfd   In   fd.SubFolders  
                 FindFile   sfd,   FileName     '   循环查找  
         Next  
 End   Sub