frmac_qq.frm

办公自动化系统--vb+access

VERSION 5.00
Begin VB.Form frmAC_QQ 
   AutoRedraw      =   -1  'True
   BorderStyle     =   0  'None
   Caption         =   "信使服务"
   ClientHeight    =   4200
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   6780
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Picture         =   "frmAC_QQ.frx":0000
   ScaleHeight     =   4200
   ScaleWidth      =   6780
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton cmdClear 
      Caption         =   "清空消息"
      Height          =   345
      Left            =   1740
      TabIndex        =   9
      Top             =   3750
      Width           =   1620
   End
   Begin VB.CommandButton cmdSend 
      Caption         =   "发送消息"
      Height          =   345
      Left            =   135
      TabIndex        =   7
      Top             =   3750
      Width           =   1620
   End
   Begin VB.TextBox txtMemo 
      Appearance      =   0  'Flat
      Height          =   1830
      Left            =   1845
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   6
      Top             =   1800
      Width           =   4815
   End
   Begin VB.TextBox TxtCmpName 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      Height          =   270
      Left            =   2640
      TabIndex        =   3
      Top             =   1290
      Width           =   1140
   End
   Begin VB.TextBox txtFromName 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      Enabled         =   0   'False
      Height          =   270
      Left            =   4620
      TabIndex        =   2
      Top             =   1290
      Width           =   1140
   End
   Begin VB.ListBox List1 
      Appearance      =   0  'Flat
      Height          =   1830
      Left            =   150
      TabIndex        =   0
      Top             =   1800
      Width           =   1620
   End
   Begin VB.Label labExit 
      BackStyle       =   0  'Transparent
      Height          =   375
      Left            =   6210
      TabIndex        =   10
      Top             =   75
      Width           =   465
   End
   Begin VB.Label Label4 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      Caption         =   "发送文本："
      ForeColor       =   &H00FF0000&
      Height          =   180
      Left            =   1860
      TabIndex        =   8
      Top             =   1560
      Width           =   900
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "机器名："
      ForeColor       =   &H00FF0000&
      Height          =   180
      Left            =   1845
      TabIndex        =   5
      Top             =   1320
      Width           =   720
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "发送人："
      ForeColor       =   &H00FF0000&
      Height          =   180
      Left            =   3840
      TabIndex        =   4
      Top             =   1320
      Width           =   720
   End
   Begin VB.Label Label3 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      Caption         =   "选择接收机器名称："
      ForeColor       =   &H00C00000&
      Height          =   180
      Left            =   135
      TabIndex        =   1
      Top             =   1560
      Width           =   1620
   End
End
Attribute VB_Name = "frmAC_QQ"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'局域网发送消息
Private Declare Function NetMessageBufferSend Lib "NETAPI32.DLL" (Server As Any, yToName As Byte, yFromName As Any, yMsg As Byte, ByVal lSize As Long) As Long
Dim FName As String * 256

'移动窗体
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2


Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, ByVal dwUsage As Long, lpNetResource As Any, lphEnum As Long) As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, lpBuffer As Any, lpBufferSize As Long) As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (lpTo As Any, lpFrom As Any, ByVal lLen As Long)
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Any) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long

Private Const RESOURCE_GLOBALNET As Long = &H2&  ' 枚举所有资源

'  网络资源类型常数
Private Const RESOURCEDISPLAYTYPE_DIRECTORY& = &H9
Private Const RESOURCEDISPLAYTYPE_DOMAIN& = &H1
Private Const RESOURCEDISPLAYTYPE_FILE& = &H4
Private Const RESOURCEDISPLAYTYPE_GENERIC& = &H0
Private Const RESOURCEDISPLAYTYPE_GROUP& = &H5
Private Const RESOURCEDISPLAYTYPE_NETWORK& = &H6
Private Const RESOURCEDISPLAYTYPE_ROOT& = &H7
Private Const RESOURCEDISPLAYTYPE_SERVER& = &H2
Private Const RESOURCEDISPLAYTYPE_SHARE& = &H3
Private Const RESOURCEDISPLAYTYPE_SHAREADMIN& = &H8
Private Const RESOURCETYPE_ANY As Long = &H0&
Private Const RESOURCETYPE_DISK As Long = &H1&
Private Const RESOURCETYPE_PRINT As Long = &H2&
Private Const RESOURCETYPE_UNKNOWN As Long = &HFFFF&
Private Const RESOURCEUSAGE_ALL As Long = &H0&
Private Const RESOURCEUSAGE_CONNECTABLE As Long = &H1&
Private Const RESOURCEUSAGE_CONTAINER As Long = &H2&
Private Const RESOURCEUSAGE_RESERVED As Long = &H80000000

Private Const NO_ERROR = 0
Private Const ERROR_MORE_DATA = 234
Private Const RESOURCE_ENUM_ALL As Long = &HFFFF

'   枚举信息数据类型
Private Type NETRESOURCE
    dwScope As Long        '  枚举的范围
    dwType As Long         '  枚举的类型
    dwDisplayType As Long  '  资源的类型
    dwUsage As Long        '  枚举的用法
    sLocalName As String   '  由本地系统引用的资源名称
    sRemoteName As String  '  资源的网络名
    sComment As String     '  由网络供应商设置
    sProvider As String    '  网络供应商的名字
End Type

'  自定义类型存放枚举信息
Private Type NETRESOURCE_BUF
    dwScope As Long        '  枚举的范围
    dwType As Long         '  枚举的类型
    dwDisplayType As Long  '  资源的类型
    dwUsage As Long        '  枚举的用法
    pLocalName As Long     '  由本地系统引用的资源名称
    pRemoteName As Long    '  资源的网络名
    pComment As Long       '  由网络供应商设置
    pProvider As Long      '  网络供应商的名字
End Type

Private Declare Function gethostname Lib "WSOCK32.DLL" (ByVal szHost As String, ByVal dwHostLen As Long) As Long
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal szHost As String) As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)

'  Socket错误常数和版本常数
Private Const SOCKET_ERROR As Long = -1
Private Const MAX_WSADescription = 256
Private Const MAX_WSASYSStatus = 128
Private Const ERROR_SUCCESS       As Long = 0
Private Const WS_VERSION_REQD     As Long = &H101
Private Const MIN_SOCKETS_REQD    As Long = 1