module1.bas

关于局域网发送消息的vb源代码

Attribute VB_Name = "Module1"
Public mdctItems As New Dictionary


'取得本机名称AIP声明
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal IpBuffer As String, nSize As Long) As Long

'消息发送AIP声明
Private Declare Function NetMessageBufferSend Lib "NETAPI32.DLL" (yServer As Any, yToName As Byte, yFromName As Any, yMsg As Byte, ByVal ISize As Long) As Long
 
'取得本机计算机名的函数
Function ComputerName() As String
 
 Dim L1 As String
 Dim L2 As Long
 Dim L3 As Long
 L2 = 255
 L1 = String$(L2, " ")
 L3 = GetComputerName(L1, L2)
 ComputerName = ""
 If L3 <> 0 Then
  ComputerName = Left(L1, L2)
 End If
 
End Function
 
'消息发送的函数
Function SendMsgInLan(ToUser As String, BodyMessage As String) As Boolean
 
 Dim RcptTo() As Byte
 Dim Body() As Byte
 Dim Ret As Long
 RcptTo = ToUser & vbNullChar '计算机名
 Body = BodyMessage & vbNullChar '消息内容
 
 '发送消息并返回信息
 Ret = NetMessageBufferSend(ByVal 0, RcptTo(0), ByVal 0, Body(0), UBound(Body))
       
 If Ret = 0 Then '发送成功
  SendMsgInLan = True
 End If
 
End Function

'获取局域网计算机名称的函数
Function GetNetComputerName(sObj As ListBox)
 
' Dim shTmp As New Shell  'Shell变量
' Dim NewDict As New Dictionary  '新的文件夹变量
' Dim fdTmp As Folder  '文件夹变量
' Dim fiTmp As FolderItem  '文件夹项目变量
' Dim strTmp As String  '字符串变量
' Dim k As Integer  '判断网络资源中是否有“邻近的计算机”
'
' sObj.Clear
'
' '打开网上邻居
' Set fdTmp = shTmp.NameSpace(ssfNETWORK)
'
'
' NewDict.RemoveAll
' '搜索网上邻居的所有项目
' For Each fiTmp In fdTmp.Items
'  '取得文件夹的详细摘要信息（0表示取名称）
'  strTmp = fdTmp.GetDetailsOf(fiTmp, 0)
'  '保存“邻近计算机”到文件夹变量，以便获取其下的计算机名称
'  If strTmp = "整个网络" Then                                 '邻近的计算机
'   NewDict.Add 0, fiTmp
'   k = 1 '有“邻近计算机”标志
'  End If
' Next
'
' '获取对“邻近计算机”中的计算机名称
' If k = 1 Then
'  Set fiTmp = NewDict(0)  '打开“邻近计算机”
'  Set fdTmp = fiTmp.GetFolder '打开“邻近计算机”中的对象
'
'  '搜索“邻近计算机”中的所有计算机名称
'  For Each fiTmp In fdTmp.Items
'   '取得名称
'   strTmp = fdTmp.GetDetailsOf(fiTmp, 0)
''   MsgBox fiTmp
''   If Left$(strTmp, 2) = "\\" Then '保存名称到列表框
'     sObj.AddItem Mid$(strTmp, 3)
''   End If
'  Next
' End If

Dim shTemp1 As New Shell
    Dim fdTemp1 As Folder
    Dim fiTemp1 As FolderItem
    Dim strTemp As String
    
    sObj.Clear
    
    Set fdTemp1 = shTemp1.NameSpace(ssfNETWORK)
    
    mdctItems.RemoveAll
    For Each fiTemp1 In fdTemp1.Items
        strTemp = fdTemp1.GetDetailsOf(fiTemp1, 0)
        sObj.AddItem strTemp
        mdctItems.Add sObj.NewIndex, fiTemp1
    Next
 
End Function

'获取局域网计算机名称的函数
Function GetNetComputerName_1(sObj As ListBox)
 
 Dim shTmp As New Shell  'Shell变量
 Dim NewDict As New Dictionary  '新的文件夹变量
 Dim fdTmp As Folder  '文件夹变量
 Dim fiTmp As FolderItem  '文件夹项目变量
 Dim strTmp As String  '字符串变量
 Dim k As Integer  '判断网络资源中是否有“邻近的计算机”

 sObj.Clear

 '打开网上邻居
 Set fdTmp = shTmp.NameSpace(ssfNETWORK)


 NewDict.RemoveAll
 '搜索网上邻居的所有项目
 For Each fiTmp In fdTmp.Items
  '取得文件夹的详细摘要信息（0表示取名称）
  strTmp = fdTmp.GetDetailsOf(fiTmp, 0)
  '保存“邻近计算机”到文件夹变量，以便获取其下的计算机名称
  If strTmp = "整个网络" Then                                 '邻近的计算机
   NewDict.Add 0, fiTmp
   k = 1 '有“邻近计算机”标志
  End If
 Next

 '获取对“邻近计算机”中的计算机名称
 If k = 1 Then
  Set fiTmp = NewDict(0)  '打开“邻近计算机”
  Set fdTmp = fiTmp.GetFolder '打开“邻近计算机”中的对象

  '搜索“邻近计算机”中的所有计算机名称
  For Each fiTmp In fdTmp.Items
   '取得名称
   strTmp = fdTmp.GetDetailsOf(fiTmp, 0)
   If strTmp = "Microsoft Windows Network" Then
    NewDict.Add 1, fiTmp
    k = 2 '有“邻近计算机”标志
   End If
  Next
 End If

 If k = 2 Then
  Set fiTmp = NewDict(1)  '打开“邻近计算机”
  Set fdTmp = fiTmp.GetFolder '打开“邻近计算机”中的对象

  '搜索“邻近计算机”中的所有计算机名称
  For Each fiTmp In fdTmp.Items
   '取得名称
   strTmp = fdTmp.GetDetailsOf(fiTmp, 0)
   If strTmp = "Yfgs" Then
    NewDict.Add 2, fiTmp
    k = 3 '有“邻近计算机”标志
   End If
  Next
 End If
 
 If k = 3 Then
  Set fiTmp = NewDict(2)  '打开“邻近计算机”
  Set fdTmp = fiTmp.GetFolder '打开“邻近计算机”中的对象

  '搜索“邻近计算机”中的所有计算机名称
  For Each fiTmp In fdTmp.Items
   '取得名称
   strTmp = fdTmp.GetDetailsOf(fiTmp, 0)
 
   If Left$(strTmp, 2) = "\\" Then '保存名称到列表框
'     sObj.AddItem Mid$(strTmp, 3)
     sObj.AddItem strTmp
   End If
  Next
 End If
 
 
End Function