Парсер сайтов без графического интерфейса

program WinApiParser;
uses Windows,WinSock,SysUtils,RegExp;
const _n=#13#10; _nn=_n+_n; _t=#9;
 
////////////////////////////////////////////////////////////////////////////////FUNCS>>>
 
function getHttp(url,page:string; ip:string=''):string;
var
  info:WSADATA;
  sin:sockaddr_in;
  hostent:pHostEnt;
  sHwnd:integer;
  s,t:string;
  sBuff,rBuff:array[0..65535]of char;
  hostname:array[0..255]of char;
  addr:pchar;
  p:word;
begin try
  if url='' then url:=ip;
  WSAStartup(makeword(1,1),info);
  if ip='' then try
    gethostname(hostname,sizeof(hostname));
    strpcopy(hostname,url);
    hostent:=gethostbyname (hostname);
    if assigned(hostent)then begin
     if assigned(hostent^.h_addr_list)then begin
       addr:=hostent^.h_addr_list^;
       if assigned(addr)then begin
         ip:=format('%d.%d.%d.%d',[byte(addr[0]),byte(addr[1]),byte(addr[2]),byte(addr[3])]);
       end;
     end;
    end;
  except ip:='';end;
  sHwnd:=Socket(AF_INET,SOCK_STREAM,0);
  sin.sin_family:=AF_INET;
  sin.sin_port:=htons(80);
  sin.sin_addr.S_addr:=inet_addr(pchar(ip));
  connect(sHwnd, sin, sizeof(sin));
  s:='GET /'+page+' HTTP/1.1'+_n+'User-Agent: ManualSender/1.0'+_n+'Host: '+url+_nn;
  CopyMemory(@sBuff,pchar(s),length(s));
  send(sHwnd,sBuff,length(sBuff),0);
  recv(sHwnd,rBuff,length(rBuff),0);
  t:=string(rBuff);
  CloseSocket(sHwnd);
  WSACleanup;
  p:=pos(_nn,t);
  if p>0 then t:=copy(t,p+length(_nn),length(t)-p-length(_nn)+1);
  p:=pos(_n,t);
  if p>0 then t:=copy(t,p+length(_n),length(t)-p-length(_n)+1);
  result:=t;
except result:='';end;end;
 
function pow(k:cardinal;s:byte):cardinal;{k^s}
var i:byte;
begin
  result:=1;
  for i:=1 to s do result:=result*k;
end;
 
function HexCh(c:char):byte;
begin
  if c in['0'..'9']then result:=ord(c)-$30
    else result:=ord(c)-$37;
end;
 
function HexToInt(s:string;def:cardinal=0):cardinal;
var k,n:byte;
begin
  result:=def;
  if length(s)<1 then exit;
  if s[1]in['#','$']then delete(s,1,1);
  if length(s)>8 then setLength(s,8);
  while length(s)<8 do s:='0'+s;
  s:=upperCase(s);
  for k:=1 to 4 do begin
    n:=HexCh(s[k*2-1])*16+HexCh(s[k*2]);
    result:=result+n*pow(16,(4-k)*2);
  end;
end;
 
function strRpl(s,s1,s2:string):string;
var i:word;r:string;
begin
  i:=pos(s1,s);
  r:='';
  while i>0 do begin
    r:=r+copy(s,1,i-1)+s2;
    delete(s,1,i+length(s1)-1);
    i:=pos(s1,s);
  end;
  result:=r+s;
end;
 
function chrcodez(s:string):string;
const chs='&#';
var i,k,d:word; r,c:string; hex:boolean;
begin
  i:=pos(chs,s);
  r:='';
  while i>0 do begin
    c:='';
    hex:=false;
    for k:=i+length(chs)to length(s)do begin
      d:=k-i-length(chs);
      if(s[k]in['0'..'9'])then c:=c+s[k] else
      if(s[k]in['A'..'F','a'..'f'])then begin
        c:=c+s[k];
        hex:=true;
      end else break;
    end;
    if length(c)>0 then begin
      if hex then c:=chr(HexToInt(c,$32))
        else c:=chr(StrToIntDef(c,$32));
      inc(d);
    end else d:=0;
    r:=r+copy(s,1,i-1)+c;
    delete(s,1,i+length(chs)-1+d);
    i:=pos(chs,s);
  end;
  result:=r+s;
end;
 
function stripTags(s:string):string;
var re:tRegExpr;
begin
  re:=tRegExpr.Create;
  s:=strRpl(s,'&nbsp;',' ');
  s:=strRpl(s,'<br>',_n);
  s:=strRpl(s,'<br/>',_n);
  s:=strRpl(s,'</div>',_n);
  s:=strRpl(s,'<hr>',_n+'----------------------------------'+_n);
  s:=strRpl(s,'<div class="message">',':~:');
  re.Expression:='\<td class\=\"ln\"\>\<pre[^\<]+';
  s:=re.Replace(s,':~:'+_n);
  re.Expression:='\<[^\>]+\>';
  s:=re.Replace(s,'');
  re.Expression:='[\ \t\f]+';
  s:=re.Replace(s,' ');
  re.Expression:='[\ \t\f]*[\n\r]+';
  s:=re.Replace(s,_n);
  re.Expression:='[\n\r\f]{2,99}';
  s:=re.Replace(s,_nn);
  re.Expression:='[\s]*\:\~\:[\s]*';
  s:=re.Replace(s,':'+_n+' ');
  re.Free;
  s:=chrCodez(s);
  s:=strRpl(s,'&quot;','"');
  result:=s;
end;
 
////////////////////////////////////////////////////////////////////////////////<<<FUNCS
 
type
  tPost=record
    num:word;
    date,user,title,post:string;
  end;
  tPosts=array of tPost;
var ps:tPosts;
 
procedure addPost(data:string);
var re:tRegExpr; k:word;
begin
  re:=tRegExpr.Create;
  re.Expression:='\<\/a\>[\s\t\n]*([\d\.]+\,\s[\d\:]+)[\s\t\n]*\<.*id\=\"postcount[^\<]+\<strong\>(\d+).*bigusername\"\>'+
  '([^\<]+).*\<strong\>([^\<]+).*\_message\_[^\>]+\>[\s\t\n]*(.*)\<\/div\>';
  if not re.Exec(data)then begin
    re.Free;
    exit;
  end;
  k:=length(ps);
  setLength(ps,k+1);
  ps[k].date:=re.Match[1];
  ps[k].num:=StrToIntDef(re.Match[2],0);
  ps[k].user:=re.Match[3];
  ps[k].title:=re.Match[4];
  ps[k].post:=re.Match[5];
  re.Free;
end;
 
var page,parsed,f:string; tx:textFile; r:tRegExpr; k,m:word; b:boolean;
begin
  try
    page:=getHttp('www.cyberforum.ru','delphi-winapi/thread943408.html');
    parsed:='';
    k:=pos('<div id="posts">',page);
    if k>0 then page:=copy(page,k+16,length(page)-k-15);
    k:=pos('<div id="lastpost">',page);
    if k>0 then page:=copy(page,0,k-1);
    r:=tRegExpr.Create;
    b:=true;
    while b do begin
      r.Expression:='\<table id\=\"post(\d+)';
      b:=r.Exec(page);
      if not b then break;
      r.Expression:='\<table id\=\"post'+r.Match[1]+'(.*)post\_thanks\_box\_'+r.Match[1];
      b:=r.Exec(page);
      if not b then break;
      addPost(r.Match[1]);
      page:=r.Replace(page,'');
    end;
    r.Free;
  except parsed:='Error: '+inttostr(GetLastError);end;
  m:=length(ps);
  if m>0 then for k:=m-1 downto 0 do begin
    parsed:=parsed+_n+'---------------------------------------------------------'+
    _n+'Ïîñò ¹'+inttostr(ps[k].num)+'  ('+ps[k].date+') îò: '+ps[k].user+_n+
    '<<< '+ps[k].title+' >>>'+_n+stripTags(ps[k].post)+_n;
  end;
  f:=changeFileExt(paramStr(0),'.log');
  assignFile(tx,f);
  rewrite(tx);
  writeln(tx,parsed);
  closeFile(tx);
  winExec(pchar('notepad.exe "'+f+'"'),SW_SHOWMAXIMIZED);
  halt;
end.