1 |
Attribute VB_Name = "Forwarding" |
2 |
' via: http://www.codeguru.com/forum/archive/index.php/t-22411.html |
3 |
|
4 |
Option Explicit |
5 |
|
6 |
Private Type MIB_IPFORWARDROW |
7 |
dwForwardDest As Long ' IP addr of destination |
8 |
dwForwardMask As Long ' subnetwork mask of destination |
9 |
dwForwardPolicy As Long ' conditions for multi-path route |
10 |
dwForwardNextHop As Long ' IP address of next hop |
11 |
dwForwardIfIndex As Long ' index of interface |
12 |
dwForwardType As Long ' route type |
13 |
dwForwardProto As Long ' protocol that generated route |
14 |
dwForwardAge As Long ' age of route |
15 |
dwForwardNextHopAS As Long ' autonomous system number |
16 |
dwForwardMetric1 As Long ' protocol-specific metric |
17 |
dwForwardMetric2 As Long ' protocol-specific metric |
18 |
dwForwardMetric3 As Long ' protocol-specific metric |
19 |
dwForwardMetric4 As Long ' protocol-specific metric |
20 |
dwForwardMetric5 As Long ' protocol-specific metric |
21 |
End Type |
22 |
|
23 |
Private Const PROTO_IP_NETMGMT = 3 |
24 |
Private Const ERROR_SUCCESS = 0 |
25 |
|
26 |
Private Declare Function CreateIpForwardEntry Lib "IPHLPAPI.DLL" (ByRef pRoute As Any) As Long |
27 |
Private Declare Function inet_addr Lib "wsock32" (ByVal s As String) As Long |
28 |
|
29 |
Public Function RouteAdd(ByVal sInterfaceIndex As Long, _ |
30 |
ByVal sForwardDestination As String, _ |
31 |
ByVal sForwardMask As String, _ |
32 |
ByVal sForwardNextHop As String) As Boolean |
33 |
|
34 |
Dim IPForwardTable As MIB_IPFORWARDROW |
35 |
|
36 |
With IPForwardTable |
37 |
|
38 |
'sForwardNextHop = "172.31.64.9" |
39 |
.dwForwardDest = inet_addr(sForwardDestination) |
40 |
'.dwForwardIfIndex = sInterfaceIndex |
41 |
.dwForwardIfIndex = 0 |
42 |
.dwForwardMask = inet_addr(sForwardMask) |
43 |
.dwForwardNextHop = inet_addr(sForwardNextHop) |
44 |
.dwForwardAge = 0 |
45 |
.dwForwardMetric1 = 50 |
46 |
|
47 |
' If MsgBox("Would you like the routing information to be permanent (otherwise the routing information is volatile and needs to be re-created every time you boot)?", vbYesNo, "Question") = vbYes Then |
48 |
' '.dwForwardProto = PROTO_IP_NT_STATIC |
49 |
' Else |
50 |
' .dwForwardProto = PROTO_IP_NETMGMT |
51 |
' End If |
52 |
.dwForwardProto = PROTO_IP_NETMGMT |
53 |
.dwForwardPolicy = 0 ' iphlpapi.h states unused (platform sdk july 2000) |
54 |
|
55 |
End With |
56 |
|
57 |
If CreateIpForwardEntry(IPForwardTable) = ERROR_SUCCESS Then |
58 |
MsgBox "Created route to host." |
59 |
Else |
60 |
MsgBox "Failed to create route!" |
61 |
End If |
62 |
|
63 |
End Function |
64 |
|