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

📄 unit2.~pas

📁 自己不会写
💻 ~PAS
字号:
unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  JPEG,Dialogs, StdCtrls, ExtCtrls, ComCtrls, Buttons, ScktComp;

type
  TForm2 = class(TForm)
    cs: TClientSocket;
    Button1: TButton;
    pb1: TProgressBar;
    Panel1: TPanel;
    img: TImage;
    Panel2: TPanel;
    BitBtn9: TBitBtn;
    BG: TButton;
    procedure csError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure csRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BGClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure BitBtn9Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var   Form2: TForm2;
      SM:Tmemorystream;
      JPGS:Tjpegimage;
      fsSend: TFileStream;
      kks:integer;
const bufsize=2048;

implementation

uses Unit1;


{$R *.dfm}

procedure TForm2.csError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin//出错时
  ErrorCode:=0;
end;

procedure TForm2.csRead(Sender: TObject; Socket: TCustomWinSocket);
var buf:array[0..bufsize] of char;
    NS:integer;
    sRecv:string;
    buff:pointer;
    lh:Integer;
begin//收到消息时
  if form2.Caption ='远程屏幕查看 ^-^' then
  begin
   NS:=CS.socket.ReceiveLength;
   CS.socket.receiveBuf(buf,NS);
   CS.socket.SendText('701');
   SM.Write(buf,NS);
   if NS<2048 then  begin
      SM.Position :=0;
      try
         JPGS.LoadFromStream(SM);
         img.Picture.Bitmap.Assign(JPGS);
      except
      end;
      SM.Clear ;
   end;
  end
 else
  begin
   sRecv:=CS.Socket.ReceiveText;
   sRecv:=copy(sRecv,1,3);
  case strtoint(sRecv) of
333:begin
        fsSend:=TFileStream.Create(form1.UPFI.FileName,fmOpenRead);
        CS.Socket.SendText('000');
        kks:=1;
    end;
555:begin
        if kks=0 then exit;
        if fsSend.Position< fsSend.Size then
          begin
           pb1.Max:=fssend.Size;
           lh:=fsSend.Size-fsSend.Position;
           pb1.Position :=fssend.Position ;
           if lh>8192 then lh:=8192;
           GetMem(buff,lh);
           try
              fsSend.Read(buff^,lh);
              CS.Socket.SendBuf(buff^,lh);
           finally
              FreeMem(buff,lh);
           end;
          end
        else
          begin
           CS.Socket.SendText('999');
           form2.Caption :='文件已发送完毕!';
           fsSend.Free;
           kks:=0;
          end;
        end;
  end;
  end;
end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin//退出时
  if form2.Caption <>'远程屏幕查看 ^-^' then exit;
  CS.Socket.SendText('710');
  CS.Active:=false;
end;

procedure TForm2.BGClick(Sender: TObject);
begin//开始抓屏时
 SM:=Tmemorystream.Create ;
 JPGS:=Tjpegimage.Create ;
 CS.Socket.SendText ('701');
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
  CS.Socket.SendText('111');
end;

procedure TForm2.BitBtn9Click(Sender: TObject);
var bmpnam:string;
    MyJPEG : TJPEGImage;
    MyBMP : TBitmap;
    a,s:tdatetime;
    i:integer;
    vv,p:string;
begin//图片保存
  s:=date; a:=time;
  vv:=timetostr(a);
  i:=pos(':',vv);
  p:=copy(vv,1,i-1);
  vv:=copy(vv,i+1,length(vv));
  i:=pos(':',vv);
  p:=p+copy(vv,1,i-1);
  vv:=copy(vv,i+1,length(vv));
  p:=p+vv;

  img.Picture.SaveToFile(p);
  application.MessageBox('图片保存完毕!','恭喜');

  MyBMP := TBitmap.Create;
  MyJPEG:= TJpegimage.Create;
  MyBMP.LoadFromFile(p);
  MyJPEG.Assign(MyBMP);
  MyJPEG.CompressionQuality:=40;
  MyJPEG.SaveToFile(p);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -