2005年写的劲乐团服务器，单人版。

August 3, 2008 4 My Programs

今天翻以前移动硬盘资料的时候，发现劲乐团出来不久写的一个服务端程序。当时可能是由于不能经常上网，所以自己做了一个单机的自娱自乐 = =。

可执行文件 http://hoho.bz/blog/upload/2008/8/O2JamPS.rar 

源代码 http://hoho.bz/blog/upload/2008/8/o2jam.rar 

用VB写的。很有意思。

启动后游戏里登陆用户名为hoho 密码为qzj

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1
   BorderStyle     =   1 ‘Fixed Single
   Caption         =   "版权HOHO所有"
   ClientHeight    =   5565
   ClientLeft      =   765
   ClientTop       =   630
   ClientWidth     =   7680
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   ‘False
   MinButton       =   0   ‘False
   ScaleHeight     =   5565
   ScaleWidth      =   7680
   StartUpPosition =   3 ‘窗口缺省
   Begin VB.Frame Frame3
      Caption         =   "关于"
      Height          =   735
      Left            =   120
      TabIndex        =   6
      Top             =   4680
      Width           =   7335
      Begin MSWinsockLib.Winsock wskhttp
         Index           =   0
         Left            =   960
         Top             =   240
         _ExtentX        =   741
         _ExtentY        =   741
         _Version        =   393216
         LocalPort       =   15000
      End
      Begin VB.CommandButton Command4
         Caption         =   "Command4"
         Height          =   315
         Left            =   5280
         TabIndex        =   8
         Top             =   300
         Visible         =   0   ‘False
         Width           =   1815
      End
      Begin VB.Label Label1
         Caption         =   "my name is hoho, my qq is 2460739."
   
      ForeColor       =   &H000000FF&
         Height          =   315
         Left            =   2100
         TabIndex        =   7
         Top             =   300
         Width           =   3195
      End
   End
   Begin MSWinsockLib.Winsock wsk
      Index           =   0
      Left            =   7140
      Top             =   4740
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      LocalPort       =   15010
   End
   Begin VB.Frame Frame2
      Caption         =   "服务控制"
      Height          =   975
      Left            =   120
      TabIndex        =   2
      Top             =   3600
      Width           =   7335
      Begin VB.CommandButton Command1
         Caption         =   "傻瓜型启动劲乐团个人服务器版"
         Default         =   -1 ‘True
         Height          =   375
         Left            =   3360
         TabIndex        =   5
         Top             =   360
         Width           =   3855
      End
      Begin VB.CommandButton Command3
         Caption         =   "退出"
         Height          =   375
         Left            =   1740
         TabIndex        =   4
         Top             =   360
         Width           =   1455
      End
      Begin VB.CommandButton Command2
         Caption         =   "复位服务器"
         Height          =   375
         Left            =   120
         TabIndex        =   3
         Top             =   360
         Width           =   1455
      End
   End
   Begin VB.Frame Frame1
      Caption         =   "网络交换信息"
      Height          =   3375
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   7335
      Begin VB.TextBox Text1
         Appearance      =   0 ‘Flat
         Height          =   2895
         Left            =   180
        MultiLine       =   -1 ‘True
         ScrollBars      =   2 ‘Vertical
         TabIndex        =   1
         Text            =   "Form1.frx":57E2
         Top             =   240
         Width           =   6975
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim spass(54) As Byte
Dim fun(30) As Integer
Dim p9(8) As Byte, p10(9) As Byte, p8(7) As Byte, p4(3) As Byte, p12(11) As Byte, loadserver(54) As Byte, p16(15) As Byte, p6(5) As Byte, p5(4) As Byte
Dim room(3907) As Byte, data1(1049) As Byte, userinfo(309) As Byte, data2(79) As Byte, data3(4425) As Byte, createroom(12) As Byte, jz() As Byte
Dim finish(75) As Byte, msg(72) As Byte
Dim version As String, httpmsg1 As String, httpmsg2 As String, httpheader As String
 
Private Function enters()
Dim i As Integer
Dim str As String
str = InputBox("输入服务器IP地址或者计算机名称", "服务器连接", "127.8.8.8")
If Len(str) = 0 Then Exit Function
i = Shell("otwo 1 o2jam-patchbj02.9you.com o2jam/patch " & str & ":15000 1 1 1 1 1 1 1 1 " & str & " 15010 " & str & " 15010 " & str & " 15010 " & str & " 15010 " & str & " 15010", vbNormalFocus)
End Function
Private Sub Command1_Click()
If Dir("OTwo.exe", vbArchive + vbNormal) = "" Then
            MsgBox "把服务器程序和劲乐团放在一个目录下傻瓜型启动,谢谢!", 4096 + vbCritical, "HOHO Help System"
            Exit Sub
End If
Dim i As Integer
i = Shell("OTwo.exe 1 o2jam-patchbj02.9you.com o2jam/patch 127.8.8.8:15000 1 1 1 1 1 1 1 127.8.8.8 15010 127.8.8.8 15010 127.8.8.8 15010 127.8.8.8 15010 127.8.8.8 15010 127.8.8.8 15010 127.8.8.8 15010", vbNormalFocus)
End Sub
 
Private Sub Command2_Click()
Call resetwsk
Text1.Text = "Copyright HOHO"
End Sub
 
Private Sub Command3_Click()
End
End Sub
 
Private Sub Command4_Click()
Dim i As Integer
For i = 1 To 5
            If wsk(i).State = sckConnected Then
                        wsk(i).SendData msg()
                        addsock i, "接收帮助信息"
            End If
Next
End Sub
 
Private Sub Form_Load()
On Error GoTo xXx
version = "测试版V0.20"
Me.Caption = "O2Jam Personal Server " & version
Text1.Text = Text1.Text & vbCrLf & version
‘If Date > DateAdd("s", 1, "2005-5-3") Then
‘            MsgBox "测试期限到了！不过你可以调整系统时间到年月号或更早继续使用。", 4096 + vbApplicationModal + vbExclamation, version
‘            End
‘End If
Dim i As Integer
Dim ii As Integer
&
nbsp;
httpmsg1 = "//Lightboard" & vbCrLf & _
"欢迎您来到HOHO劲乐单机版世界！" & vbCrLf & vbCrLf & _
"//Stateroom" & vbCrLf & _
"抵制不良游戏,拒绝盗版游戏,注意自我保护,谨防上当受骗" & vbCrLf & _
"适度游戏益脑,沉迷游戏伤身,合理安排时间,享受健康生活" & vbCrLf & _
"对于单机版任何疑问或者问题,请联系QQ2460739" & vbCrLf & vbCrLf
 
httpmsg2 = "//StateWaiting" & vbCrLf & _
"欢迎使用HOHO劲乐团单机版服务器程序!" & vbCrLf & _
"F2                 : 自动更换颜色" & vbCrLf & _
"F3                 : 快速开始.单机模式没有房主" & vbCrLf & _
"F5                 : 游戏途中切换音符类型" & vbCrLf & _
"F6                 : 游戏途中调整音符帮助" & vbCrLf & _
"F7                 : 切换音符显示模式D / 3D" & vbCrLf & _
"F8                 : 切换鼠标模式window/image" & vbCrLf & _
"F9                 : 均衡器转换模式开/ 关" & vbCrLf & _
"PrintScreen        : 截图"
 
    httpheader = "HTTP/1.1 200 OK" & vbCrLf & _
    "Server: O2Jam PS/0.10" & vbCrLf & _
    "Date: Sat, 19 June 2004 00:00:00 GMT" & vbCrLf & _
    "Content-Type: text/plain" & vbCrLf & _
    "Accept-Ranges: bytes" & vbCrLf & _
    "Last-Modified: Sat, 19 June 2004 00:00:00 GMT" & vbCrLf & _
    "Content-Length: "
 
 
    ‘BLOG中,这里省略几千行代码.
    
ii = 12
For i = 1 To 20
            room(ii) = 120
            room(ii + 4) = &H60
            room(ii + 8) = 5
            room(ii + 11) = 5
ii = ii + 13
Next
Dim iii As Integer
ii = 398
For iii = 1 To 9
            For i = 1 To 30
                        room(ii) = iii
            ii = ii + 13
            Next
Next
 
wsk(0).Listen
For i = 1 To 5
            Load wsk(i)
Next
Load wskhttp(1)
wskhttp(0).Listen
Exit Sub
 
xXx:
Call enters
End
End Sub
 
 
Private Function resetwsk()
Dim i As Integer
For i = 1 To 5
            wsk(i).Close
Next
End Function
 
 
Private Function dosend(it As Integer, Index As Integer)
wsk(Index).SendData spass()
End Function
 
Private Sub wsk_ConnectionRequest(Index As Integer, ByVal requestID As Long)
 
Dim i As Integer
For i = 1 To 5
            If wsk(i).State <> sckConnected Then
                        wsk(i).Close
                        wsk(i).Accept requestID
                        Exit For
            End If
Next
If i = 6 Then
            add ("连接数已满!拒绝接入…")
            Exit Sub
End If
           
End Sub
 
Private Sub wsk_DataArrival(Index As Integer, ByVal bytesTotal As Long)
On Error Resume Next
Dim abc() As Byte
Dim fun As String
Dim iover As Integer
wsk(Index).GetData abc(), vbArray + vbByte
 
If abc(0) + abc(1) * 256 <> bytesTotal Then
            addsock Index, "非法的数据包被发现"
End If
 
 
fun = Hex(abc(3)) & Hex(abc(2))
           
Debug.Print fun
Select Case
fun
            Case "FB5"
                        addsock Index, "尝试返回房间！"
                        p9(2) = &HB6
                        p9(3) = &HF
                        p9(4) = &H0
                        p9(5) = &HE
                        p9(6) = &H0
                        p9(7) = &H0
                        p9(8) = &H0
                        wsk(Index).SendData p9()
            Case "FB0"
                        addsock Index, "一曲结束!!"
                        p6(2) = &HB1
                        p6(3) = &HF
                        p6(4) = &H0
                        p6(5) = &H1
                        wsk(Index).SendData p6()
                        For iover = 13 To 24
                                    finish(iover) = abc(iover – 9)
                        Next
                        finish(25) = abc(18)
                        finish(26) = abc(19)
                        finish(27) = abc(20)
                        finish(28) = abc(21)
                        wsk(Index).SendData finish()
                        add "Cool:" & abc(4) + abc(5) * 256 & " Good:" & abc(6) + abc(7) * 256 & " Miss:" & abc(8) + abc(9) * 256 & " Bad:" & abc(10) + abc(11) * 256 & " HI:" & abc(12) + abc(13) * 256 & " Jam:" & abc(14) + abc(15) * 256 & " Total:" & abc(18) + abc(19) * 256 + abc(20) * 65535
                        ‘For iover = 0 To bytesTotal – 1
                        ‘            Debug.Print abc(iover)
                        ‘Next
            Case "1771"
                        addsock Index, "仍然连接!"
               &nbsp
;        wsk(Index).SendData abc()
            Case "FA0"
                        addsock Index, "成功登入房间！"
                        abc(2) = &HA1
                        wsk(Index).SendData abc()
            Case "FBE"
                        addsock Index, "房间获得中…"
                        wsk(Index).SendData data1()
            Case "FB7"
                        addsock Index, "服务器数据处理.."
                        ReDim jz(bytesTotal) As Byte
                        jz(0) = bytesTotal + 1
                        jz(2) = &HB8
                        jz(3) = &HF
                        jz(4) = &H1
              
                        For iover = 5 To bytesTotal
                                    jz(iover) = abc(iover – 1)
                        Next
                        wsk(Index).SendData jz()
            Case "7D0"
                        addsock Index, "加载用户信息…"
                        wsk(Index).SendData userinfo()
            Case "FA4"
                        addsock Index, "变更颜色！拒绝!"
                        p6(2) = &HA5
                        p6(3) = &HF
                        p6(4) = &H0
                        p6(5) = &H5
            Case "7D4"
                        addsock Index, "为用户建立房间."
                        wsk(Index).SendData createroom()
            Case "FB2"
                        addsock Index, "爽色你!!"
                        p4(2) = &HB5
                        p4(3) = &HF
                        wsk(Index).SendData p4()
            Case "FAA"
                        addsock Index, "开启音乐…"
                        p12(2) = &HAB
                        p12(3) = &HF
                        p12(4) = &H0
                        p12(5) = &H0
                        p12(6) = &H0
                        p12(7) = &H0
                        p12(8) = &H9C
                        p12(9) = &HED
                        p12(10) = &H7B
                        p12(11) = &HE
                        wsk(Index).SendData p12()
            Case "FBB"
                        addsock Index, "退出房间.."
                        abc(2) = &HBC
                        wsk(Index).SendData abc()
            Case "FA2"
                        addsock Index, "FA2 Request"
                        p6(2) = &HA5
                        p6(3) = &HF
                        p6(4) = &H0
                        p6(5) = &H0
                        wsk(Index).SendData p6()
            Case "FAC"
                        addsock Index, "音乐就绪.."
                        p5(2) = &HAD
                        p5(3) = &HF
                        p5(4) = &H0
                        wsk(Index).SendData p5()
            Case "FAA"
                        addsock Index, "嘎快就死外的?"

                        p12(2) = &HAB
                        p12(3) = &HF
                        p12(4) = &H0
                        p12(5) = &H0
                        p12(6) = &H0
                        p12(7) = &H0
                        p12(8) = &H9B
                        p12(9) = &H50
                        p12(10) = &HB7
                        p12(11) = &H2
                        wsk(Index).SendData p12()
            Case "BBD"
                        addsock Index, "退出房间.."
                        p8(2) = &HBE
                        p8(3) = &HB
                        p8(4) = &H0
                        p8(5) = &H0
                        p8(6) = &H0
                        p8(7) = &H0
                        wsk(Index).SendData p8()
            Case "BB8"
                        addsock Index, "更改房间名称！拒绝"
                        p10(2) = &HB9
                        p10(3) = &HB
                        p10(4) = Asc("%")
                        p10(5) = Asc("H")
                        p10(6) = Asc("O")
                        p10(7) = Asc("H")
                        p10(8) = Asc("O")
                        p10(9) = Asc("%")
                        wsk(Index).SendData p10()
            Case "FAC"
                        addsock Index, "准备歌曲…"
                        p5(2) = &HAD
                        p5(3) = &HF

                        p5(4) = &H0
                        wsk(Index).SendData p5()
            Case "7E8"
                        p12(2) = &HE7
                        p12(3) = &H7
                        p12(4) = &H0
                        p12(5) = &H0
                        p12(6) = &H0
                        p12(7) = &H0
                        p12(8) = &HB2
                        p12(9) = &H0
                        p12(10) = &H0
                        p12(11) = &H1
                        wsk(Index).SendData p12()
            Case "7E5"
                        addsock Index, "返回星球"
                        p8(2) = &HE6
                        p8(3) = &H7
                        p8(4) = &H0
                        p8(5) = &H0
                        p8(6) = &H0
                        p8(7) = &H0
                        wsk(Index).SendData p8
            Case "3EA"
                        addsock Index, "开始获取星球信息！"
                        wsk(Index).SendData room()
            Case "3F3"
                        addsock Index, "要求获得星球信息!"
                        wsk(Index).SendData loadserver()
            Case "FB9"
                        addsock Index, "专辑房间.."
                        p6(2) = &HBA
                        p6(3) = &HF
                        p6(4) = &H0
                        p6(5) = &H0
               &nbs
p;        wsk(Index).SendData p6()
            Case "3F4", "3E8"
                        addsock Index, "准备获得星球信息!"
                        p8(2) = &HE9
                        p8(3) = &H3
                        p8(4) = &H0
                        p8(5) = &H0
                        p8(6) = &H0
                        p8(7) = &H0
                        wsk(Index).SendData p8()
            Case "13A4"
                        addsock Index, "分配客户空间!"
                        p8(2) = &HA5
                        p8(3) = &H13
                        p8(4) = &H91
                        p8(5) = &H2E
                        p8(6) = &H0
                        p8(7) = &H0
                        wsk(Index).SendData p8
            Case "3F1"
                        addsock Index, "尝试登陆游戏"
                        wsk(Index).SendData spass()
            Case "7D2"
                        addsock Index, "获得房间信息"
                        wsk(Index).SendData data2()
                        wsk(Index).SendData data3()
            Case "3EC"
                        addsock Index, "正在进入房间"
                        p16(2) = &HED
                        p16(3) = &H3
                        p16(4) = &H0
                        p16(5) = &H0
                        p16(6) = &H0
                        p16(7) = &H0
                        p16(8) = &H0
         &nbsp
;              p16(9) = &H0
                        p16(10) = &H0
                        p16(11) = &H0
                        p16(12) = &HE4 ‘A0
                        p16(13) = &H8 ‘6
                        p16(14) = &H0
                        p16(15) = &H0
                        wsk(Index).SendData p16()
            Case "3EF"
                        If abc(0) = 13 Then
                                    Dim sum As Long
                                    sum = abc(4) * 13 + abc(6) * 14 + abc(7) * 15 + abc(8) * 16 + abc(9) * 17 + abc(10) * 18 + abc(11) * 19 + abc(5)
                                    Debug.Print "sum" & sum
                                    If sum = 12345 Then
                                                addsock Index, "登陆了游戏!"
                                                p12(2) = &HF0
                                                p12(3) = &H3
                                                p12(4) = &H0
                                                p12(5) = &H0
                                                p12(6) = &H0
                                                p12(7) = &H0
                                                p12(8) = &H90
                                                p12(9) = &H23
                                                p12(10) = &H1
                                                p12(11) = &H0
                                                wsk(Index).SendData p12()
     &nbs
p;                                          Exit Sub
                                    End If
                        End If
                        addsock Index, "登陆失败!"
                        p8(2) = &HF0
                        p8(3) = &H3
                        p8(4) = &HFF
                        p8(5) = &HFF
                        p8(6) = &HFF
                        p8(7) = &HFF
                        wsk(Index).SendData p8()
            Case "FFF0"
                        addsock Index, "客户主动要求断开一个连接"
                        wsk(Index).Close
            Case Else
                        addsock Index, "未知命令:" & fun
           
End Select
If Err Then addsock Index, "接收数据出现一个错误!连接已关闭!"
End Sub
 
 
Private Sub wsk_Error(Index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
add ("套接字错误id" & Index)
wsk(Index).Close
End Sub
 
 
Private Function add(str As String)
Text1.Text = Time & ": " & str & vbCrLf & Text1.Text
End Function
 
Private Function addsock(Index As Integer, str As String)
Text1.Text = Time & "," & wsk(Index).RemoteHostIP & ": " & str & vbCrLf & Text1.Text
End Function
 
Private Sub wskhttp_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Debug.Print "okkok"
wskhttp(1).Close
wskhttp(1).Accept requestID
End Sub
 
Private Sub wskhttp_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim str As String
wskhttp(Index).GetData str
If InStr(1, str, "txt") Then
            wskhttp(Index).SendData httpheader & "599" & vbCrLf & vbCrLf & httpmsg1 & httpmsg2
ElseIf InStr(1, str, "asp") Then
            wskhttp(Index).SendData httpheader & "192" & vbCrLf & vbCrLf & "<html><body bgcolor=""#0095BF"" leftmargin=""0"" topmargin=""0"" oncontextmenu=""return false"" onselectstart=""return false"" ondragstart=""return false"">O2Jam Personal Server By HOHO</html>"
End If
End Sub
 
Private Sub wskhttp_Error(Index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
wskhttp(Index).Close
End Sub
 
Private Sub wskhttp_SendComplete(Index As Integer)
wskhttp(1).Close
End Sub
 

4 Responses

  1. crazyfiend says:
    August 5, 2008 at 5:01 pm

    荣誉虽然有人做出一个单机版了 ..是 我素V2 做的.
    但是不支持620首以上的歌曲 ..
    试一下老大的版本..
    当回小白鼠..

    Reply
  2. crazyfiend says:
    August 5, 2008 at 5:14 pm

    要换05年的系统时间 =.= 死人啊.
    还是等老大有兴趣改进吧

    Reply
  3. TROUBLEMAKER says:
    August 10, 2008 at 1:23 pm

    你好，记不记得你以前做过一个3389批量抓鸡教程？我昨天刚看完，你在工具里提供了3389批量登录器，很好用呵！请问你还有没有8088批量登录器啊？我想要，troublemaker@163.com

    hoho 于 2008-8-10 14:49:33 回复

    没有.

    Reply
  4. 冯斌 says:
    October 28, 2010 at 2:38 pm

    来次宝地，打个酱油。。。。O(∩_∩)O哈哈哈~

    Reply

Leave a Reply

Your email address will not be published. Required fields are marked *

August 2008
S M T W T F S
 12
3456789
10111213141516
17181920212223
24252627282930
31  

Archives