⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 这是一个非常好的教师和学生沟通用的电子教室!
💻 PAS
📖 第 1 页 / 共 5 页
字号:
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 + -