{
   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 Ufrmfetch;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ComCtrls, Spin, httpsend2, FreeBitmap, FreeImage, shellapi;

const
  fetchinterval = 10; //분

type
  Tfrmfetch = class(TForm)
    Edit1: TEdit;
    BitBtn1: TBitBtn;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    SpinEdit1: TSpinEdit;
    Label3: TLabel;
    BitBtn2: TBitBtn;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    ComboBox1: TComboBox;
    Button3: TButton;
    Label7: TLabel;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    Button1: TButton;
    Button2: TButton;
    Label8: TLabel;
    SpinEdit2: TSpinEdit;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button3Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    function isallowfetch():boolean;
    procedure WndProc(var Message: TMessage); override;
    procedure fetchimgOnTerminate(Sender: TObject);
    procedure dllfetchimgOnTerminate(Sender: TObject);
  public
    { Public declarations }
  end;

  Tfetchsite = (fsyahoo, fsempas);

  Tfetchimg = class(TThread)
  private
    http:thttpsend2;
    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:integer;
    fetchsite:Tfetchsite;

    constructor CreateThread;
    destructor Destroy; override;
  end;

  Tdllfetchimg = class(TThread)
  private
    stopped:boolean;
  protected
    procedure Execute; override;
  public
    formhandle:thandle;
    keyword,targetfolder:string;
    maxfetch,startcount:integer;
    fetchsite:Tfetchsite;
    lasterrmsg:string;

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

var
  frmfetch:Tfrmfetch;
  fetchimg:Tfetchimg;
  dllfetchimg:Tdllfetchimg;
  dllupdatechecked:boolean=false;

implementation
uses Ufrmmain, Ufunction, Umain_hlp, Uregistry, Uconfig;
{$R *.dfm}

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

destructor Tfetchimg.Destroy;
begin
  http.Free;
  strlist.Free;
  bitmap.Free;
  inherited Destroy;
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;
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,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 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 fetchcount>=maxfetch then begin
          result:=false;
          break;
        end else
          result:=true;
      end;
    end;
    p1:=pos(find,s1);
  end;

end;

{Tdllfetchimg}
constructor Tdllfetchimg.CreateThread;
begin
  inherited Create(true);
  FreeOnTerminate:=false;
  stopped:=false;
end;

destructor Tdllfetchimg.Destroy;
begin
  inherited Destroy;
end;

type
  T_start_fetch = procedure (formhandle:thandle;keyword,targetfolder:pchar;maxfetch,startcount,fetchsite:integer); stdcall;
  T_stop_fetch = procedure (); stdcall;

procedure Tdllfetchimg.Execute;
var
  DllHandle:thandle;
  start_fetch:T_start_fetch;
  stop_fetch:T_stop_fetch;
begin
  DllHandle:=LoadLibrary(PChar(GetAppDirectory2+'fetch.dll'));
  if DllHandle>0 then begin
    start_fetch:=GetProcAddress(DllHandle, 'start_fetch');
    stop_fetch:=GetProcAddress(DllHandle, 'stop_fetch');
  end else
    lasterrmsg:='라이브러리를 읽을 수 없습니다.';
  if assigned(start_fetch) then begin
    start_fetch(formhandle,pchar(keyword),pchar(targetfolder),maxfetch,startcount,integer(fetchsite));
    while self.Terminated=false do begin
      sleep(100);
      if stopped then begin
        if assigned(stop_fetch) then begin
          stop_fetch();
          break;
        end;
      end;
    end;
  end else
    lasterrmsg:='라이브러리를 확인할 수 없습니다.';
  if DllHandle>0 then begin
    if assigned(stop_fetch) then
      stop_fetch();
    FreeLibrary(DllHandle);
  end;
end;

procedure Tdllfetchimg.stop();
begin
  lasterrmsg:='중지 되었습니다.';
  stopped:=true;
end;

{Tfrmfetch}
procedure Tfrmfetch.WndProc(var Message: TMessage);
begin
  with Message do
    case Msg of
      wm_message:begin
        label3.Caption:=pchar(wparam)+'...다음것을 받고 있습니다.';
      end;
      wm_message_end:begin
        label3.Caption:=StringReplace(label3.Caption,'...다음것을 받고 있습니다.','',[]);
        if assigned(dllfetchimg) then begin
          dllfetchimg.stopped:=true;
//          dllfetchimg.WaitFor;
//          freeandnil(dllfetchimg);
        end;
      end;
    end;
  inherited;
end;

procedure Tfrmfetch.BitBtn1Click(Sender: TObject);
var
  s:string;
  v:cardinal;
begin
  if Sender<>BitBtn1 then begin
    if MessageDlg('테스트로 40개의 조각이미지를 가져옵니다.'
      +#13#10+'가져오기가 정상적인지 확인할때 사용합니다.'
      +#13#10#13#10+'지금 테스트 가져오기를 계속 진행하시겠습니까?',
        mtConfirmation, [mbYes, mbNo], 0) = mrNo then
      exit;
  end;
  if edit1.Text='' then begin
    MessageDlg('검색어를 입력해 주세요.', mtError, [mbok], 0);
    exit;
  end;
  s:=GetAppDirectory+'mosaic_images\'+edit2.Text;
  if DirectoryExists(s) then begin
    if MessageDlg('같은 이름의 폴더가 존재합니다. 폴더 삭제를 권장합니다. 그냥 덮어씌우시겠습니까?',
       mtConfirmation, [mbYes, mbNo], 0) = mrNo then exit;
  end;

  BitBtn1.Enabled:=false;
  BitBtn4.Enabled:=false;
  BitBtn2.Enabled:=true;
  BitBtn3.Enabled:=false;
  label3.Caption:='';
  if Sender=BitBtn1 then begin
    RegSetString(HKEY_CURRENT_USER, 'software\'+thisregname+'\ft', datetimetostr(now));
    v:=0;
    RegGetDword(HKEY_CURRENT_USER, 'software\'+thisregname+'\ct', v);
    inc(v);
    if v>10 then v:=11;
    RegSetDword(HKEY_CURRENT_USER, 'software\'+thisregname+'\ct', v);
  end;

  dllfetchimg:=Tdllfetchimg.CreateThread;
  dllfetchimg.formhandle:=handle;
  dllfetchimg.keyword:=edit1.Text;
  dllfetchimg.targetfolder:=s;
  if Sender=BitBtn1 then begin
    dllfetchimg.maxfetch:=self.SpinEdit1.Value;
    dllfetchimg.startcount:=self.SpinEdit2.Value;
  end else begin
    dllfetchimg.maxfetch:=40;
    dllfetchimg.startcount:=0;
  end;
  dllfetchimg.fetchsite:=Tfetchsite(self.ComboBox1.ItemIndex);
  dllfetchimg.OnTerminate:=dllfetchimgOnTerminate;
  dllfetchimg.Resume;
end;

procedure Tfrmfetch.dllfetchimgOnTerminate(Sender: TObject);
begin
  BitBtn1.Enabled:=isallowfetch();
  BitBtn4.Enabled:=true;
  BitBtn2.Enabled:=false;
  BitBtn3.Enabled:=true;

  if dllfetchimg.lasterrmsg='' then
    MessageDlg('완료 되었습니다.', mtInformation, [mbok], 0)
  else
    MessageDlg(dllfetchimg.lasterrmsg, mtError, [mbok], 0);
end;

procedure Tfrmfetch.fetchimgOnTerminate(Sender: TObject);
begin
  MessageDlg('완료 되었습니다.', mtInformation, [mbok], 0);
end;

procedure Tfrmfetch.BitBtn2Click(Sender: TObject);
begin
  if assigned(dllfetchimg) then begin
    dllfetchimg.stop;
    dllfetchimg.WaitFor;
    freeandnil(dllfetchimg);
  end;
end;

procedure Tfrmfetch.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  BitBtn2Click(nil);
end;

function getdifftime(t:tdatetime):integer;
var
  Hour, Min, Sec, MSec: Word;
  diff:tdatetime;
begin
  diff:=now-t;
  sysutils.DecodeTime(diff, Hour, Min, Sec, MSec);
  result:=(hour*60)+Min+(round(diff)*24*60);
end;

function Tfrmfetch.isallowfetch():boolean;
var
  s:String;
  t:tdatetime;
  v:cardinal;
begin
  result:=true;
{
  v:=0;
  RegGetDword(HKEY_CURRENT_USER, 'software\'+thisregname+'\ct', v);
  if (v<=10) then begin
    result:=true;
    exit;
  end;
  RegGetString(HKEY_CURRENT_USER, 'software\'+thisregname+'\ft', s);
  t:=sysutils.StrToDateTimeDef(s,now-1);
  if (getdifftime(t)>fetchinterval) then result:=true
  else result:=false;
  }
end;

procedure Tfrmfetch.FormCreate(Sender: TObject);
begin
  ComboBox1.ItemIndex:=config.c_selectfetchidx;
  self.SpinEdit1.Value:=config.c_selectfetchcount;
  edit1.Text:=config.c_fetchkeyword1;
  edit2.Text:=config.c_fetchkeyword2;
  BitBtn1.Enabled:=isallowfetch();
  BitBtn4.Enabled:=true;

  label6.Caption:=format(label6.Caption,[fetchinterval]);
end;

procedure Tfrmfetch.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  config.c_selectfetchidx:=ComboBox1.ItemIndex;
  config.c_selectfetchcount:=self.SpinEdit1.Value;  
  config.c_fetchkeyword1:=edit1.Text;
  config.c_fetchkeyword2:=edit2.Text;
end;

procedure Tfrmfetch.Button3Click(Sender: TObject);
var
  s:String;
begin
  s:=GetAppDirectory+'mosaic_images';
  ShellExecute(Application.Handle, 'open', PChar(s), nil, nil, SW_NORMAL);
end;

procedure Tfrmfetch.BitBtn3Click(Sender: TObject);
var
  http:thttpsend2;
  strlist:tstringlist;
  s:string;
  ver,downurl:string;
  downsize:integer;
  flag:boolean;
begin
  if dllupdatechecked then begin
    MessageDlg('이미 업데이트 확인을 하였습니다.', mtinformation, [mbok], 0);
    exit;
  end;
  dllupdatechecked:=true;
  flag:=false;
  http:=thttpsend2.Create;
  strlist:=tstringlist.Create;
  screen.Cursor:=crHourGlass;
  try
    s:=format('http://iblogbox.com/nview/update/update.php?v=%s&kind=fetchdll',[GetVersion(paramstr(0))]);
    http.HTTPMethod('get',s);
    strlist.LoadFromStream(http.Document);
    s:=trim(strlist.Text);
    strlist.Clear;
    SplitString(s,strlist,',');
    if strlist.Count=3 then begin
      ver:=strlist.Strings[0];
      downurl:=strlist.Strings[1];
      downsize:=strtointdef(strlist.Strings[2],0);
      if ver>GetVersion(GetAppDirectory2+'fetch.dll') then begin
        http.Clear;
        http.HTTPMethod('get',downurl);
        if http.Document.Size=downsize then begin
          http.Document.SaveToFile(GetAppDirectory2+'fetch.dll');
          flag:=true;
        end;
      end;
    end;
  finally
    http.Free;
    strlist.Free;
    screen.Cursor:=crdefault;
  end;

  if flag then
    MessageDlg('업데이트 되었습니다. 지금 마지막 업데이트 내용을 적용했습니다.', mtinformation, [mbok], 0)
  else
    MessageDlg('업데이트 내용이 없습니다.', mtinformation, [mbok], 0);
end;

procedure Tfrmfetch.Button1Click(Sender: TObject);
var
  s:string;
  v:cardinal;
begin
  if edit1.Text='' then begin
    MessageDlg('검색어를 입력해 주세요.', mtError, [mbok], 0);
    exit;
  end;
  s:=GetAppDirectory+'mosaic_images\'+edit2.Text;
  if DirectoryExists(s) then begin
    if MessageDlg('같은 이름의 폴더가 존재합니다. 폴더 삭제를 권장합니다. 그냥 덮어씌우시겠습니까?',
       mtConfirmation, [mbYes, mbNo], 0) = mrNo then exit;
  end;

  label3.Caption:='';

  fetchimg:=Tfetchimg.CreateThread;
  fetchimg.formhandle:=handle;
  fetchimg.keyword:=edit1.Text;
  fetchimg.targetfolder:=s;
  fetchimg.maxfetch:=self.SpinEdit1.Value;
  fetchimg.fetchsite:=Tfetchsite(self.ComboBox1.ItemIndex);
  fetchimg.OnTerminate:=fetchimgOnTerminate;
  fetchimg.Resume;
end;

procedure Tfrmfetch.Button2Click(Sender: TObject);
begin
  if assigned(fetchimg) then begin
    fetchimg.Terminate;
    fetchimg.WaitFor;
    freeandnil(fetchimg);
  end;
end;

end.
