Private Type NETRESOURCE
lngScope As Long 'To Specify scope during enumeration.
lngType As Long 'Defines the type of Resource.
lngDisplayType As Long 'How resources will be displayed
lngUsage As Long 'Specifies the Resource usage.
strLocalName As String 'Local Device for the connection
strRemoteName As String 'Indicates the Network Resource
strComment As String 'For a Provider-Supplied Comment.
strProvider As String 'Name of Provider who owns theresource.
End Type
Const RESOURCETYPE_ANY = &H0 'These are some useful
Const RESOURCETYPE_DISK = &H1 'Constants to be used
Const RESOURCETYPE_PRINT = &H2 'with many of the WNet
Const RESOURCETYPE_UNKNOWN = &HFFFF 'Functions.
Const CONNECT_UPDATE_PROFILE = &H1
Public srvr As String
Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As _
NETRESOURCE, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long
Private Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias _
"WNetCancelConnection2A" (ByVal lpName As String, _
ByVal dwFlags As Long, ByVal fForce As Long) As Long
Private Type TIME_OF_DAY_INFO
tod_elapsedt As Long
tod_msecs As Long
tod_hours As Long
tod_mins As Long
tod_secs As Long
tod_hunds As Long
tod_timezone As Long
tod_tinterval As Long
tod_day As Long
tod_month As Long
tod_year As Long
tod_weekday As Long
End Type
Private ti As TIME_OF_DAY_INFO
Private Type HiLoInt
loInt As Integer
hiInt As Integer
End Type
Dim TwoInt As HiLoInt
Private Type LongType
l As Long
End Type
Dim lLong As LongType
Private Declare Function NetRemoteTOD Lib "netapi32.dll" (ServerName As Any, buffer As Any) As Long
Private Declare Function DataFromPtr Lib "kernel32" Alias "lstrcpynW" (RetVal As Any, ByVal Ptr As Long, ByVal nCharCount As Long) As Long
Private Declare Function NetAPIBufferFree Lib "netapi32.dll" Alias "NetApiBufferFree" (ByVal Ptr As Long) As Long
Private Sub Connect_Up(srvpath As String, username As String)
Dim ServerText As String, PassWordText As String
Dim DriveLetter As String
Dim Msg As String
Dim Succeed As Long
On Error GoTo Err_Error
Dim nrConnect As NETRESOURCE 'Get NETRESOURCE var.
nrConnect.lngType = RESOURCETYPE_DISK 'Set Resource Type.
nrConnect.strLocalName = "" 'Get Drive Letter
nrConnect.strRemoteName = UCase$(srvpath) 'Path to resource
nrConnect.strProvider = "" 'Unknown Provider.
PassWordText = "password" 'A Text Box for the PassWord
srvr = nrConnect.strRemoteName
Succeed = WNetAddConnection2(nrConnect, PassWordText, username, 0)
Exit Sub
Err_Error:
MsgBox "Error: " & Err.Description & "(" & srvpath & " " & username & ")"
End Sub
Private Sub Command1_Click()
Dim Failed As Boolean
Dim sName As String
Dim pbServer() As Byte
Dim ptmpBuffer As Long
Dim lRetVal As Long
Start:
'Set the NT server name
sName = "\\GNIFS01"
'Convert the name to a Unicode byte array
pbServer = sName & vbNullChar
'Call the NetRemoteTOD function
lRetVal = NetRemoteTOD(pbServer(0), ptmpBuffer)
If lRetVal <> 0 Then
MsgBox "Failed"
If Failed = False Then
Connect_Up sName, "MY_DOMAIN\myuser"
Failed = True
GoTo Start
End If
Failed = True
'Function failed
Exit Sub
End If
'Extract the information into a TIME_OF_DAY_INFO structure
'Get first element of the structure
lRetVal = DataFromPtr(ti.tod_elapsedt, ptmpBuffer, 4)
'Get second element of the structure
lRetVal = DataFromPtr(ti.tod_msecs, ptmpBuffer + 4, 4)
'Get third element of the structure
lRetVal = DataFromPtr(ti.tod_hours, ptmpBuffer + 8, 4)
'....
lRetVal = DataFromPtr(ti.tod_mins, ptmpBuffer + 12, 4)
lRetVal = DataFromPtr(ti.tod_secs, ptmpBuffer + 16, 4)
lRetVal = DataFromPtr(ti.tod_hunds, ptmpBuffer + 20, 4)
lRetVal = DataFromPtr(ti.tod_timezone, ptmpBuffer + 24, 4)
lRetVal = DataFromPtr(ti.tod_tinterval, ptmpBuffer + 28, 4)
lRetVal = DataFromPtr(ti.tod_day, ptmpBuffer + 32, 4)
lRetVal = DataFromPtr(ti.tod_month, ptmpBuffer + 36, 4)
lRetVal = DataFromPtr(ti.tod_year, ptmpBuffer + 40, 4)
'Get last element of the structure
lRetVal = DataFromPtr(ti.tod_weekday, ptmpBuffer + 44, 4)
'Convert to local time
If ti.tod_timezone <> -1 Then
ti.tod_hours = ti.tod_hours - ti.tod_timezone \ 60
End If
If ti.tod_hours = 24 Then ti.tod_hours = 0
'Release the memory, allocated by NetRemoteTOD function
NetAPIBufferFree ptmpBuffer
MsgBox ti.tod_hours & ":" & ti.tod_mins
Cancel_Connected
End Sub
Private Sub Cancel_Connected()
On Error GoTo Err_ErrorHandler
Dim ErrInfo As Long
ErrInfo = WNetCancelConnection2(srvr, CONNECT_UPDATE_PROFILE, False)
MsgBox "Net Disconnection Successful!", vbInformation, _
"Share Disconnected"
Exit Sub
Err_ErrorHandler:
MsgBox "ERROR: " & ErrInfo & " - Net Disconnection Failed!", _
vbExclamation, "Share not Disconnected"
End Sub
