home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD1259312112000.psc / modNetServer.bas < prev    next >
Encoding:
BASIC Source File  |  2000-12-11  |  8.0 KB  |  242 lines
  1. Attribute VB_Name = "modNetServer"
  2. Option Explicit
  3.  
  4. Public Declare Function NetServerEnum Lib "Netapi32.dll" (vServername As Any, ByVal lLevel As Long, vBufptr As Any, lPrefmaxlen As Long, lEntriesRead As Long, lTotalEntries As Long, vServerType As Any, ByVal sDomain As String, vResumeHandle As Any) As Long
  5. Public Declare Sub RtlMoveMemory Lib "kernel32" (dest As Any, vSrc As Any, ByVal lSize&)
  6. Public Declare Sub lstrcpyW Lib "kernel32" (vDest As Any, ByVal sSrc As Any)
  7. Declare Sub lstrcpy Lib "kernel32" (vDest As Any, ByVal vSrc As Any)
  8. Declare Sub lstrcpynW Lib "kernel32" (ByVal vDest As Any, ByVal vSrc As Any, lLength As Long)
  9. Public Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer As Long) As Long
  10.  
  11. Declare Function NetWkstaGetInfo Lib "Netapi32.dll" (ByVal sServerName$, ByVal lLevel&, vBuffer As Any) As Long
  12. 'Public Declare Function NetWkstaGetInfo Lib "Netapi32.dll" (lpServer As Any, ByVal Level As Long, lpBuffer As Any) As Long
  13.  
  14. Declare Function NetMessageBufferSend Lib "Netapi32.dll" (ByVal sServerName$, ByVal sMsgName$, ByVal sFromName$, ByVal sMessageText$, ByVal lBufferLength&) As Long
  15.  
  16.  
  17. 'try these
  18. Public Declare Function NetLocalGroupGetMembers Lib "Netapi32.dll" (ByVal psServer As Long, ByVal psLocalGroup As Long, ByVal lLevel As Long, pBuffer As Long, ByVal lMaxLength As Long, plEntriesRead As Long, plTotalEntries As Long, phResume As Long) As Long
  19. Public Declare Function NetUserGetGroups Lib "Netapi32.dll" (ByVal sServerName$, UserName As Byte, ByVal Level As Long, lpBuffer As Long, ByVal PrefMaxLen As Long, lpEntriesRead As Long, lpTotalEntries As Long) As Long
  20. Public Declare Function NetUserGetInfo Lib "Netapi32.dll" (ByVal sServerName$, UserName As Byte, ByVal Level As Long, lpBuffer As Long) As Long
  21. Public Declare Function NetWkstaUserGetInfo Lib "Netapi32.dll" (ByVal reserved As Any, ByVal Level As Long, lpBuffer As Any) As Long
  22.  
  23.  
  24.  
  25.  
  26. Type SERVER_INFO_100
  27.     sv100_platform_id As Long
  28.     sv100_servername As Long
  29. End Type
  30.  
  31. Public Type SERVER_INFO_101
  32.     dw_platform_id As Long
  33.     ptr_name As Long
  34.     dw_ver_major As Long
  35.     dw_ver_minor As Long
  36.     dw_type As Long
  37.     ptr_comment As Long
  38. End Type
  39.  
  40. Type WKSTA_INFO_100
  41.     wki100_platform_id As Long
  42.     wki100_computername As Long
  43.     wki100_langroup As Long
  44.     wki100_ver_major As Long
  45.     wki100_ver_minor As Long
  46. End Type
  47.  
  48. Public Enum eServerTypes
  49.     SV_TYPE_WORKSTATION = &H1
  50.     SV_TYPE_SERVER = &H2
  51.     SV_TYPE_SQLSERVER = &H4
  52.     SV_TYPE_DOMAIN_CTRL = &H8
  53.     SV_TYPE_DOMAIN_BAKCTRL = &H10
  54.     SV_TYPE_TIMESOURCE = &H20
  55.     SV_TYPE_AFP = &H40
  56.     SV_TYPE_NOVELL = &H80
  57.     SV_TYPE_DOMAIN_MEMBER = &H100
  58.     SV_TYPE_LOCAL_LIST_ONLY = &H40000000
  59.     SV_TYPE_PRINT = &H200
  60.     SV_TYPE_DIALIN = &H400
  61.     SV_TYPE_XENIX_SERVER = &H800
  62.     SV_TYPE_MFPN = &H4000
  63.     SV_TYPE_NT = &H1000
  64.     SV_TYPE_WFW = &H2000
  65.     SV_TYPE_SERVER_NT = &H8000
  66.     SV_TYPE_POTENTIAL_BROWSER = &H10000
  67.     SV_TYPE_BACKUP_BROWSER = &H20000
  68.     SV_TYPE_MASTER_BROWSER = &H40000
  69.     SV_TYPE_DOMAIN_MASTER = &H80000
  70.     SV_TYPE_DOMAIN_ENUM = &H80000000
  71.     SV_TYPE_WINDOWS = &H400000
  72.     SV_TYPE_ALL = &HFFFFFFFF
  73.  
  74. End Enum
  75.  
  76. Private Const mcsTempFile As String = "~tempUserList"
  77.  
  78. 'Public Const SV_TYPE_WORKSTATION = &H1
  79. 'Public Const SV_TYPE_SERVER = &H2
  80. 'Public Const SV_TYPE_SQLSERVER = &H4
  81. 'Public Const SV_TYPE_DOMAIN_CTRL = &H8
  82. 'Public Const SV_TYPE_DOMAIN_BAKCTRL = &H10
  83. 'Public Const SV_TYPE_TIMESOURCE = &H20
  84. 'Public Const SV_TYPE_AFP = &H40
  85. 'Public Const SV_TYPE_NOVELL = &H80
  86. 'Public Const SV_TYPE_DOMAIN_MEMBER = &H100
  87. 'Public Const SV_TYPE_LOCAL_LIST_ONLY = &H40000000
  88. 'Public Const SV_TYPE_PRINT = &H200
  89. 'Public Const SV_TYPE_DIALIN = &H400
  90. 'Public Const SV_TYPE_XENIX_SERVER = &H800
  91. 'Public Const SV_TYPE_MFPN = &H4000
  92. 'Public Const SV_TYPE_NT = &H1000
  93. 'Public Const SV_TYPE_WFW = &H2000
  94. 'Public Const SV_TYPE_SERVER_NT = &H8000
  95. 'Public Const SV_TYPE_POTENTIAL_BROWSER = &H10000
  96. 'Public Const SV_TYPE_BACKUP_BROWSER = &H20000
  97. 'Public Const SV_TYPE_MASTER_BROWSER = &H40000
  98. 'Public Const SV_TYPE_DOMAIN_MASTER = &H80000
  99. 'Public Const SV_TYPE_DOMAIN_ENUM = &H80000000
  100. 'Public Const SV_TYPE_WINDOWS = &H400000
  101. 'Public Const SV_TYPE_ALL = &HFFFFFFFF
  102. '
  103.  
  104. '__________________________________________________
  105. ' Scope  : Public
  106. ' Type   : Function
  107. ' Name   : GetLocalSystemName
  108. ' Params : 
  109. ' Returns: Nothing
  110. ' Desc   : The Function uses parameters  for GetLocalSystemName and returns Nothing.
  111. '__________________________________________________
  112. ' History
  113. ' CDK: 20001112: Added Error Trapping & Comments using
  114. '        Auto-Code Commenter
  115. '__________________________________________________
  116. Public Function GetLocalSystemName()
  117.     On Error GoTo Proc_Err
  118.     Const csProcName As String = "GetLocalSystemName"
  119.     Dim lReturnCode As Long
  120.     Dim bBuffer(512) As Byte
  121.     Dim I As Integer
  122.     Dim twkstaInfo100 As WKSTA_INFO_100, lwkstaInfo100 As Long
  123.     Dim lwkstaInfo100StructPtr As Long
  124.     Dim sLocalName As String
  125.     
  126.     lReturnCode = NetWkstaGetInfo("", 100, lwkstaInfo100)
  127.  
  128.     lwkstaInfo100StructPtr = lwkstaInfo100
  129.                  
  130.     If lReturnCode = 0 Then
  131.                  
  132.         RtlMoveMemory twkstaInfo100, ByVal lwkstaInfo100StructPtr, Len(twkstaInfo100)
  133.          
  134.         lstrcpyW bBuffer(0), twkstaInfo100.wki100_computername
  135.  
  136.         I = 0
  137.         Do While bBuffer(I) <> 0
  138.             sLocalName = sLocalName & Chr(bBuffer(I))
  139.             I = I + 2
  140.         Loop
  141.             
  142.         GetLocalSystemName = sLocalName
  143.          
  144.     End If
  145.  
  146.  
  147. Proc_Exit:
  148.     GoSub Proc_Cleanup
  149.     Exit Function
  150.  
  151. Proc_Cleanup:
  152.     On Error Resume Next
  153.     'Place any cleanup of instantiated objects here    
  154.     On Error GoTo 0
  155.     Return
  156.  
  157. Proc_Err:
  158.     Dim lErrNum As String, sErrSource As String, sErrDesc As String
  159.     lErrNum = VBA.Err.Number
  160.     sErrSource = VBA.Err.Source & vbcrlf & "modNetServer->"  & csProcName
  161.     sErrDesc = VBA.Err.Description
  162.     Resume Proc_Err_Continue
  163.     
  164. Proc_Err_Continue:
  165.     GoSub Proc_Cleanup
  166.     Err.Raise Number:=lErrNum, Source:=sErrSource, Description:=sErrDesc
  167.     Exit Function
  168.     
  169. End Function
  170.  
  171. '__________________________________________________
  172. ' Scope  : Public
  173. ' Type   : Function
  174. ' Name   : GetDomainName
  175. ' Params : 
  176. ' Returns: String
  177. ' Desc   : The Function uses parameters  for GetDomainName and returns String.
  178. '__________________________________________________
  179. ' History
  180. ' CDK: 20001112: Added Error Trapping & Comments using
  181. '        Auto-Code Commenter
  182. '__________________________________________________
  183. Public Function GetDomainName() As String
  184.     On Error GoTo Proc_Err
  185.     Const csProcName As String = "GetDomainName"
  186.     
  187.     Dim lReturnCode As Long
  188.     Dim bBuffer(512) As Byte
  189.     Dim I As Integer
  190.     Dim twkstaInfo100 As WKSTA_INFO_100, lwkstaInfo100 As Long
  191.     Dim lwkstaInfo100StructPtr As Long
  192.     Dim sDomainName As String
  193.     
  194.     lReturnCode = NetWkstaGetInfo("", 100, lwkstaInfo100)
  195.  
  196.     lwkstaInfo100StructPtr = lwkstaInfo100
  197.                  
  198.     If lReturnCode = 0 Then
  199.                  
  200.         RtlMoveMemory twkstaInfo100, ByVal lwkstaInfo100StructPtr, Len(twkstaInfo100)
  201.          
  202.         lstrcpyW bBuffer(0), twkstaInfo100.wki100_langroup
  203.         
  204.         
  205.         I = 0
  206.         Do While bBuffer(I) <> 0
  207.             sDomainName = sDomainName & Chr(bBuffer(I))
  208.             I = I + 2
  209.         Loop
  210.             
  211.         GetDomainName = sDomainName
  212.          
  213.     End If
  214.         
  215.  
  216. Proc_Exit:
  217.     GoSub Proc_Cleanup
  218.     Exit Function
  219.  
  220. Proc_Cleanup:
  221.     On Error Resume Next
  222.     'Place any cleanup of instantiated objects here    
  223.     On Error GoTo 0
  224.     Return
  225.  
  226. Proc_Err:
  227.     Dim lErrNum As String, sErrSource As String, sErrDesc As String
  228.     lErrNum = VBA.Err.Number
  229.     sErrSource = VBA.Err.Source & vbcrlf & "modNetServer->"  & csProcName
  230.     sErrDesc = VBA.Err.Description
  231.     Resume Proc_Err_Continue
  232.     
  233. Proc_Err_Continue:
  234.     GoSub Proc_Cleanup
  235.     Err.Raise Number:=lErrNum, Source:=sErrSource, Description:=sErrDesc
  236.     Exit Function
  237.     
  238. End Function
  239.  
  240.  
  241.  
  242.