夕阳醉了's Blog

Windows Registry Editor Version 5.00

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

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

set adocon=Server.Createobject("adodb.connection")
adoconn.Open"Driver={Microsoft Access Driver(*.mdb)};DBQ="& _
Server.MapPath("数据库所在路径")