พฤษภาคม 27, 2020, 09:41:47 AM *
ยินดีต้อนรับคุณ, บุคคลไม่รู้ว่าใคร กรุณา เข้าสู่ระบบ หรือ ลงทะเบียน

เข้าสู่ระบบด้วยชื่อผู้ใช้ รหัสผ่าน และระยะเวลาในเซสชั่น
หน้า: [1]   ลงล่าง
  พิมพ์  
[มุม VB6 part 2] ทำอย่างไรเมื่อเขียนโปรแกรม ค้นหา  (อ่าน 2035 ครั้ง)
DavidTh30
มกราคม 07, 2010, 01:10:13 AM
ผลงาน: 0
DavidTh30
บุคคลไม่รู้ว่าใคร
« เมื่อ: มกราคม 07, 2010, 01:10:13 AM »
[มุม VB6 part 2]
 ทำอย่างไรเมื่อเขียนโปรแกรมด้วย Visual Basic 6 ค้นหา  IP Address
โดยไม่ต้องใช้ API และไม่ต้องโหลด Component OCX


จริงๆแล้ว ใช้คำสั่ง Shell start ipconfig >> c:\ MyIP.txt ก็ได้แต่นั้น เราจะไม่รู้วิธีการเข้าถึงข้อมูล IP Address
วิธีที่ผมใช้ก็คือ GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
                   GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
ด้วยวิธีนี้เราจะรู้ข้อมูลทั้งหมดในระบบ IP Address และจะได้นำวิธีนี้ไปเขียนโปรแกรมในบทต่อไป

ขั้นตอนที่ 1 สร้างตัวแปรและตัวแปรมาตรฐาน
Const HKEY_LOCAL_MACHINE = &H80000002
Dim strComputer, strKeyPath1, strKeyPath2, strHostEntry, strDomain
Dim strHostname, strDomainEntry, strNodeEntry, strRoutingEntry
Dim strIPRouting, objWMIService, colFirstNicConfig, objFirstNicConfig
Dim strDnsWins, strWinsProxy, sngOsVer, objNicConfig, strAdapterType
Dim objReg, dwNodeType, colNicConfigs, strNetConn, ObjNic, strNodeType
Dim IntIndex, strIPAddresses, strIPSubnets, strDefaultIPGateways
Dim colOperatingSystems, objOperatingSystem, dwIPRouting, strDNSServer
Dim strIPAddress, strIPSubnet, strDefaultIPGateway, strDNSServerSearchOrder
Dim dtmRawLeaseObtainedDate, strFormattedLeaseObtainedDate, dtmRawLeaseExpiresDate
Dim strFormattedLeaseExpiresDate


strComputer = "."
strKeyPath1 = "SYSTEM\CurrentControlSet\Services\Tcpip\Parameters"
strKeyPath2 = "SYSTEM\CurrentControlSet\Services\NetBT\Parameters"
strHostEntry = "Hostname"
strDomainEntry = "Domain"
strNodeEntry = "DhcpNodeType"
strRoutingEntry = "IPEnableRouter"


ขั้นตอนที่ 2 สร้าง Function แปลงวันที่เป็นตัวอักษร และ อ่านค่ารุ่นของ Windows
Function WMIDateToString(dtmDate) As String
    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


Function GetOsVer()
  Set colOperatingSystems = objWMIService.ExecQuery _
   ("Select * from Win32_OperatingSystem")
  For Each objOperatingSystem In colOperatingSystems
    GetOsVer = CSng(Left(objOperatingSystem.Version, 3))
  Next
End Function


ขั้นตอนที่ 3 สร้าง Object
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
 strComputer & "\root\default:StdRegProv")
Set objWMIService = GetObject("winmgmts:" _
 & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

 
ขั้นตอนที่ 4 อ่าน Parameter Properties
Windows IP Configuration
Loop Ethernet Connection

ตัวอย่าง
เมื่อกดปุ่ม Command1 แล้วจะเห็น Windows IP Configuration และ Ethernet Connection ทั้งหมดใน Textbox

ข้อควรระวัง
-

โปรแกรมที่เขียน VisualBasic6
อุปกรณ์ Source Code ที่ใช้คือ   
1. Command Button
ชื่อ                   Command1
Events ที่ใช้คือ  Private Sub Command1_Click()

2. Text Box
ชื่อ                   Text1
Events ที่ใช้ -
BlackColor = &H00000000&
ForeColor = &H00000000&
MultiLine = True
ScrollBar = Both



[Source Code เต็ม]

Option Explicit

Const HKEY_LOCAL_MACHINE = &H80000002
Dim strComputer, strKeyPath1, strKeyPath2, strHostEntry, strDomain
Dim strHostname, strDomainEntry, strNodeEntry, strRoutingEntry
Dim strIPRouting, objWMIService, colFirstNicConfig, objFirstNicConfig
Dim strDnsWins, strWinsProxy, sngOsVer, objNicConfig, strAdapterType
Dim objReg, dwNodeType, colNicConfigs, strNetConn, ObjNic, strNodeType
Dim IntIndex, strIPAddresses, strIPSubnets, strDefaultIPGateways
Dim colOperatingSystems, objOperatingSystem, dwIPRouting, strDNSServer
Dim strIPAddress, strIPSubnet, strDefaultIPGateway, strDNSServerSearchOrder
Dim dtmRawLeaseObtainedDate, strFormattedLeaseObtainedDate, dtmRawLeaseExpiresDate
Dim strFormattedLeaseExpiresDate
Private Sub Command1_Click()
On Error Resume Next


strComputer = "."
strKeyPath1 = "SYSTEM\CurrentControlSet\Services\Tcpip\Parameters"
strKeyPath2 = "SYSTEM\CurrentControlSet\Services\NetBT\Parameters"
strHostEntry = "Hostname"
strDomainEntry = "Domain"
strNodeEntry = "DhcpNodeType"
strRoutingEntry = "IPEnableRouter"
 
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
 strComputer & "\root\default:StdRegProv")
objReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath1, strHostEntry, strHostname
objReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath1, strDomainEntry, strDomain
objReg.GetDWORDValue HKEY_LOCAL_MACHINE, strKeyPath2, strNodeEntry, dwNodeType
objReg.GetDWORDValue HKEY_LOCAL_MACHINE, strKeyPath1, strRoutingEntry, dwIPRouting
 
If dwNodeType = 4 Then strNodeType = "Mixed"
If dwNodeType = 8 Then strNodeType = "Hybrid"
If dwNodeType <> 8 And dwNodeType <> 4 Then strNodeType = dwNodeType

If dwIPRouting = 0 Then
  strIPRouting = "No"
ElseIf dwIPRouting = 1 Then
  strIPRouting = "Yes"
Else
  strIPRouting = "?"
End If
 
strComputer = "."

Set objWMIService = GetObject("winmgmts:" _
 & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
 
Set colFirstNicConfig = objWMIService.ExecQuery _
 ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
For Each objFirstNicConfig In colFirstNicConfig
  strDnsWins = objFirstNicConfig.DNSEnabledForWINSResolution
Next
If strDnsWins = False Then
  strWinsProxy = "No"
ElseIf strDnsWins = True Then
  strWinsProxy = "Yes"
Else
  strWinsProxy = "?"
End If
 
Text1.Text = "Windows IP Configuration"
Text1.Text = Text1.Text & vbCrLf & "        Host Name . . . . . . . . . . . . : " & strHostname
Text1.Text = Text1.Text & vbCrLf & "        Primary DNS Suffix  . . . . . . . : " & strDomain
Text1.Text = Text1.Text & vbCrLf & "        Node Type . . . . . . . . . . . . : " & strNodeType
Text1.Text = Text1.Text & vbCrLf & "        IP Routing Enabled. . . . . . . . : " & strIPRouting
Text1.Text = Text1.Text & vbCrLf & "        WINS Proxy Enabled. . . . . . . . : " & strWinsProxy
Text1.Text = Text1.Text & vbCrLf & "        DNS Suffix Search List. . . . . . : " & strDomain & vbCrLf

Set colNicConfigs = objWMIService.ExecQuery _
  ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
sngOsVer = GetOsVer

 
For Each objNicConfig In colNicConfigs
  IntIndex = objNicConfig.Index
  Set ObjNic = objWMIService.Get("Win32_NetworkAdapter.DeviceID=" & IntIndex)
 
  strAdapterType = ObjNic.AdapterType
  If IsEmpty(strAdapterType) Or IsNull(strAdapterType) Or _
   (strAdapterType = "") Then
    strAdapterType = "Network"
  End If
 
  If sngOsVer > 5 Then
    strNetConn = ObjNic.NetConnectionID
  Else
    strNetConn = IntIndex
  End If
 
Text1.Text = Text1.Text & vbCrLf & strAdapterType & " adapter " & strNetConn
Text1.Text = Text1.Text & vbCrLf & "        Connection-specific DNS Suffix  . : " & _
   objNicConfig.DNSDomain
Text1.Text = Text1.Text & vbCrLf & "        Description . . . . . . . . . . . : " & _
   objNicConfig.Description
Text1.Text = Text1.Text & vbCrLf & "        Physical Address. . . . . . . . . : " & _
   objNicConfig.MACAddress
Text1.Text = Text1.Text & vbCrLf & "        DHCP Enabled. . . . . . . . . . . : " & _
   objNicConfig.DHCPEnabled & vbCrLf
'Text1.Text = Text1.Text & vbCrLf &  "        Autoconfiguration Enabled . . . .: " & objNicConfig.? & vbCrLf
 
    strIPAddresses = ""
  If Not IsNull(objNicConfig.IPAddress) Then
    For Each strIPAddress In objNicConfig.IPAddress
      strIPAddresses = strIPAddresses & strIPAddress & " "
    Next
  End If
Text1.Text = Text1.Text & vbCrLf & "        IP Address. . . . . . . . . . . . : " & strIPAddresses
  strIPSubnets = ""
  If Not IsNull(objNicConfig.IPSubnet) Then
    For Each strIPSubnet In objNicConfig.IPSubnet
      strIPSubnets = strIPSubnets & strIPSubnet & " "
    Next
  End If
Text1.Text = Text1.Text & vbCrLf & "        Subnet Mask . . . . . . . . . . . : " & strIPSubnets
  strDefaultIPGateways = ""
  If Not IsNull(objNicConfig.DefaultIPGateway) Then
    For Each strDefaultIPGateway In objNicConfig.DefaultIPGateway
      strDefaultIPGateways = strDefaultIPGateways & strDefaultIPGateway & " "
    Next
  End If
Text1.Text = Text1.Text & vbCrLf & "        Default Gateway . . . . . . . . . : " & _
   strDefaultIPGateways
Text1.Text = Text1.Text & vbCrLf & "        DHCP Server . . . . . . . . . . . : " & _
   objNicConfig.DHCPServer
  strDNSServerSearchOrder = ""
  If Not IsNull(objNicConfig.DNSServerSearchOrder) Then
    For Each strDNSServer In objNicConfig.DNSServerSearchOrder
      strDNSServerSearchOrder = strDNSServerSearchOrder & vbCrLf & _
      "                                            " & strDNSServer
    Next
  End If
Text1.Text = Text1.Text & vbCrLf & "        DNS Servers . . . . . . . . . . . :" & _
   strDNSServerSearchOrder
  If Not IsNull(objNicConfig.WINSPrimaryServer) Then
Text1.Text = Text1.Text & vbCrLf & "        Primary WINS Server . . . . . . . : " & _
     objNicConfig.WINSPrimaryServer & vbCrLf
  End If
  If Not IsNull(objNicConfig.WINSSecondaryServer) Then
Text1.Text = Text1.Text & vbCrLf & "        Secondary WINS Server . . . . . . : " & _
     objNicConfig.WINSSecondaryServer & vbCrLf
  End If
  If objNicConfig.DHCPEnabled Then
    dtmRawLeaseObtainedDate = objNicConfig.DHCPLeaseObtained
    strFormattedLeaseObtainedDate = WMIDateToString(dtmRawLeaseObtainedDate)
Text1.Text = Text1.Text & vbCrLf & "        Lease Obtained. . . . . . . . . . : " & _
     strFormattedLeaseObtainedDate
    dtmRawLeaseExpiresDate = objNicConfig.DHCPLeaseExpires
    strFormattedLeaseExpiresDate = WMIDateToString(dtmRawLeaseExpiresDate)
Text1.Text = Text1.Text & vbCrLf & "        Lease Expires . . . . . . . . . . : " & _
    strFormattedLeaseExpiresDate & vbCrLf
  End If
Next
End Sub

Function WMIDateToString(dtmDate) As String
    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
 
Function GetOsVer()
  Set colOperatingSystems = objWMIService.ExecQuery _
   ("Select * from Win32_OperatingSystem")
  For Each objOperatingSystem In colOperatingSystems
    GetOsVer = CSng(Left(objOperatingSystem.Version, 3))
  Next
End Function


**** หมายเหตุ ****
-ตัวอย่างที่ให้ทดลองบน Windows XP แล้วปลอดภัย ไม่ทำให้เสียหายแต่อย่างได 1000000%
-ตัวอย่างที่ให้ อาจใช้งานได้ตั้งแต่ Windows 2000 ขึ้นไป (ไม่แน่ใจ)
-Source Code สามารถใช้งานที่ Microsoft Word, Excel, PowerPoint, VBS, VB.Net, HTML, XML, ASP, ASP.Net ได้ด้วย
-ขอความกรุณาผู้อ่าน ทดลองใช้งานตาม Windows อื่นๆ และตอบกระทู้กลับมาด้วยครับ ที่ Folder [TestRun]


-------------------------------------------------------------------------------------------------------------------------------------------------
Source Code และตัวอย่างอยู่ที่ IPaddress.zip
โปรแกรมเปิด Source Code อยู่ที่ Portable_Visual__Basic_6.zip

IPaddress.zip

-------------------------------------------------------------------------------------------------------------------------------------------------

[link]
[มุม VB6 part 1] http://www.art2bempire.com/board/index.php?topic=128014.0
[มุม VB6 part 2] http://www.art2bempire.com/board/index.php?topic=128016.0
[มุม VB6 part 3] http://www.art2bempire.com/board/index.php?topic=128017.0
[มุมVB6 ตอน Bat To Exe (1)]  http://www.art2bempire.com/board/index.php?topic=128015.0

                                                                                      อ้างอิง >>http://technet.microsoft.com/en-us/library/ee692585.aspx<< 
                                                                                               >>ถ้ามีข้อสงสัยหลือช่วยแก้ไข Project ก็ ตอบกระทู้มาเลยครับ<<   
                                                                                                             :z06: :z06: :z06: :z06: :z06:
หน้า: [1]   ขึ้นบน
  พิมพ์  
 
กระโดดไป:  

Powered by MySQL Powered by PHP Valid XHTML 1.0! Valid CSS!