⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 module1.bas

📁 时通讯和P2P开发工具
💻 BAS
📖 第 1 页 / 共 3 页
字号:
Attribute VB_Name = "Module1"
Option Explicit
 '''''''''''''''''''''''''''''''''''''''''''
'版权所有
'深圳纵横网络服务有限公司  2004年10月
'
'honjan@126.com
'honjan@tom.com
'请不要删除此版权版权信息
'不得用于未经授权用途
'''''''''''''''''''''''''''''''''''''''''''

'本过程主要与P2P Dll有关, DllShareRes.dll
Public g_tag1 As String     '传递树的节点信息
Public g_intCounti As Integer

Public g_commonUid As String  '传递uin 号
Public login1 As Boolean      '判断是否ExeAdvSearch执行完毕
Public loginlist As Boolean   '判断是否ExeLoginReply执行完毕
Public g_clickevent As Boolean  '判断树结点点及事件
Public g_blleavemsg As Boolean  '判断留言事件
Public g_blAddUser As Boolean  '判断加好友事件
'Public login2 As Integer
'Public longstr As String     '字符串变量
Public g_sendMessage As Boolean   '判断是否收到信息
  

Public Const NAME_LEN = 17          '名称长度
Public Const NICK_LEN = NAME_LEN    '
Public Const CITY_LEN = 13
Public Const PROVINCE_LEN = 13
Public Const COUNTRY_LEN = 13
Public Const TIMER_ACK_CLOCK = 2
Public Const PASS_LEN = 17
Public Const EMAIL_LEN = 61
Public Const MOBLE_LEN = 15
Public Const IP_LEN = 20
Public Const COMMENT_LEN = 81
Public Const ADDR_LEN = 41
Public Const TEL_LEN = 32
Public Const JOB_LEN = 11
Public Const EDU_LEN = 9
Public Const SCHOOL_LEN = 21
Public Const CONSTELLATION_LEN = 7
Public Const TITLE_LEN = 11
'Public Const MAX_MSG_LENGTH_VB = 300
Public Const USER_URL = 41

Public Const MAX_MSG_LENGTH_VB = 400


Public str() As String


''''''''''''''''''''''''''''''
'Public Type sendUin
'bl As Boolean
'uin As Long
'ip As String
'port As Long
'firewall As Long
'End Type
'Public sendUin1 As sendUin

Public Type onlineUse
bl As Integer
UIN As String
Status As String
ip As String
port As String
firewall As Long
End Type

Public onlineUser(200) As onlineUse
'''''''''''''''''''''''''''''''''''''''''''''''''
Public Type VB_ISHOW_USER   '在VB程序中用到的用户信息结构
        UIN As Long
        IconID As Integer
        BAuthType As Integer  ';      //00 means that your client should request authorization before adding this user to the contact list.
        '//01 means that authorization is not required to add him/her to your contact list.
        bSex As Integer ';
        nAuthGroup As Integer ';
        nLanStatus As Integer '; //在防火墙内或外,是否可以点对点直连,WITH_FIREWARE 1 表示有防火墙。NO_FIREWARE     0 表示无
        age As Integer ';
        nPort As Long ';
        nStatus As Integer
        sIP  As String   '';//
        Nick As String   '/
        UserName As String  ';//
        country As String  ';
        City As String   ';
        Province As String  '
        sMoblie As String  ';
        Email As String
        nGroupIndex As Integer
        sGroupName As String
        nGroupID As Integer
End Type


'这里保存我的结构
Public g_stMe As VB_ISHOW_USER

Public g_stSelUser As VB_ISHOW_USER  '被选中的人








Public Type FACE_USER_DETAIL    '用户详细信息结构
        UIN As Long
        address As String * ADDR_LEN '地址
        name As String * NAME_LEN ' ;//真名
        comment As String * COMMENT_LEN  ';//个人介绍
        tel As String * TEL_LEN ';//电话
        job As String * JOB_LEN ';//工作
        URL As String * USER_URL  ';//个人主页
        edu As String * EDU_LEN ';//学历
        school As String * SCHOOL_LEN ';//毕业学校
        constellation As String * CONSTELLATION_LEN ';//星座
        Title As String * TITLE_LEN '职位
      '  age As Byte ';
End Type














Public Type FACE_UPDATE_USER_INFO       '更新用户信息时所需要的结构
        UIN As Long
        IconID As Byte
        BAuthType As Byte  ';      //0 means that your client should request authorization before adding this user to the contact list.
        '//01 means that authorization is not required to add him/her to your contact list.
        bSex As Byte ';
        nAuthGroup As Byte ';
   '     nLanStatus As Byte '; //在防火墙内或外,是否可以点对点直连,WITH_FIREWARE 1 表示有防火墙。NO_FIREWARE     0 表示无
        age As Byte ';
   '     nPort As Long ';
    '    nip  As String * IP_LEN ';//
        Nick As String * NAME_LEN '/
        country As String * COUNTRY_LEN ';
        City As String * CITY_LEN ';
        Province As String * PROVINCE_LEN '
        sMoblie As String * MOBLE_LEN ';
        Email As String * EMAIL_LEN ';//
 End Type

Public Type CS_REG_NEW_USR  '注册新建用户时所需要的结构
        name As String * NAME_LEN
        Nick As String * NICK_LEN
        Email As String * EMAIL_LEN
        Mobile As String * MOBLE_LEN
        sPassword As String * PASS_LEN
        nIconID As Long
        age As Byte
        sex As Byte
        bAuth As Byte
        nGroup As Byte
        country As String * COUNTRY_LEN
        City  As String * CITY_LEN
        Province As String * PROVINCE_LEN
End Type

'这个结构保存网络设置结构
Public Type SET_NET_STRUCT
     sServerIP As String
     nSrvPort As Long
     sProxyIP As String
     nProxyPort As Long
     sUserName As String
     sPass As String
     
End Type


Private Type LEAVE_MSG_STRUCT       '保存留言时用到的结构
    UIN As Long
    nType As Long
    sMsg As String
    sTime As String
End Type

Dim m_LeaveMsgArray() As LEAVE_MSG_STRUCT
Dim m_LeaveMsgNum As Integer

Public g_SetNetwork As SET_NET_STRUCT
Public g_SetNetworkNAT As SET_NET_STRUCT

'//初始化log, spath是文件名,如果只给log文件名就在当前目录
Public Declare Sub CmdiniLog Lib "DllShareRes.dll" (ByVal sPath As String, ByVal bCurrentDir As Boolean)
Public Declare Sub lmsg Lib "DllShareRes.dll" (ByVal sMsg As String)

Public AddGroupsIndex As Integer
Public AddGroupsName As String
Public LeaveMsg As String



'LHJ 但以下有可能会同时收到很多个,当好友很多时,因此如果仅用一个字符来保存是不够的喔。可以用加法
Public g_sTempVisibleList As String  '用来保存Vc发来的收到的可见好友列表字符,
Public g_sTempUserOnlineList As String  '用来保存Vc发来的收到的好友上线字符,
Public g_sTempUserLeaveMsg As String  '用来保存Vc发来的收到的留言字符,
Public g_bHasContactList As Boolean   '表示是否存在好友列表,如果好友列表还没下来,就不能处理显示上线好友的函数



'组名组号
Public Const CONTACT_LIST_STRANGER = 0   '陌生人组
Public Const CONTACT_LIST_STRANGER_STR = "陌生人"
Public Const CONTACT_LIST_WEBPAGE = 3   '网站
Public Const CONTACT_LIST_WEBPAGE_STR = "网站访客"




'以下是FrmSysMsg窗和DealWithRecievedMsg用到,表示这个窗的类型
'Public m_MsgType   会用到



'////////
'//Batch_users类型
'//////////////
'Public ThisUserId As Long

Public Const BATCH_CONTACT_LIST = 1 '      //好友列表
Public Const BATCH_VIS_LIST = 2       '    //可见list
Public Const BATCH_SEARCH_LIST = 3     '   //查找到的list
Public Const BATCH_FLASH_CONTACT_LIST = 4  'flash用户List

'状态信息
Public Const STATUS_OFFLINE = 1
Public Const STATUS_INVISIBLE = 10     '//00 01 00 00 User isn invisible
Public Const STATUS_ONLINE = 11
Public Const STATUS_NA = 16             '  // Not Available

'忙的原因,自定义的回复
Private m_sStatusNA_Reson As String

        '//下线


'''
''防火墙内外
'''''''/
Public Const WITH_FIREWARE = 11
Public Const NO_FIREWARE = 9
Public Const FIREWARE_NO_DEFINE = 0 ''未定义防火墙状态


'状态信息
'//status info
'Public g_nMyState As Integer, g_nInFaceMyState As Integer
'Public Const STATUS_OFFLINE = 1
'Public Const STATUS_OFFLINEStr = "已经下线"
'Public Const STATUS_INVISIBLE = 10     '//00 01 00 00 User isn invisible
'Public Const STATUS_INVISIBLEStr = "隐身"
'Public Const STATUS_ONLINE = 11
'Public Const STATUS_ONLINEStr = "已经上线"
'Public Const STATUS_CHAT = 12      ' // Free for chat
      '     //User is online
'Public Const STATUS_CHATStr = "我有空"
'Public Const STATUS_AWAY = 13         '    //User is away
'Public Const STATUS_AWAYStr = "不在电脑旁"
'Public Const STATUS_DND = 14             '  //Do Not Disturb
'Public Const STATUS_DNDStr = "勿打扰"
'Public Const STATUS_OCCUPIED = 15       '   //Occupied
'Public Const STATUS_NA = 16             '  // Not Available

'忙的原因,自定义的回复
'Private m_sStatusNA_Reson As String

        '//下线

    '''''''''''''''''''''/
    '关于系统消息的定义
    '''''''''''''''''''''/
'error code
Public Const E_SEND_UDP = 10000             'UDP发送本机出错
Public Const E_NOT_WAIT_NEXT = 10001                '未处于发送状态
Public Const E_MSG_NOT_REACH_PEER = 10002       '消息未能到达对方
Public Const E_USER_ALREADY_LOGIN = 10003       '用户已经登录
Public Const E_USER_NOT_FOUND = 10010           '
Public Const E_USERNAME_EXIST = 10020
Public Const E_SOKET_CREATE = 10030                 '无法创建socket

Public Const E_SUCCEED = 0                      '操作成功
Public Const E_LOGIN_SUC = 12000                    '登录成功
Public Const E_NO_UIN = 12010                   '登录不成功,用户名不存在
Public Const E_PWD = 12020                      '密码错误
Public Const E_LOGIN_FAIL = 12025               '登录不成功,其它原因
Public Const E_NEET_AUTH = 12030                    '对方需要认证
Public Const E_FRIEND_REFUSE = 12040
Public Const E_ADD_LIST_SUC = 12050                 '用户添加成功
Public Const E_ALREDY_LIST_FRIEND = 12060       '他已经是本组成员
Public Const E_DEL_LIST_SUC = 12070                 '成功删除
Public Const E_UPDATE_SUC = 12080               '服务器已经接受你的修改
Public Const E_SEARCH_NO_USER = 12090           '没找到用户
Const E_SEARCH_END = 12095                  '//已经查到最后
Public Const E_SEARCH_SQL_ERROR = 12092          ' //查找时SQL出错,是否输入不对。
Public Const E_NEED_LOGIN = 13000               '未登录
Public Const E_SEND = 13010                         '发送出错
Public Const E_NO_CONTACT_LIST = 13020            '//无好友列表
Public Const E_CONTACT_LIST_END = 13030             'constact list 结束
'检查Session的返回值
Public Const E_NO_USER = 2                  '用户不在线
Public Const E_SESSION_CORRECT = 1          'session正确
Public Const E_SESSION_ERROR = 0                'session不对

'本地错误
Public Const E_TIME_OUT = 14000                     '与服务器通讯超时未发出某个命令
Public Const E_ALLPACKAGE_TIME_OUT = 14010          '所有包都超时
Public Const E_TXT_MSG_TIME_OUT = 14020             '与Peer通讯时超时



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public FormOldWidth As Long
'保存窗体的原始宽度
Public FormOldHeight As Long
'保存窗体的原始高度

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)








'=========================================================
'Dll接口函数 所有都以Cmd开头

Public Declare Sub DllOnTimer Lib "DllShareRes.dll" (ByVal nTimerID As Integer)

'更新ContactList组名
Public Declare Sub CmdUpdateContactListNameDll Lib "DllShareRes.dll" (ByVal sGroupName As String, ByVal nGroupID As Integer)


'注册新用户
'Public Declare Sub CmdRegNewUserDll Lib "DllShareRes.dll" (ByVal addr As Long, ByVal sUserName As String, ByVal sNick As String, ByVal sPassword As String, ByVal sMobilePhone As String, ByVal sEmail As String, ByVal IconID As Integer)

Public Declare Sub CmdRegNewUserDll Lib "DllShareRes.dll" (ByVal addr As Long, NewUser As CS_REG_NEW_USR)


'更新个人基本信息(long addr, LPCTSTR sInfo)
Public Declare Sub CmdUpdateInfoDll Lib "DllShareRes.dll" (ByVal addr As Long, UserInfo As FACE_UPDATE_USER_INFO)


'更新个人详细信息(long addr, LPCTSTR sInfo)
Public Declare Sub CmdUpdateDetailInfoDll Lib "DllShareRes.dll" (ByVal addr As Long, UserDetail As FACE_USER_DETAIL)


'用来测试回调函数,无用
Public Declare Sub ExecuteCallback Lib "DllShareRes.dll" (ByVal pFunc As Long, ByVal pC As String, pos As Long)

'按一定条件查找用户常用信息sqlwhere是查的条件
Public Declare Sub CmdAdvSearchUserDll Lib "DllShareRes.dll" (ByVal addr As Long, ByVal sqlWhere As String)


'初始化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)


'查找线上朋友
Public Declare Sub CmdSearchOnlineUserDll 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)


'获得某人的全部信息
Public Declare Sub CmdReqUserDetailInfoDll Lib "DllShareRes.dll" (ByVal addr As Long, ByVal hisUIN As Long)


'//更新是否需要通过验证的状态,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)

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -