home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / code / network / vbnets / cti-nets.bas next >
BASIC Source File  |  1994-10-11  |  16KB  |  381 lines
  1. Option Explicit
  2.  
  3. ' Copyright ⌐ 1993, 1994 by Computer Technologies, Inc. All rights reserved.
  4.  
  5. Declare Function WNetGetConnection Lib "User" (ByVal LocalDev As String, ByVal rmtname As String, buffsize As Integer) As Integer
  6. Declare Function WNetAddConnection Lib "User" (ByVal NetPath As String, ByVal PassWord As String, ByVal LocalDev As String) As Integer
  7. Declare Function WNetCancelConnection Lib "User" (ByVal LocalDev As String, ByVal Force As Integer) As Integer
  8. Declare Function WNetGetUser Lib "User" (ByVal szUser As String, lpnBufferSize As Integer) As Integer
  9. Declare Function WNetGetCaps Lib "User" (ByVal nFlags As Integer) As Integer
  10. Declare Function MNetNetworkEnum Lib "WFWNET.DRV" (lpnSubnet As Integer) As Integer
  11. Declare Function MNetSetNextTarget Lib "WFWNET.DRV" (ByVal lpnSubnet As Integer) As Integer
  12.  
  13. Global Const WN_SUCCESS = &H0
  14. Global Const WN_NOT_SUPPORTED = &H1
  15. Global Const WN_NET_ERROR = &H2
  16. Global Const WN_MORE_DATA = &H3
  17. Global Const WN_BAD_POINTER = &H4
  18. Global Const WN_BAD_VALUE = &H5
  19. Global Const WN_BAD_PASSWORD = &H6
  20. Global Const WN_ACCESS_DENIED = &H7
  21. Global Const WN_FUNCTION_BUSY = &H8
  22. Global Const WN_WINDOWS_ERROR = &H9
  23. Global Const WN_BAD_USER = &HA
  24. Global Const WN_OUT_OF_MEMORY = &HB
  25. Global Const WN_CANCEL = &HC
  26. Global Const WN_CONTINUE = &HD
  27. Global Const WN_NOT_CONNECTED = &H30
  28. Global Const WN_OPEN_FILES = &H31
  29. Global Const WN_BAD_NETNAME = &H32
  30. Global Const WN_BAD_LOCALNAME = &H33
  31. Global Const WN_ALREADY_CONNECTED = &H34
  32. Global Const WN_DEVICE_ERROR = &H35
  33. Global Const WN_CONNECTION_CLOSED = &H36
  34.  
  35. ' Open file handling constants
  36. Global Const NET_OPENDISALLOW = 1
  37. Global Const NET_OPENQUERY = 2
  38. Global Const NET_OPENIGNORE = 3
  39.  
  40. Function UT_GetNetworkType () As String
  41.  
  42. ' Copyright ⌐ 1994 by Computer Technologies, Inc. All rights reserved.
  43.  
  44. ' When WNetGetCaps is called with the flag WNNC_NET_TYPE it returns a
  45. ' network type bit mask. The high byte contains the network type, and
  46. ' the low byte may contain a subtype. The network type can be one of
  47. ' the following values:
  48.     Const WNNC_NET_NONE = &H0
  49.     Const WNNC_NET_MSNet = &H100
  50.     Const WNNC_NET_LanMan = &H200
  51.     Const WNNC_NET_NetWare = &H300
  52.     Const WNNC_NET_Vines = &H400
  53.     Const WNNC_NET_10NET = &H500
  54.     Const WNNC_NET_Locus = &H600
  55.     Const WNNC_NET_SunPCNFS = &H700
  56.     Const WNNC_NET_LANstep = &H800
  57.     Const WNNC_NET_9TILES = &H900
  58.     Const WNNC_NET_LANtastic = &HA00
  59.     Const WNNC_NET_AS400 = &HB00
  60.     Const WNNC_NET_FTP_NFS = &HC00
  61.     Const WNNC_NET_PATHWORKS = &HD00
  62.     Const WNNC_NET_LifeNet = &HE00
  63.     Const WNNC_NET_POWERLan = &HF00
  64.     Const WNNC_NET_MultiNet = &H8000
  65.  
  66.     Const WNNC_SUBNET_NONE = &H0
  67.     Const WNNC_SUBNET_MSNet = &H1
  68.     Const WNNC_SUBNET_LanMan = &H2
  69.     Const WNNC_SUBNET_WinWork = &H4
  70.     Const WNNC_SUBNET_NetWare = &H8
  71.     Const WNNC_SUBNET_Vines = &H10
  72.     Const WNNC_SUBNET_Other = &H80
  73.  
  74.     Const WNNC_NET_TYPE = &H2
  75.     
  76.     Dim tTempStr            As String
  77.     Dim nFlags              As Integer
  78.     Dim nByteHi             As Integer
  79.     Dim nByteLo             As Integer
  80.  
  81.     tTempStr = ""
  82.  
  83.     nFlags = WNetGetCaps(WNNC_NET_TYPE)     ' Get network type bit flags
  84.  
  85.     If (nFlags And WNNC_NET_NONE) Then tTempStr = "Network not installed or not running" & ", "
  86.     If (nFlags And WNNC_NET_MSNet) Then tTempStr = "MSNet" & ", "
  87.     If (nFlags And WNNC_NET_LanMan) Then tTempStr = "LanMan" & ", "
  88.     If (nFlags And WNNC_NET_NetWare) Then tTempStr = "NetWare" & ", "
  89.     If (nFlags And WNNC_NET_Vines) Then tTempStr = "Vines" & ", "
  90.     If (nFlags And WNNC_NET_10NET) Then tTempStr = "10 NET" & ", "
  91.     If (nFlags And WNNC_NET_Locus) Then tTempStr = "Locus" & ", "
  92.     If (nFlags And WNNC_NET_SunPCNFS) Then tTempStr = "Sun PC NFS" & ", "
  93.     If (nFlags And WNNC_NET_LANstep) Then tTempStr = "LANstep" & ", "
  94.     If (nFlags And WNNC_NET_9TILES) Then tTempStr = "9 TILES" & ", "
  95.     If (nFlags And WNNC_NET_LANtastic) Then tTempStr = "LANtastic" & ", "
  96.     If (nFlags And WNNC_NET_AS400) Then tTempStr = "AS-400" & ", "
  97.     If (nFlags And WNNC_NET_FTP_NFS) Then tTempStr = "FTP NFS" & ", "
  98.     If (nFlags And WNNC_NET_PATHWORKS) Then tTempStr = "PATHWORKS" & ", "
  99.     If (nFlags And WNNC_NET_LifeNet) Then tTempStr = "LifeNet" & ", "
  100.     If (nFlags And WNNC_NET_POWERLan) Then tTempStr = "POWERLan" & ", "
  101.     If (nFlags And WNNC_NET_MultiNet) Then  ' Multinet is a bit mask that identifies all the sub nets so check each one ...
  102.     If (nFlags And WNNC_SUBNET_NONE) Then tTempStr = tTempStr & "None" & ", "
  103.     If (nFlags And WNNC_SUBNET_MSNet) Then tTempStr = tTempStr & "MsNet" & ", "
  104.     If (nFlags And WNNC_SUBNET_LanMan) Then tTempStr = tTempStr & "LanMan" & ", "
  105.     If (nFlags And WNNC_SUBNET_WinWork) Then tTempStr = tTempStr & "Windows for Workgroups" & ", "
  106.     If (nFlags And WNNC_SUBNET_NetWare) Then tTempStr = tTempStr & "NetWare" & ", "
  107.     If (nFlags And WNNC_SUBNET_Vines) Then tTempStr = tTempStr & "Vines" & ", "
  108.     If (nFlags And WNNC_SUBNET_Other) Then tTempStr = tTempStr & "Other" & ", "
  109.     End If
  110.  
  111.     If Right$(tTempStr, 2) = ", " Then tTempStr = Left$(tTempStr, Len(tTempStr) - 2)
  112.  
  113.     UT_GetNetworkType = tTempStr
  114.  
  115. End Function
  116.  
  117. Function UT_NetDismount (tLocalName As String, nOpenFileAction As Integer) As Integer
  118.  
  119. ' Copyright ⌐ 1993, 1994 by Computer Technologies, Inc. All rights reserved.
  120.  
  121. ' Inbound parameters:
  122. '   tLocalName          - The drive letter to dismount
  123. '   nOpenFileAction     - What to do if there are open files on the service
  124.  
  125. ' Use one of the following defined constants for nOpenFileAction values:
  126. '   NET_OPENDISALLOW    - Service can't be closed with open files
  127. '   NET_OPENQUERY       - Warn the user that there are open files
  128. '   NET_OPENIGNORE      - Ignore open files and force a dismount
  129.  
  130. ' Return value:
  131. '   True        - The service was dismounted
  132. '   False       - The service was NOT dismounted
  133.  
  134.     Dim nResult1            As Integer
  135.     Dim nResult2            As Integer
  136.     Dim nAction             As Integer
  137.     Dim bForceClose         As Integer
  138.     Dim tLocalDevice        As String
  139.     Dim tTempStr            As String
  140.  
  141. ' Change to uppercase and insure the correct format of the local drive letter
  142.     tLocalDevice = UCase$(Left$(tLocalName, 1)) & ":"
  143.  
  144. ' Setup for open file handling
  145.     If nOpenFileAction = NET_OPENIGNORE Then    ' Always dismount
  146.     bForceClose = True
  147.       Else                                      ' Disallow or Warn specified
  148.     bForceClose = False
  149.     End If
  150.  
  151. ' Attempt to drop the connection ...
  152. DismAttempt:
  153.     nResult1 = WNetCancelConnection(tLocalDevice, bForceClose)
  154.     
  155. ' Evaluate the return status of the disconnect
  156.     Select Case nResult1
  157.     Case WN_SUCCESS
  158.         UT_NetDismount = True
  159.     Case WN_OPEN_FILES
  160.         If nOpenFileAction = NET_OPENDISALLOW Then
  161.         MsgBox "There are still open files on the service and it cannot be disconnected. Please close the open files and click 'OK' to dismount the service.", 0, "Network Services"
  162.         GoTo DismAttempt
  163.         End If
  164.         If nOpenFileAction = NET_OPENQUERY Then      ' Warn and prompt
  165.         nAction = MsgBox("There are still open files on the service. Do you want to disconnect anyway?", 4 + 32, "Network Services")
  166.         If nAction = 6 Then                     ' Yes selected
  167.             bForceClose = True
  168.             GoTo DismAttempt
  169.           Else                                  ' No selected
  170.             UT_NetDismount = False
  171.         End If
  172.         End If
  173.     Case Else
  174.         tTempStr = UT_NetError(nResult1)
  175.         MsgBox "An unexpected network error has occurred: " & tTempStr, MB_ICONSTOP, "Network Error"
  176.         UT_NetDismount = False
  177.     End Select
  178.  
  179. End Function
  180.  
  181. Function UT_NetError (nErrorCode As Integer) As String
  182.  
  183. ' Copyright ⌐ 1993, 1994 by Computer Technologies, Inc. All rights reserved.
  184.  
  185. ' This function is passed the network error from a WNet* API function.
  186. ' The return string is the text form of the error.
  187.  
  188.     Dim tMessageText        As String
  189.  
  190.     Select Case nErrorCode
  191.     Case WN_NOT_SUPPORTED:      tMessageText = "Function is not supported."
  192.     Case WN_OUT_OF_MEMORY:      tMessageText = "Out of memory."
  193.     Case WN_NET_ERROR:          tMessageText = "An error occurred on the network."
  194.     Case WN_BAD_POINTER:        tMessageText = "The pointer was invalid."
  195.     Case WN_BAD_NETNAME:        tMessageText = "Invalid network resource name."
  196.     Case WN_BAD_PASSWORD:       tMessageText = "The password was invalid. Please try again."
  197.     Case WN_BAD_VALUE:          tMessageText = "Invalid local device name."
  198.     Case WN_BAD_LOCALNAME:      tMessageText = "The local device name was invalid."
  199.     Case WN_ACCESS_DENIED:      tMessageText = "The maximum number of users are already connected to this service, or a security has violation occurred. Please try again later."
  200.     Case WN_ALREADY_CONNECTED:  tMessageText = "The local device is already connected to a resource."
  201.     Case WN_NOT_CONNECTED:      tMessageText = "The device is not a redirected network resource."
  202.     Case WN_MORE_DATA:          tMessageText = "More data."
  203.     Case WN_FUNCTION_BUSY:      tMessageText = "Function is already busy."
  204.     Case WN_WINDOWS_ERROR:      tMessageText = "Unexpected Windows error."
  205.     Case WN_BAD_USER:           tMessageText = "The user name is invalid. Please try again."
  206.     Case WN_OUT_OF_MEMORY:      tMessageText = "Out of memory."
  207.     Case WN_OPEN_FILES:         tMessageText = "There are open files on the service."
  208.     Case WN_DEVICE_ERROR:       tMessageText = "A device error occurred."
  209.     Case WN_CONNECTION_CLOSED:  tMessageText = "Connection is closed."
  210.     Case Else
  211.         tMessageText = "Unrecognized Network Error " & Trim$(Str$(nErrorCode)) & "."
  212.     End Select
  213.  
  214.     UT_NetError = tMessageText
  215.  
  216. End Function
  217.  
  218. Function UT_NetGetServiceDrive (tServiceName As String) As String
  219.  
  220. ' Copyright ⌐ 1993, 1994 by Computer Technologies, Inc. All rights reserved.
  221.  
  222. ' This function returns the drive letter associated with a particular service name.
  223.  
  224.     Dim tNetworkName        As String
  225.     Dim tTempStr            As String
  226.     Dim nLoopCtr            As Integer
  227.  
  228. ' Loop through the drives looking for the service name
  229.     tTempStr = Trim$(UCase$(tServiceName))
  230.     For nLoopCtr = 4 To 26                  ' Check drives D: to Z:
  231.     On Error Resume Next
  232.     tNetworkName = UT_NetGetServiceName(Chr$(64 + nLoopCtr) & ":")
  233.     On Error GoTo 0
  234.     If tNetworkName = tTempStr Then Exit For
  235.     Next nLoopCtr
  236.  
  237. ' Prepare the return string
  238.     If tNetworkName = tTempStr Then
  239.     UT_NetGetServiceDrive = Chr$(64 + nLoopCtr) & ":"
  240.       Else
  241.     UT_NetGetServiceDrive = ""
  242.     End If
  243.  
  244. End Function
  245.  
  246. Function UT_NetGetServiceName (tLocalDrive As String) As String
  247.  
  248. ' Copyright ⌐ 1993, 1994 by Computer Technologies, Inc. All rights reserved.
  249.  
  250. ' This function returns the name of a service connected to a particular drive.
  251.  
  252.     Dim tServiceName        As String
  253.     Dim nResult             As Integer
  254.     Dim tTempStr            As String
  255.  
  256.     If Len(tLocalDrive) = 1 Then tTempStr = tLocalDrive & ":" Else tTempStr = tLocalDrive
  257.  
  258. ' Make the call to get the service information
  259.     tServiceName = Space$(256)              ' Allocate return buffer space
  260.     nResult = WNetGetConnection(tTempStr, tServiceName, 255)
  261.     
  262. ' Evaluate the return and pass back the service name if successful
  263.     Select Case nResult
  264.     Case WN_SUCCESS
  265.         UT_NetGetServiceName = Left$(tServiceName, InStr(tServiceName, Chr$(0)) - 1)
  266.     Case WN_NOT_CONNECTED
  267.         UT_NetGetServiceName = ""
  268.     Case Else
  269.         tTempStr = UT_NetError(nResult)
  270.         MsgBox "An unexpected network error has occurred: " & tTempStr, MB_ICONSTOP, "Network Error"
  271.         UT_NetGetServiceName = ""
  272.     End Select
  273.  
  274. End Function
  275.  
  276. Function UT_NetMount (tLocalDrive As String, tServerName As String, tServiceName As String, tPassword As String) As String
  277.  
  278. ' Copyright ⌐ 1993, 1994 by Computer Technologies, Inc. All rights reserved.
  279.  
  280. ' Inbound parameters:
  281. '   tLocalDrive       the local logical drive letter to use
  282. '   tServerName       the name of the server to connect to
  283. '   tServiceName      the name of the service that we want
  284. '   tPassword         the service tPassword
  285.  
  286. ' Return value:
  287. '   Drive letter that the service is connected to or a NULL string
  288. '   if the mount was not successful.
  289.  
  290.     Dim nResult             As Integer
  291.     Dim tNetworkPath        As String
  292.     Dim tLocalName          As String
  293.     Dim tTempStr            As String
  294.  
  295. ' Build the network service name from the server and service names
  296.     tNetworkPath = "\\" & Trim$(tServerName) & "\" & Trim$(tServiceName)
  297.  
  298. ' Change to uppercase and insure the correct format of the local drive letter
  299.     tLocalName = UCase$(Left$(tLocalDrive, 1)) & ":"
  300.  
  301. ' Make sure that it is a valid drive letter between A and Z
  302.     If Asc(tLocalName) < 65 Or Asc(tLocalName) > 90 Then
  303.     nResult = MsgBox("An invalid local drive letter was provided to UT_NetMount.", MB_ICONSTOP, "Network Services")
  304.     UT_NetMount = ""
  305.     Exit Function
  306.     End If
  307.  
  308. ' Attempt to mount the service
  309.     nResult = WNetAddConnection(tNetworkPath, tPassword, tLocalName)
  310.  
  311. ' Check the return status
  312.     If nResult = WN_SUCCESS Then
  313.     UT_NetMount = tLocalName
  314.       Else
  315.     tTempStr = UT_NetError(nResult)
  316.     MsgBox "An unexpected network error has occurred: " & tTempStr, MB_ICONSTOP, "Network Error"
  317.     UT_NetMount = ""
  318.     End If
  319.     
  320. End Function
  321.  
  322. Function UT_NetUserID () As String
  323.  
  324. ' Copyright ⌐ 1994 by Computer Technologies, Inc. All rights reserved.
  325.  
  326. ' This function gets the name of the user who is currently connected to
  327. ' the network from this system. If no user is logged in the routine returns
  328. ' a null string.
  329.  
  330.     Dim tUser               As String
  331.     Dim nStatus             As Integer
  332.     Dim nReturn             As Integer
  333.     Dim tTempStr            As String
  334.     Dim tNetType            As String
  335.     Dim hNetwork            As Integer
  336.     Dim bWFW                As Integer
  337.  
  338.     tTempStr = ""                   ' Assume user is not logged in
  339.     tUser = Space$(256)             ' Allocate return buffer space
  340.     
  341.     nStatus = WNetGetUser(tUser, 255)   ' Check for a user name
  342.     If nStatus = 0 Then                 ' Valid call so move data
  343.     tTempStr = Left$(tUser, InStr(tUser, Chr(0)) - 1)
  344.     End If
  345.     
  346. ' If we got a user name all is well ...
  347.     If tTempStr <> "" Then
  348.     UT_NetUserID = tTempStr
  349.     Exit Function
  350.     End If
  351.  
  352. ' We did not get a user ID so see if this is WFW and check the subnets
  353.     bWFW = False
  354.     If InStr((UT_GetNetworkType()), "Workgroups") > 0 Then bWFW = True
  355.  
  356.     If bWFW = True Then             ' This is Workgroups so loop the subnets
  357.         hNetwork = 0                        ' Set the initial subnet handle
  358.         Do
  359.         nStatus = MNetNetworkEnum(hNetwork)         ' Get a subnet handle
  360.         If nStatus = WN_SUCCESS Then
  361.             nReturn = MNetSetNextTarget(hNetwork)   ' Point to the subnet
  362.             nReturn = WNetGetUser(tUser, 255)       ' Look for a user name
  363.             If nReturn = 0 Then                     ' Got a user name
  364.             tTempStr = Left$(tUser, InStr(tUser, Chr(0)) - 1)
  365.             Exit Do
  366.             End If
  367.         End If
  368.         Loop While nStatus = WN_SUCCESS
  369.     End If
  370.         
  371. ' IF we don't have a user id try once more
  372. '    nStatus = WNetGetUser(tUser, 255)   ' Check for a user name
  373. '    If nStatus = 0 Then                 ' Valid call so move data
  374. '        tTempStr = Left$(tUser, InStr(tUser, Chr(0)) - 1)
  375. '    End If
  376.  
  377.     UT_NetUserID = tTempStr
  378.     
  379. End Function
  380.  
  381.