module1.bas

时通讯和P2P开发工具

'更改个人状态，如上线，下线，隐身, addr其实没有用到
Public Declare Sub CmdStatChangeDll Lib "DllShareRes.dll" (ByVal addr As Long, ByVal newStat As Integer)

'发送留言
Public Declare Sub CmdLeaveMsgDll Lib "DllShareRes.dll" (ByVal msgtype As Long, ByVal addr As Long, ByVal hisUIN As Long, ByVal msg As String)



'发送留言(long addr, LPCTSTR sInfo)
'Public Declare Sub CmdUpdateInfoDll Lib "DllShareRes.dll" (ByVal addr As Long, ByVal sInfo As String)


'发送留言(long addr, LPCTSTR sInfo)
'Public Declare Sub CmdUpdateDetailInfoDll Lib "DllShareRes.dll" (ByVal addr As Long, ByVal sInfo As String)

Public Declare Sub SetNetworkDll Lib "DllShareRes.dll" (ByVal sIP As String, ByVal nPort As Long, ByVal sProxyIP As String, ByVal nProxyPort As Long, ByVal sUserName As String, ByVal sPass As String)

Public Declare Sub CmdSendMsgToSvr Lib "DllShareRes.dll" (ByVal nType As Long, ByVal nLen As Long, ByVal sMsg As String)


'
''=========================================================
''Dll接口函数 所有都以Cmd开头
'
'Public Declare Sub DllOnTimer Lib "DllShareRes.dll" (ByVal nTimerID As Integer)
'
'
'
''初始化DLL
''addrOffline是offline的回调地址
'Public Declare Sub StartUp Lib "DllShareRes.dll" (ByVal LeaveMsg As Long, ByVal LanStatus As Long, ByVal addrLocalErr As Long, ByVal addrTimer As Long, ByVal addrGetMsg As Long, _
'ByVal addrOnline As Long, ByVal addrSysMsg As Long, ByVal addrAdvSearch As Long)
'
''登录,Uin是Uin号，Pass是密码
'Public Declare Sub CmdLoginDll Lib "DllShareRes.dll" (ByVal addr As Long, _
'        ByVal status As Long, ByVal uin As Long, ByVal name As String, ByVal Pass As String)
'
''需要contact list
'Public Declare Sub CmdReqContactListDll Lib "DllShareRes.dll" (ByVal addr As Long)
'
'
'
''添加到某个组列表  nGroup是组ID，BAdd是添加还是从组中删除他
'Public Declare Sub CmdAddToContactListDll Lib "DllShareRes.dll" (ByVal addr As Long, ByVal sGroup As String, ByVal nGroup As Integer, ByVal hisUIN As Long, ByVal BAdd As Byte)
'
''发送消息
'Public Declare Sub CmdSendMsgDll Lib "DllShareRes.dll" (ByVal msgtype As Long, ByVal nLanStatus As Integer, ByVal addr As Long, ByVal hisUIN As Long, ByVal sDestIP As String, ByVal destPort As Long, ByVal mes As String)
'
'
''//更新是否需要通过验证的状态，bNewStat是新的状态,无回调函数，返回系统消息，成功或否
'Public Declare Sub CmdUpdateAuthDll Lib "DllShareRes.dll" (ByVal addr As Long, ByVal NewState As Long)
'
''更改密码
'Public Declare Sub CmdChangePwdDll Lib "DllShareRes.dll" (ByVal addr As Long, ByVal newPass As String)
'
''需要基本信息
'Public Declare Sub CmdReqInfoDll Lib "DllShareRes.dll" (ByVal addr As Long, ByVal hisUIN As Long)
'
'
''更改个人状态，如上线，下线，隐身, addr其实没有用到
'Public Declare Sub CmdStatChangeDll Lib "DllShareRes.dll" (ByVal addr As Long, ByVal newStat As Integer)
'
''发送留言
'Public Declare Sub CmdLeaveMsgDll Lib "DllShareRes.dll" (ByVal msgtype As Long, ByVal addr As Long, ByVal hisUIN As Long, ByVal Msg As String)
'
'
'Public Declare Sub SetNetworkDll Lib "DllShareRes.dll" (ByVal sIP As String, ByVal nPort As Long, ByVal sProxyIP As String, ByVal nProxyPort As Long, ByVal sUserName As String, ByVal sPass As String)

'void __stdcall SetNetworkDll(LPCTSTR sIP, USHORT nPort, LPCTSTR sProxyIP, USHORT nProxyPort, LPCTSTR sUserName, LPCTSTR sPass)


'===========================================================
'Dll回调函数，所有都以Exe开头

'获得用户常用信息   'parm是字符串，其中为"City:深圳;Province:广东;"这样的格式
Sub ExeSetTimer(ByVal nVer As Long, ByVal nTimerID As Long, ByVal Interval As Long, ByVal parm As String)

'Sub ExeSetTimer(ByVal nTimerID As Long, ByVal Interval As Long, ByVal parm As String)
   lmsg "ExeSetTimer:: Timer: " & nTimerID & " interval: " & Interval & "Parm: " & parm
'If Interval = 0 Then
 '   Form1.DllTimer.Enabled = False
  '  Form1.DllTimer.Interval = Interval
'Else
 '   Form1.DllTimer.Enabled = True
  '  Form1.DllTimer.Interval = Interval
'End If

End Sub



''用户上线   i是状态, parm是 IP=Port=防火墙状态=IP=Port...
 Sub ExeUserOnline(ByVal nVer As Long, ByVal UIN As Long, ByVal nStatus As Integer, ByVal parm As String)

' Sub ExeUserOnline(ByVal UIN As Long, ByVal nStatus As Integer, ByVal parm As String)
     lmsg "   "
    lmsg "::::::::ExeUserOnline::::::::::::::::::: 用户: " & UIN & ", 状态: " & nStatus & ", 字符信息：" & parm
    Debug.Print "::::::::ExeUserOnline::::::::::::::::::: 用户: " & UIN & ", 状态: " & nStatus & ", 字符信息：" & parm
    
Form1.Text1.Text = Form1.Text1.Text & vbCrLf & "进入函数ExeUserOnline，参数：用户: " & UIN & ", 状态: " & nStatus & ", 字符信息：" & parm
 End Sub

 

''获得好友列表, parm为好友及组信息
'parm为：组号=组名=Nick Name=是否需要验证=图标ID=UIN=在线状态
'如果是BATCH_FLASH_CONTACT_LIST ，就是 组号=组名=Nick Name=是否需要验证=图标ID=UIN=在线状态=WebServerIP=WebServerPort

'LHJ 在线状态在这里并没有什么用，因为会有可见好友信息吧，
Sub ExeReqContactList(ByVal nVer As Long, ByVal UIN As Long, ByVal i As Long, ByVal parm As String)


'Sub ExeReqContactList(ByVal UIN As Long, ByVal i As Long, ByVal parm As String)
   
   'Use = parm
   lmsg "  "
    lmsg "ExeReqContactList::::::::::::: UIN: " & UIN & ", i:" & i & ", parm: " & parm
    Debug.Print "ExeReqContactList::::::::::::: UIN: " & UIN & ", i:" & i & ", parm: " & parm
    Form1.Text1.Text = Form1.Text1.Text & vbCrLf & vbCrLf & "ExeReqContactList::::::::::::: UIN: " & UIN & ", i:" & i & ", parm: " & parm
 
 
   addContactList (parm)
 
 
'
'  Dim UserB() As String
'  Dim iii As Integer
'  Dim iiii As Integer
'   Dim GroupNameNo As Integer, UserFriend() As String
'    Dim FriendNum As Long, Group() As String, GroupNum As Long, ii As Long
'    Dim GroupName As String
'    Dim UserFriendOne() As String
'    Dim sNick As String
'    Dim sIcon As String
'    Dim sIP As String
'    Dim nPort As Long
'    Dim theUIN As Long
'    Dim USER_ITEMS As Integer
'    USER_ITEMS = 7   '一个用户数据包括的字段数
'
'  UserB = Split(parm, "`")
'  GroupNum = UBound(UserB)
''
''   'Form1.TreeView1.Nodes.Add "root", tvwChild, UserB(1), UserB(1)
'' ' MsgBox GroupNum, vbCritical
''
' If GroupNum < USER_ITEMS Then
'       '如果只有组，无成员
'       'lmsg "如果只有组，无成员: " & UserB(0), UserB(1)
'     Debug.Print "如果只有组，无成员: " & UserB(0), UserB(1)
'      Form1.TreeView1.Nodes.Add "root", tvwChild, UserB(1), UserB(1)
'   Else
'
'
'     ' MsgBox "adad", vbCritical
'   '    Form1.TreeView1.Nodes.Add "root", tvwChild, UserB(1), UserB(1)
'          Dim IconID As Integer
'           '如果为7
'
'            For ii = 0 To ((GroupNum - 2) / USER_ITEMS) - 1
'        '        theUIN = CLng(UserB(2 + 3 + USER_ITEMS * ii))
'        '         sIcon = UserB(2 + 2 + USER_ITEMS * ii)
'        '         sNick = UserB(2 + 0 + USER_ITEMS * ii)
'        '         sIP = UserB(2 + 5 + USER_ITEMS * ii)
'        '         If Len(UserB(2 + 6 + USER_ITEMS * ii)) > 0 Then
'        '            nPort = CLng(UserB(2 + 6 + USER_ITEMS * ii))
'        '         Else
'       ''             nPort = 0
'         ''        End If
'        ' '        lmsg "ExeReqContactList::ListAllUser1.AddMemberOne 组号: " & UserB(0) & " 组名: " & UserB(1) & _
'         '       " 用户: " & theUIN & _
'         '       " Nick: " & sNick & _
'        ''        " 是否需要验证: " & UserB(2 + 1 + USER_ITEMS * ii) & _
'                " 图标ID : " & sIcon & _
'         ' '      " 在线状态: " & UserB(2 + 4 + USER_ITEMS * ii) & _
'                " IP地址: " & sIP & _
'         '       " 端口:  " & CStr(nPort)
'            '  Debug.Print " 在线状态: " & UserB(2 + 4 + USER_ITEMS * ii)
'              ' Dim IconID As Integer
'           '     IconID = CInt(sIcon)
'           '     If IconID > HEADER_IMAGE_COUNT Then
'           '         IconID = 0
'           '     End If
'       If UserB(2 + 0 + USER_ITEMS * ii) <> "" Then
'          Form1.TreeView1.Nodes.Add UserB(1), tvwChild, UserB(2 + 0 + USER_ITEMS * ii) + "'" + UserB(5 + 0 + USER_ITEMS * ii) + "'", UserB(2 + 0 + USER_ITEMS * ii) + "'" + UserB(5 + 0 + USER_ITEMS * ii) + "'", UserB(4 + 0 + USER_ITEMS * ii) + 1
'       End If
'       'Call CmdReqInfoDll(AddressOf ExeAdvSearch, 0)
'
'
'        Next ii
'
'
'' Form4.Text1 = para
'
' Form1.TreeView1.Nodes(1).Expanded = True
' End If
'
 End Sub


 
'获得用户常用信息   'parm是字符串，其中为"City:深圳;Province:广东;"这样的格式
 Sub ExeUserInfo(ByVal nVer As Long, ByVal UIN As Long, ByVal i As Long, ByVal parm As String)

 'Sub ExeUserInfo(ByVal UIN As Long, ByVal i As Long, ByVal parm As String)
    ''parm是 以下顺序，用=号分开
    'IconID=nick=UserName=BAuthType=Bsex=nAuthGroup=nip=nPort=city=province=country
    '=nLanStatus=age=sMoblie=nStatus=Email
 lmsg ":::::ExeUserInfo:::::::::: UIN: " & UIN & ", i:" & i & ", parm: " & parm
  Debug.Print ":::::ExeUserInfo:::::::::: UIN: " & UIN & ", i:" & i & ", parm: " & parm
  Dim UserBaseData() As String, ddd As String, pic As String, OnLineOrOffLine As Integer
  UserBaseData = Split(parm, "`")
 
  lmsg UIN & AddGroupsName
  lmsg "povince:" & UserBaseData(9)
  lmsg "country:" & UserBaseData(10)
  lmsg "nLanStatus:" & UserBaseData(11)
  lmsg "age:" & UserBaseData(12)
  lmsg "sMoblie:" & UserBaseData(13)
  lmsg "nStatus:" & UserBaseData(14)
  lmsg "Eail:" & UserBaseData(15)
  lmsg "City:" & UserBaseData(8)
  lmsg "UserIp:" & UserBaseData(6)
  lmsg "UsrPort:" & Val(UserBaseData(7))
  lmsg "UserNick" & UserBaseData(1)
  lmsg "UserPic:" & pic
    
   g_stSelUser.sIP = UserBaseData(6)
   g_stSelUser.nPort = Val(UserBaseData(7))
   '
   Debug.Print ":::::ExeUserInfo:::::::::: UIN: ; g_stSelUser.sIP; ; " & g_stSelUser.sIP
End Sub


Sub ExeLocalErr(ByVal nVer As Long, ByVal code As Integer, ByVal cmd As Long, ByVal parm As String)
      '  MsgBox "ExeSysMsg " & code & " cmd= " & i & "parm=" & parm
lmsg " "
lmsg "ExeLocalErr: code: " & code & ", cmd:" & cmd & ", parm: " & parm
   
        
End Sub



'收到某人发的消息
Sub ExeGetMsg(ByVal nVer As Long, ByVal UIN As Long, ByVal nType As Long, ByVal msg As String, ByVal sIP As String, ByVal nPort As Long)

'Sub ExeGetMsg(ByVal UIN As Long, ByVal nType As Long, ByVal msg As String, ByVal sIP As String, ByVal nPort As Long)
     lmsg ":::::ExeGetMsg:::::::::::: UIN: " & UIN & ", nType:" & nType & ", Msg:" & msg & "IP: " & sIP & " : " & nPort
      
     'DealWithRecievedMsg False, UIN, nType, msg, "", sIP, nPort
     Debug.Print ":::::ExeGetMsg:::::::::::: UIN: " & UIN & ", nType:" & nType & ", Msg:" & msg & "IP: " & sIP & " : " & nPort

   Form1.Text1.Text = Form1.Text1.Text & vbCrLf & vbCrLf & "收到信息:::::ExeGetMsg:::::::::::: UIN: " & UIN & ", nType:" & nType & ", Msg:" & msg & "IP: " & sIP & " : " & nPort


'     If g_stSelUser.UIN <> UIN Then
'     'MsgBox Msg
'     g_sendMessage = True
'
'     g_stSelUser.UIN = UIN
'     g_stSelUser.sIP = sIP
'     g_stSelUser.nPort = nPort
'
'   Form4.Label1.Caption = Form4.Label1.Caption + CStr(g_stSelUser.UIN)
'  Form4.Caption = Form4.Caption + CStr(g_stSelUser.UIN)
'
'     Form4.Show
'     Form4.Text1.Text = Form4.Text1.Text + CStr(g_stSelUser.UIN) + "说说" + msg + vbCrLf
'    Else
'     Form4.Text1.Text = Form4.Text1.Text + CStr(g_stSelUser.UIN) + "说说" + msg + vbCrLf
'   End If
   
End Sub


Sub ExeLanStatus(ByVal nStatus As Integer, ByVal NoUse As Long, ByVal parm As String)
    lmsg " "
    lmsg "ExeUserStatusChange:::::::::::::::::: UIN: " & nStatus & ", i:" & NoUse & ", parm: " & parm
    
     'derug.Print "ExeUserStatusChange:::::::::::::::::: UIN: " & nStatus & ", i:" & NoUse & ", parm: " & parm
    
       MsgBox "ExeLanStatus " & nStatus
         
    '     If e = E_LOGIN_SUC Then
    '        myUin = i
    '     End If
End Sub

'需要显示的广告
'UIN 是广告ID, i是类型 sContent是广告内容
Sub ExeAdvertisement(ByVal nVer As Long, ByVal UIN As Long, ByVal i As Long, ByVal sContent As String)
'  '  MsgBox "ExeFriendAuth:" & Uin & Why
'    lmsg " "
'    lmsg "ExeAdvertisement: UIN: " & UIN & ", i:" & i & ", sContent: " & sContent
'
'    g_nAdvNum = g_nAdvNum + 1
'    If g_nAdvNum > 6 Then
'        ReDim Preserve g_stAdv(g_nAdvNum)
'    End If
'
'    g_stAdv(g_nAdvNum - 1).nAdvID = UIN
'    g_stAdv(g_nAdvNum - 1).sContent = sContent
'
'
'    '
'    If UIN = ADV_SYS_MSG_URL Or UIN = ADV_SYS_MSG Then
'        frmMain.TimerStartAdv.Interval = 3000  '3秒再显示弹出式广告
'        frmMain.TimerStartAdv.Enabled = True
'    End If
'
'    If UIN = ADV_CHANNEL_1 Then
'        frmMain.BtnTaps(2).Visible = True
'    End If
'    If UIN = ADV_CHANNEL_2 Then
'        frmMain.BtnTaps(3).Visible = True
'    End If
'     If UIN = ADV_CHANNEL_3 Then
'        frmMain.BtnTaps(5).Visible = True
'    End If
'
  
   
End Sub


'收到某人发的留言消息ByVal nVer As Long, ByVal UIN As Long, ByVal i As Long, ByVal msg As String, ByVal sTime As String)
Sub ExeGetLeaveMsg(ByVal nVer As Long, ByVal UIN As Long, ByVal i As Long, ByVal msg As String, ByVal sTime As String)
'    'MsgBox "ExeGetLeaveMsg: " & UIN & ", " & i & ", " & Msg & ", " & stime
'    lmsg "::::::ExeGetLeaveMsg:::::::::::::::::: " & UIN & ", " & i & ", " & msg & ", " & sTime
'    '收到信息 UIN, i, Msg
''    LeaveMsg = LeaveMsg + LTrim(str(UIN)) + "<=>" + LTrim(str(i)) + "<=>" + msg + "<==>"
'
'Debug.Print "::::::ExeGetLeaveMsg:::::::::::::::::: " & UIN & ", " & i & ", " & msg & ", " & sTime
'  MsgBox "ax"
'  g_blleavemsg = True
'    'Dim i As Integer
'    Dim count As Integer
'    Dim childcount As Integer
'    Dim str As String
'    Dim uin1() As String
'    If UIN <> Form2.Combo2.Text Then
'   ' MsgBox "上线" & nStatus
'    Dim ii As Integer
'    count = Form1.TreeView1.Nodes.count
'
'    'MsgBox str
'    For ii = 2 To count
'    childcount = Form1.TreeView1.Nodes(ii).Children
'    If childcount = 0 And Form1.TreeView1.Nodes(ii).Parent <> Form1.TreeView1.Nodes(1) Then
'    str = Form1.TreeView1.Nodes(ii).Text
'    uin1 = Split(str, "'")
'
'    If UIN = CInt(uin1(1)) Then
'
'   g_commonUid = msg + "'" + CStr(UIN) + "'"
'   'g_stSelUser.uin = uin
'
'   Dim str1() As String
'  ' str1 = Split(g_commonUid, "'")
'  '  While g_clickevent <> True
'
'  ' Form1.TreeView1.Nodes(ii).Bold = False
'  '  Form1.TreeView1.Nodes(ii).BackColor = &H80000005
'
'    'Form1.TreeView1.Nodes(i).
'     ' Sleep (500)
'   'delay (1)
'
'   '  Form1.TreeView1.Nodes(ii).Bold = True
'   ' Form1.TreeView1.Nodes(ii).BackColor = &H80000013
'   ' delay (1)
'   ' Sleep (500)
'
'
'   ' Wend
'
'
'    End If
'    Else: 'ii = ii + 1
'
'
'    End If
'    Next ii
'    End If
'
' Form4.Text1.Text = Form4.Text1.Text + CStr(UIN) + "说说" + msg + "  " + CStr(sTime) + vbCrLf
'
'

End Sub

'#define BATCH_VIS_LIST      2       //可见list         parm是 UIN=Status=nIP=nPort=防火墙
'
Sub ExeAdvSearch(ByVal nVer As Long, ByVal UIN As Long, ByVal i As Long, ByVal parm As String)

''Sub ExeAdvSearch(ByVal UIN As Long, ByVal i As Long, ByVal parm As String)
'  'MsgBox "ExeAdvSearch " & Uin & " " & i & " " & parm
'  lmsg "ExeAdvSearch批量用户下来::::::: UIN: " & UIN & "i: " & i & "parm: " & parm
'  Debug.Print "ExeAdvSearch批量用户下来::::::: UIN: " & UIN & "i: " & i & "parm: " & parm
''Nick=bAuth=IconID=UIN=bOnline
''#define BATCH_CONTACT_LIST  1       //好友列表
''#define BATCH_VIS_LIST      2       //可见list
''#define BATCH_SEARCH_LIST   3       //查找到的list
''           Nick=bAuth=City=IconID=UIN=bOnline
'