procedure TForm1.Button3Click(Sender: TObject);

type aob=array [0..10000000] of byte;

var str:string;

    i:integer;

    fs:longint;

    iw,ih:integer;

    bi:tagbitmapinfo;

    bits:pointer;

    src:^aob;

    numwritten,temp:integer;

    cnt:longint;

    destlen:longint;

    f:file;

    tmp:cardinal;

    opt:byte;

label exitproc;

begin

  enablecancel('Capturing');

  status.panels[1].text:='Server is capturing... Be patient';

  client.socket.SendText('screen?'#13);

  {captscriscaller:=true;}

  str:=wait_n_receive;

  if str='' then begin

    goto exitproc;

  end;

  i:=pos('x',str);

  iw:=strtoint(copy(str,0,i-1)); ih:=strtoint(copy(str,i+1,length(str)-i));

  client.socket.SendText('n!'#13);

  captscriscaller:=true; str:=wait_n_receive;

  if str='' then begin

    goto exitproc;

  end;

  i:=pos('?',str);

  if copy(str,0,i-1)='sending' then begin

    if str[i+2]='.' then begin

      opt:=byte(str[i+1])-48; i:=i+2;

    end else begin

      // support for old versions below 1.15

      opt:=1; // 1=nonzero

    end;

    fs:=strtoint(copy(str,i+1,length(str)-i));

    getmem(src,fs+100);

    form1.status.panels[1].text:='0%';

    form1.client.socket.sendtext('c!'#13); cnt:=0;

    repeat

      temp:=0;

      tmp:=gettickcount;

      repeat

        Application.ProcessMessages;

        numwritten:=form1.client.socket.receivelength;

        form1.client.socket.ReceiveBuf(pointer(longint(src)+cnt)^,numwritten);

        temp:=temp+numwritten;

        if unconnected then exit;

        if tmp+20000<=gettickcount then begin

          messagedlg('Server is not answering, try to Reconnect.',mterror,[mbok],0);

          client.Socket.Close;

          exit;

        end;

      until (temp>=8192)or(temp>=fs-cnt);

      if cancel then begin

        goto exitproc;

      end else

        form1.client.socket.sendtext('n!'#13);

      cnt:=cnt+temp;

      form1.status.panels[1].text:=inttostr(100*cnt div fs)+'%  ('+inttostr(cnt)+'/'+inttostr(fs)+')';

    until cnt>=fs;

    form1.client.socket.sendtext('n!'#13);

  end else begin

    status.panels[1].text:='Error happened';

    goto exitproc;

  end;

  status.panels[1].text:='Ready!';

 

  disablecancel;

 

  destlen:=iw*ih*3;

  getmem(bits,destlen+1000);

 

  if opt=0 then begin

    lzo1x_decompress(src,fs,bits,@destlen,nil);

  end else

    uncompress(bits,destlen,src^,fs);

 

//  assignfile(f,'lastpic.gz'); rewrite(f,1);

//  blockwrite(f,src^,fs); closefile(f);

 

//  assignfile(f,'lastpic.tmp'); rewrite(f,1);

//  blockwrite(f,bits^,destlen); closefile(f);

 

  freemem(src);

  form2.Height:=screen.height; form2.width:=screen.width;

  form2.top:=0; form2.left:=0;

  form2.show;

  bi.bmiHeader.biSize:=sizeof(tbitmapinfoheader);

  bi.bmiHeader.biWidth:=iw;

  bi.bmiHeader.biHeight:=ih;

  bi.bmiHeader.biPlanes:=1;

  bi.bmiHeader.biBitCount:=24;

  bi.bmiHeader.biCompression:=BI_RGB;

  bi.bmiHeader.biSizeImage:=0;

  bi.bmiHeader.biClrUsed:=0;

  bi.bmiHeader.biClrImportant:=0;

  stretchdibits(getwindowdc(getdesktopwindow),0,0,iw,ih,0,0,screen.width,screen.height,bits,bi,DIB_RGB_COLORS,SrcCopy);

  freemem(bits);

 

exitproc:

  form1.client.socket.sendtext('e!'#13);

  disablecancel;

  cancel:=false;

end;

program ScrShop;

uses

  Windows,

  Messages;

 

 

Function ApiScrCapture(FileName:String):HDC;

Type

  TScr = array [0..10000000*3] of Byte;

  PScr =  ^TScr;

var

  TBmp     : TBitmap;

  hBmp     : hBitmap;

  DeskDC   : hDC;

  DC       : hDC;

  BmpInfo  : tagBitmapInfo;

  ScrX,ScrY: Integer;

  F        : File;

  ScrSize  : Cardinal;

  Bits     : PScr;

begin

  GetMem(Bits,ScrSize);

  SCRX     := GetSystemMetrics(SM_CXSCREEN);

  SCRY     := GetSystemMetrics(SM_CYSCREEN);

  ScrSize  := ScrX*ScrY*3;

  New(bits);

 

  DeskDC   := GetWindowDC(GetDesktopWindow);

  hBmp     := CreateCompatibleBitmap(deskdc,ScrX,ScrY);

  DC       := CreateCompatibleDC(DeskDC);

 

  SelectObject(dc,hbmp);

  BitBlt(Dc,0,0,SCRX,SCRY,deskdc,0,0,SrcCopy);

 

  BmpInfo.bmiHeader.biSize:=sizeof(tagBitmapInfoHeader);

  BmpInfo.bmiHeader.biBitCount:=0;

  GetDiBits(DeskDC,hBmp,0,SCRY,nil,BmpInfo,DIB_RGB_COLORS);

 

  BmpInfo.bmiHeader.biWidth:=SCRX;

  BmpInfo.bmiHeader.biHeight:=SCRY;

  BmpInfo.bmiHeader.biPlanes:=1;

  BmpInfo.bmiHeader.biBitCount:=24;

  BmpInfo.bmiHeader.biCompression:=BI_RGB;

  BmpInfo.bmiHeader.biSizeImage:=ScrSize;

  BmpInfo.bmiHeader.biClrImportant:=0;

 

  GetDiBits(DeskDC,hbmp,0,SCRY,Bits,BmpInfo,DIB_RGB_COLORS);

  DeleteObject(hbmp);

  Result:=DeskDC;

//------- Что то не сохраняется :( -------//

  AssignFile(F,FileName);

  Rewrite(F,1);

  Blockwrite(F,bits^,ScrSize);

  closeFile(F);

  FreeMem(Bits,ScrSize);

end;

 

 

begin

  ApiScrCapture('1.bmp');

end.