别人用VB编写的QQ程序,部分代码看不懂,请好心人加个注释。
注册:Private Sub BUtton_Register_Click(ByVal ClickReason As FlatButton.b2kClickReason)
Register.Show
Me.Visible = False
End Sub
Private Sub Button_OK_Click(ByVal ClickReason As FlatButton.b2kClickReason)
On Error GoTo ErrHandle
If User_Name_.Text = "" Then
MsgBox "请输入用户昵称!"
User_Name_.SetFocus
End If
If Pass_.Text = "" Then
MsgBox "密码不能为空!"
Pass_.SetFocus
End If
If Pass_.Text <> Check_Pass_.Text Then
MsgBox "两次输入密码不一致!"
Check_Pass_.Text = ""
Check_Pass_.SetFocus
End If
If User_Name_.Text <> "" And Pass_.Text <> "" And Pass_.Text = Check_Pass_.Text Then
Dim Data As String
Dim Pass_Tmp As String * 18
Pass_Tmp = Pass_.Text
Dim Message As MSG_Register
Message.User_Nick_Name = User_Name_.Text
Message.User_Pass = Login.ENTry.EnCrypt(Pass_Tmp)
If User_Sex_Male.Value = True Then
Message.User_Sex = "M"
Else
Message.User_Sex = "F"
End If
Message.User_Face = Str(Scroll.Value)
Message.User_Email = User_Email_.Text
Message.User_Address = User_Address_.Text
Message.User_Note = User_Note_.Text
Data = "0x100"
Data = Data + Message.User_Nick_Name
Data = Data + Message.User_Pass + Message.User_Face
Data = Data + Message.User_Sex + Message.User_Email
Data = Data + Message.User_Address + Message.User_Note
Socket.Sock_Send(0).SendData Data
End If
ErrHandle:
Select Case Err.Number
Case 0
'MsgBox Err.Description
Socket.Note.Text = Socket.Note.Text + "Sock_Send(0): 发生错误!" + vbCrLf
Socket.Note.Text = Socket.Note.Text + "本机端口:" + Str(Socket.Sock_Send(Index).LocalPort) + vbCrLf
Socket.Note.Text = Socket.Note.Text + "错误编号:" + Str(Err.Number) + vbCrLf
Socket.Note.Text = Socket.Note.Text + "错误类型:" + Err.Description + vbCrLf
Socket.Note.Text = Socket.Note.Text + "错误解释:" + vbCrLf
Case 40006
'MsgBox Err.Description
MsgBox "请稍等,尚未连上服务器!"
Socket.Note.Text = Socket.Note.Text + "Sock_Send(0): 发生错误!" + vbCrLf
Socket.Note.Text = Socket.Note.Text + "本机端口:" + Str(Socket.Sock_Send(Index).LocalPort) + vbCrLf
Socket.Note.Text = Socket.Note.Text + "错误编号:" + Str(Err.Number) + vbCrLf
Socket.Note.Text = Socket.Note.Text + "错误类型:" + Err.Description + vbCrLf
Socket.Note.Text = Socket.Note.Text + "错误解释:尚未连上服务器!" + vbCrLf
Case Else
End Select
End Sub
登录:
Private Sub Button_OK_Click(ByVal ClickReason As FlatButton.b2kClickReason)
On Error GoTo ErrHandle
If Login.ID_.Text <> "" And Login.Pass_.Text <> "" Then
Dim New_Login As MSG_Login
Dim Tmp_ID As String * 12
Dim Tmp_Pass As String * 18
Dim ID As String
Tmp_ID = Me.ID_.Text
ID = Me.ID_.Text
Tmp_Pass = Me.Pass_.Text
With New_Login
.User_ID = Me.ENTry.EnCrypt(Tmp_ID)
.User_Pass = Me.ENTry.EnCrypt(Tmp_Pass)
End With
Dim FileObj, Obj
Set FileObj = CreateObject("Scripting.FileSystemObject")
FileObj.createfolder (ID)
'Cread File
Open App.Path & "\" & ID & "\User.ODB" For Random As #1
Close #1
Open App.Path & "\" & ID & "\Friend.ODB" For Random As #1
Close #1
Open App.Path & "\" & ID & "\BlackList.ODB" For Random As #1
Close #1
Dim Data As String
Data = "0x001" + New_Login.User_ID + New_Login.User_Pass
Socket.Sock_Send(0).SendData Data
Else
If ID_.Text = "" Then
MsgBox "ID 不能为空!"
ID_.SetFocus
End If
If Pass_.Text = "" Then
MsgBox "密码 不能为空!"
Pass_.SetFocus
End If
End If
ErrHandle:
Select Case Err.Number
Case 0
'MsgBox Err.Description
Socket.Note.Text = Socket.Note.Text + "Sock_Send(0): 发生错误!" + vbCrLf
Socket.Note.Text = Socket.Note.Text + "本机端口:" + Str(Socket.Sock_Send(Index).LocalPort) + vbCrLf
Socket.Note.Text = Socket.Note.Text + "错误编号:" + Str(Err.Number) + vbCrLf
Socket.Note.Text = Socket.Note.Text + "错误类型:" + Err.Description + vbCrLf
Socket.Note.Text = Socket.Note.Text + "错误解释:" + vbCrLf
Case 58
'Cread File
Open App.Path & "\" & ID & "\" & "PassWord.ODB" For Random As #1
Close #1
Open App.Path & "\" & ID & "\" & "User.ODB" For Random As #1
Close #1
Open App.Path & "\" & ID & "\" & "Friend.ODB" For Random As #1
Close #1
Open App.Path & "\" & ID & "\" & "BlackList.ODB" For Random As #1
Close #1
Data = "0x001" + New_Login.User_ID + New_Login.User_Pass
Socket.Sock_Send(0).SendData Data
Case 40006
'MsgBox Err.Description
MsgBox "请稍等,尚未连上服务器!"
Socket.Note.Text = Socket.Note.Text + "Sock_Send(0): 发生错误!" + vbCrLf
Socket.Note.Text = Socket.Note.Text + "本机端口:" + Str(Socket.Sock_Send(Index).LocalPort) + vbCrLf
Socket.Note.Text = Socket.Note.Text + "错误编号:" + Str(Err.Number) + vbCrLf
Socket.Note.Text = Socket.Note.Text + "错误类型:" + Err.Description + vbCrLf
Socket.Note.Text = Socket.Note.Text + "错误解释:尚未连上服务器!" + vbCrLf
Case Else
MsgBox Str(Err.Number) + Err.Description
End Select
End Sub
添加好友:
Private Sub Button_OK_Click(ByVal ClickReason As FlatButton.b2kClickReason)
On Error GoTo ErrHandle
If Main.ID.Text <> "" Then
Dim From_ID As String * 12
Dim To_ID As String * 12
From_ID = Main.ID.Text
To_ID = ID.Text
Socket.Sock_Send(0).SendData "0x012" + Login.ENTry.EnCrypt(From_ID) + Login.ENTry.EnCrypt(To_ID)
Main.User_Friend.ListItems.Add 1, Login.ENTry.EnCrypt(To_ID), To_ID, 1, 1
Unload Me
Else
End If
ErrHandle:
End Sub
查找好友:
Private Sub Button_OK_Click(ByVal ClickReason As FlatButton.b2kClickReason)
On Error GoTo ErrHandle
If Button_OK.Caption = "下一页" Then
Dim Location As String * 3
Location = Loca.Text
Socket.Sock_Send(0).SendData "0x013" + Location
List.ListItems.Clear
Else
If Button_OK.Caption = "完成" Then
Unload Me
Else
'Add User
Dim ID As String * 12
ID = Main.ID.Text
Socket.Sock_Send(0).SendData "0x012" + Login.ENTry.EnCrypt(ID) + List.SelectedItem.Key
Main.User_Friend.ListItems.Add 1, List.SelectedItem.Key, Login.ENTry.DeCrypt(List.SelectedItem.Key), 1, 1
End If
End If
ErrHandle:
End Sub
发送消息:
Private Sub Button_OK_Click(ByVal ClickReason As FlatButton.b2kClickReason)
If Me.Button_OK.Caption = "确 定" Then
If TMP.Text <> "" Then
If Note.Text <> "" Then
Dim New_Message As MSG_Chat
Dim From_ID As String * 12
Dim To_ID As String * 12
From_ID = Main.ID.Text
With New_Message
.Msg_From = Login.ENTry.EnCrypt(From_ID)
.Msg_Message = Note.Text
.Msg_To = TMP.Text
End With
Dim Data As String
Data = "0x010" + New_Message.Msg_From + New_Message.Msg_To + New_Message.Msg_Message
Socket.Sock_Send(0).SendData Data
TMP.Text = ""
Unload Me
Else
MsgBox "消息不能为空!"
Me.Note.SetFocus
End If
Else
Unload Me
End If
Else
Unload Me
End If
End Sub