📄 main.pas
字号:
unit MAIN;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
WSocket, StdCtrls, Buttons, ExtCtrls, registry, lmdclass, lmdnwgui, Menus,
T_BIANCOLOCK, shellapi,inifiles, lmdcompo, Tongz, sndkey32,
lmdnonvS, Taolun, jushou, msacm, mmsystem,jpeg, Gmovie,
LMDCustomComponent, LMDGlobalHotKey, IPXUnit, SoundOut,
SoundIN, Winsock, LMDOneInstance, LMDWndProcComponent,
LMDTrayIcon, LMDTimer, VCLUnZip, VCLZip, LZRW1, LMDPopupMenu;
type
TForm1 = class(TForm)
SrvSocket: TWSocket;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
Panel1: TPanel;
CliSocket: TWSocket;
LMDGlobalHotKey1: TLMDGlobalHotKey;
BiancoLock1: TBiancoLock;
LMDGlobalHotKey2: TLMDGlobalHotKey;
LMDGlobalHotKey3: TLMDGlobalHotKey;
Timer1: TTimer;
LMDOneInstance1: TLMDOneInstance;
Timer2: TTimer;
WSocket: TWSocket;
WSocketHook: TWSocket;
SVoiceSocket: TWSocket;
IPX1: IPX;
LoginTimer: TTimer;
IPX2: IPX;
LoginwSocket: TWSocket;
RVoiceSocket: TWSocket;
SoundIN1: TSoundIN;
SoundOut1: TSoundOut;
WSocketsize: TWSocket;
LMDGlobalHotKey4: TLMDGlobalHotKey;
LMDTrayIcon1: TLMDTrayIcon;
PingmuTimer: TLMDHiTimer;
VCLZip1: TVCLZip;
lzrw11: Tlzrw1;
LMDPopupMenu1: TLMDPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N5: TMenuItem;
N4: TMenuItem;
function DynamicResolution(X, Y: word): BOOL;
procedure GetScreen(var bmp: TBitmap);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure SrvSocketSessionAvailable(Sender: TObject; Error: Word);
procedure CliSocketDataAvailable(Sender: TObject; Error: Word);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure LMDGlobalHotKey1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure BiancoLock1CloseQuery(Sender: TObject;
var CanClose: Boolean);
procedure LMDGlobalHotKey2KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure CliSocketSessionClosed(Sender: TObject; Error: Word);
procedure BiancoLock1Close(Sender: TObject; var Action: TCloseAction);
procedure LMDGlobalHotKey3KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure WSocketDataAvailable(Sender: TObject; Error: Word);
procedure WSocketHookDataAvailable(Sender: TObject; Error: Word);
procedure IPX1ReceiveData(Sender: TObject; Buffer: PChar;
BufferLength: Integer; SockAddr: TSockAddrIPX; SockAddrLen: Integer);
procedure LoginTimerTimer(Sender: TObject);
procedure IPX2ReceiveData(Sender: TObject; Buffer: PChar;
BufferLength: Integer; SockAddr: TSockAddrIPX; SockAddrLen: Integer);
procedure SoundIN1Data(data: Pointer; size: Integer);
procedure RVoiceSocketDataAvailable(Sender: TObject; Error: Word);
procedure PingmuTimerTimer(Sender: TObject);
procedure WSocketsizeDataAvailable(Sender: TObject; Error: Word);
procedure LMDGlobalHotKey4KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure LMDOneInstance1Custom(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N7Click(Sender: TObject);
private
{ Private declarations }
procedure WMQueryEndSession(var Msg: TMessage);
message WM_QueryEndSession;
public
{ Public declarations }
end;
var
Form1: TForm1;
confirmclose, wsh_color256: boolean; //确认关闭,是否256色广播
TmpStream: TMemoryStream; //临时内存流
BmpStream, drawstream, comstream: TMemoryStream; //采集数据
hua_ok, guangboing, draw_ok: boolean; //开始画屏,正在广播,画屏完成
image_index, len, send_streamsize, getime: integer; //图象帧,接收长度,发送流长度,学生延时
guangbo_state: string; //广播状态
teacherip: string; //老师机的IP地址
d_memo, s_computername: string;
priscreen: tbitmap;
quan_screen: boolean; //是否显示全屏幕
allsize: longint;
implementation
uses Guangbo, aboutf, soundf, heipin;
const
BufSize = 1024; { 发送每一笔数据的缓冲区大小 }
Bufsize1 = 1024;
var
Leftsize, recsize: longint;
ding_stat: string; //定时执行什么
voice_wsh, sendwav, ScreenStream: Tmemorystream;
s_guangbo, havesendvoice: boolean;
bmpmap1, nowscreen: Tbitmap;
shang_size, shang_ci: integer;
{$R *.DFM}
function SetPrivilege(PrivilegeName: String; Enable:
Boolean): Boolean;
var
NewState,
PreviousState : TTokenPrivileges;
token : THandle;
dwRetLen : DWord;
begin
Result := False;
OpenProcessToken(GetCurrentProcess,
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, token);
NewState.PrivilegeCount := 1;
if LookupPrivilegeValue(nil, PChar(PrivilegeName),
NewState.Privileges[0].LUID) then
begin
if Enable then
NewState.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
else
NewState.Privileges[0].Attributes := 0;
dwRetLen := 0;
Result := AdjustTokenPrivileges(token,
False, NewState, SizeOf(PreviousState),
PreviousState, dwRetLen);
end;
CloseHandle(token);
end;
function My_SelfHide: Boolean;
type
TRegisterServiceProcess = function(dwProcessID, dwType: DWord): DWORD; stdcall;
var
hNdl: THandle;
RegisterServiceProcess: TRegisterServiceProcess;
begin
Result := False;
if Win32Platform <> VER_PLATFORM_WIN32_NT then //不是NT
begin
hNdl := LoadLibrary('KERNEL32.DLL');
RegisterServiceProcess := GetProcAddress(hNdl, 'RegisterServiceProcess');
RegisterServiceProcess(GetCurrentProcessID, 1);
FreeLibrary(hNdl);
Result := True;
end
else
Exit;
end;
function TForm1.DynamicResolution(X, Y: word): BOOL; //改变屏幕分辨率
var
lpDevMode: TDeviceMode;
begin
Result := EnumDisplaySettings(nil, 0, lpDevMode);
if Result then
begin
lpDevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
lpDevMode.dmPelsWidth := X;
lpDevMode.dmPelsHeight := Y;
Result := ChangeDisplaySettings(lpDevMode, 0) = DISP_CHANGE_SUCCESSFUL;
end
end;
procedure TForm1.WMQueryEndSession(var Msg: TMessage); //CLOSE学生程序
begin
LoginTimer.Enabled := false;
Guangboing := false;
Msg.Result := 1;
confirmclose := true;
halt;
end;
procedure Tform1.GetScreen(var bmp: TBitmap); //截屏
var
dc: integer;
c: TCanvas;
R: TRect;
begin
bmp := TBitmap.Create;
dc := GetWindowDC(0);
try
c := TCanvas.Create;
c.Handle := dc;
R := Rect(0, 0, Screen.Width, Screen.Height);
bmp.Width := R.Right;
bmp.Height := R.Bottom;
bmp.Canvas.CopyRect(R, c, R);
c.Handle := 0;
c.Free;
finally
ReleaseDC(0, dc);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Payregistry, teaipreg: TRegistry;
wndHandle: Thandle; //关闭任务条
wndClass: array[0..50] of char;
s_install: string;
i, ip_where, n_ip_h: smallint;
s_ip, s_ip_q, s_ip_h: string;
// id:DWORD;
begin
//列举所在线程的所有的窗体
// form1.Hide;
s_install := 'ok';
Guangboing := false;
draw_ok := true;
//设置安放位置
// cishu:=0;
width := 1;
height := 1;
top := screen.Height;
left := screen.Width;
My_SelfHide;
confirmclose := false;
//得到教师的IP地址
TeaipReg := TRegistry.create;
TeaipReg.RootKey := HKEY_LOCAL_MACHINE;
if TeaipReg.OpenKey('Software\sihai', True) then
begin
teacherip := TeaipReg.Readstring('teacherip');
TeaipReg.CloseKey;
end;
TeaipReg.Free;
n_ip_h := 0;
s_ip := trim(teacherip); //取得第三个点的IP位置
s_ip_q := s_ip;
i := 0;
ip_where := 0;
while Pos('.', S_ip) > 0 do
begin
i := i + 1;
ip_where := Pos('.', S_ip);
S_ip[ip_where] := '&';
end;
if i <> 3 then teacherip := 'no';
//安装如注册表中
//若运行本程序时带'/I'参数,则安装注册登记表的登记项
PayRegistry := TRegistry.create;
PayRegistry.RootKey := HKEY_LOCAL_MACHINE;
if PayRegistry.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', True) then
begin
s_install := PayRegistry.Readstring('feiyun');
PayRegistry.CloseKey;
end;
PayRegistry.Free;
PayRegistry := TRegistry.create;
PayRegistry.RootKey := HKEY_LOCAL_MACHINE;
if PayRegistry.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', True) then
begin
PayRegistry.Writestring('feiyun', ParamStr(0));
PayRegistry.CloseKey;
end;
PayRegistry.Free;
// left := screen.Width - 110;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
SrvSocket.Close;
SrvSocket.Addr := '0.0.0.0';
SrvSocket.Port := '7509'; //端口号,可任意指定
SrvSocket.Proto := 'tcp';
try
SrvSocket.Listen;
except
Timer1.Enabled := false;
showmessage('没有安装TCP/IP协议!或没有设置IP地址!' + #13 + #10 + '无法运行本软件!');
confirmclose := true;
close;
end;
//发送登陆消息
loginwsocket.Close;
LoginwSocket.Multicast := true;
loginwSocket.Proto := 'udp';
LoginwSocket.Addr := '225.1.2.8'; // or whatever you decide
loginwSocket.Port := '1525';
loginwSocket.Connect;
LoginTimer.Enabled := true;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
i: integer;
begin
Guangboing := false;
confirmclose := true;
if clisocket.State<>wsclosed then Clisocket.Close;
if Srvsocket.State<>wsclosed then SrvSocket.Close;
if loginwsocket.State<>wsclosed then loginwsocket.Close;
if wsocket.State<>wsclosed then wsocket.close;
if wsockethook.State<>wsclosed then wsockethook.close;
if wsocketsize.State<>wsclosed then wsocketsize.close;
end;
procedure TForm1.SrvSocketSessionAvailable(Sender: TObject; Error: Word);
var
PeerName: TSockAddrIn;
// inifile: Tinifile;
teaipreg: TRegistry; //写教师IP地址
s_path: string;
begin
Panel1.Caption := '登陆成功!';
CliSocket.HSocket := SrvSocket.Accept;
//写入教师的IP地址
CliSocket.GetPeerName(PeerName, Sizeof(PeerName));
Teacherip := IntToStr(ord(PeerName.sin_addr.S_un_b.s_b1)) + '.' +
IntToStr(ord(PeerName.sin_addr.S_un_b.s_b2)) + '.' +
IntToStr(ord(PeerName.sin_addr.S_un_b.s_b3)) + '.' +
IntToStr(ord(PeerName.sin_addr.S_un_b.s_b4));
TeaipReg := TRegistry.create;
TeaipReg.RootKey := HKEY_LOCAL_MACHINE;
if TeaipReg.OpenKey('Software\sihai', True) then
begin
TeaipReg.Writestring('teacherip', teacherip);
TeaipReg.CloseKey;
end;
TeaipReg.Free;
end;
procedure TForm1.CliSocketDataAvailable(Sender: TObject; Error: Word);
var
s_receive, s_command, s_message, s_jincheng, s_path, teacher_ip, s_zhuce: string;
szText: array[0..254] of char; //进程文本
w_path: array[0..50] of char; //命令指针
close_jingcheng, close_lei: array[0..50] of char; //关闭进程指针
temp, sendsize: integer;
hCurrentWindow, close_hwnd: HWnd;
rtScreen: TRect;
Buf: array[0..BufSize - 1] of char; //屏幕信息发送缓冲
Buf1: array[0..BufSize - 1] of char; //屏幕广播 缓冲
w_command: string; //屏幕广播命令
Gmovief: TGmovief; //网上影院
jushouf: TJushouf;
bmpmap: Tbitmap;
inifile: Tinifile; //写教师IP地址 写*.CNF文件
inifilename: string; //写*.CNF文件
cshjpeg:TJPEGImage;
wndHandle, hDesktop: Thandle; //关闭任务条
wndClass: array[0..50] of char;
xieyi: integer; //协议选择
Format: PWAVEFORMATEX;
FMaxFmtSize: DWORD;
mylzh: Tlzrw1;
begin
s_jincheng := ''; //初始化进程字符串
s_receive := CliSocket.ReceiveStr; //接受字符串
s_command := copy(s_receive, 11, length(s_receive) - 10); //分解远程命令
if copy(s_receive, 1, 10) = '/*csh*/:' + #13 + #10 then
begin
if s_command = '屏幕监看' then //命令10
begin
BmpStream := TMemoryStream.Create;
bmpstream.clear;
comstream := Tmemorystream.Create;
comstream.Clear;
bmpmap := TBitmap.Create;
GetScreen(bmpmap);
bmpmap.PixelFormat :=pf8bit; //监看颜色降至为256色
bmpmap.SaveToStream (comstream);
comstream.Position := 0;
bmpmap.FreeImage;
bmpstream.Clear;
bmpstream.Position := 0;
mylzh := Tlzrw1.Create(self);
try
//mylzh.Visible := false;
mylzh.CompressMode := fast;
mylzh.UseStream := true;
mylzh.InputStream := comstream;
mylzh.OutputStream := bmpstream;
mylzh.Compress;
mylzh.Free;
except
mylzh.Free;
bmpmap.free;
bmpstream.Free;
comstream.free;
exit;
end;
BmpStream.Position := 0;
LeftSize := BmpStream.Size;
comstream.Clear;
comstream.free;
bmpmap.free;
if s_command = '屏幕监看' then
Clisocket.SendStr('/*csh*/:' + #13 + #10 + '屏幕监看' + inttostr(leftsize))
else
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -