{
   This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License
  as published by the Free Software Foundation; either
  version 2 of the License, or (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit Umain;

interface
uses windows, classes, sysutils, messages, httpsend, FreeBitmap,
  FreeImage, Ufunction;

const
  wm_base = wm_user+1000;
  wm_message = wm_base+2;
  wm_message_end = wm_base+3;

type
  Tfetchsite = (fsyahoo, fsempas);

  Tfetchimg = class(TThread)
  private
    http:thttpsend;
    strlist:tstringlist;
    bitmap:TFreeWinBitmap;
    fetchcount:integer;
    lasturl:string;

    function proc_yahoo(page:integer):boolean;
    function proc_daum(page:integer):boolean;
    procedure save(rcount:integer;stream:tmemorystream);
  protected
    procedure Execute; override;
  public
    formhandle:thandle;
    keyword,targetfolder:string;
    maxfetch,startcount:integer;
    fetchsite:Tfetchsite;

    constructor CreateThread;
    destructor Destroy; override;
    procedure stop();
  end;

implementation

{Tfetchimg}
constructor Tfetchimg.CreateThread;
begin
  inherited Create(true);
  FreeOnTerminate:=false;
  http:=thttpsend.Create;
  strlist:=tstringlist.Create;
  bitmap:=TFreeWinBitmap.Create();
end;

destructor Tfetchimg.Destroy;
begin
  http.Free;
  strlist.Free;
  bitmap.Free;
  inherited Destroy;
end;

procedure Tfetchimg.stop();
begin
  http.Sock.CloseSocket;
  self.Terminate;
end;

procedure Tfetchimg.Execute;
var
  k:integer;
begin
  if targetfolder[length(targetfolder)]<>'\' then
    targetfolder:=targetfolder+'\';
  sysutils.ForceDirectories(targetfolder);

  k:=0;
  fetchcount:=0;
  while true do begin
    inc(k);
    try
      case fetchsite of
        fsyahoo:
          if proc_yahoo(k)=false then break;
        fsempas:
          if proc_daum(k)=false then break;
      end;
    except end;
    if self.Terminated then break;
    sleep(2);
  end;

  sendmessage(formhandle, wm_message_end, 0,0);  
end;

procedure Tfetchimg.save(rcount:integer;stream:tmemorystream);
var
  FreeMemoryIO1:TFreeMemoryIO;
  s,s3:string;
begin
  FreeMemoryIO1:=TFreeMemoryIO.Create(stream.Memory,stream.Size);
  try
    bitmap.LoadFromMemory(FreeMemoryIO1);
    s:=format('%s_%d.jpg',[keyword,startcount+rcount]);
    s3:=targetfolder+s;
    bitmap.Save(s3, FIF_JPEG);
    s:=format('[%d] %s ÀúÀå.',[rcount, s]);
    sendmessage(formhandle, wm_message, integer(pchar(s)),0);
  finally
    FreeMemoryIO1.Free;
  end;
end;

function Tfetchimg.proc_yahoo(page:integer):boolean;
var
  s,s1,s2,s3:string;
  find:string;
  p1,p2:integer;
begin
  result:=false;

  http.Clear;
  s:='http://kr.img.search.yahoo.com/search/images?b=%d&p=%s&subtype=Image_DB';
  s:=format(s,[(25*(page-1))+1,keyword]);

  http.HTTPMethod('get',s);
  strlist.LoadFromStream(http.Document);

  s1:=strlist.Text;
  find:='"isrc":"';
  p1:=pos(find,s1);
  while p1>0 do begin
      s2:=getvalue(s1,'"isrc":"','"');
      s2:=sysutils.StringReplace(s2,'\/','/',[rfReplaceAll]);
      if s2<>'' then begin
        if s2=lasturl then begin
          result:=false;
          break;
        end;
        http.Clear;
        http.HTTPMethod('get',s2);
        sleep(30);
        lasturl:=s2;
        inc(fetchcount);
        save(fetchcount,http.Document);
        if self.Terminated then break;
        if fetchcount>=maxfetch then begin
          result:=false;
          break;
        end else
          result:=true;
      end;
    delete(s1,1,p1+1);
    p1:=pos(find,s1);
  end;

end;

function Tfetchimg.proc_daum(page:integer):boolean;
var
  s,s1,s2,s3:string;
  find:string;
  p1,p2:integer;
begin
  result:=false;

  http.Clear;
  s:='http://search.daum.net/search?w=img&q=%s&lpp=28&color=0&size=0&shape=default&SortType=3&cp=&page=%d';
  s:=format(s,[keyword,page]);
  http.HTTPMethod('get',s);
  strlist.LoadFromStream(http.Document);

  s1:=strlist.Text;
  find:='<span id="image_img_';
  p1:=pos(find,s1);
  while p1>0 do begin
    delete(s1,1,p1+2);
    p2:=pos('</a>',s1);
    if p2>0 then begin
      s2:=copy(s1,1,p2-1);
      s2:=getvalue(s2,'<img src="','"');
      if (s2<>'') then begin
        http.Clear;
        http.HTTPMethod('get',s2);
        sleep(30);
        lasturl:=s2;
        inc(fetchcount);
        save(fetchcount,http.Document);
        if self.Terminated then break;
        if fetchcount>=maxfetch then begin
          result:=false;
          break;
        end else
          result:=true;
      end;
    end;
    p1:=pos(find,s1);
  end;

end;

end.
 
