ThreadSearch.pas

   1 unit ThreadSearch;
   2
   3 interface
   4
   5 uses
   6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   7   Dialogs, ComCtrls, ExtCtrls, StdCtrls, IdBaseComponent, IdComponent,
   8   IdTCPConnection, IdTCPClient, IdHTTP, Menus, Clipbrd, IniFiles;
   9
  10 type
  11   TThreadSrch = class(TForm)
  12     Panel1: TPanel;
  13     ResultList: TListView;
  14     Label1: TLabel;
  15     BtnSearch: TButton;
  16     CmbType: TComboBox;
  17     Label2: TLabel;
  18     CmbMax: TComboBox;
  19     Label3: TLabel;
  20     CmbLim: TComboBox;
  21     Label4: TLabel;
  22     CmbSort: TComboBox;
  23     CmbBoard: TComboBox;
  24     Cmb924: TComboBox;
  25     Indy: TIdHTTP;
  26     ChkTop: TCheckBox;
  27     CmbKW: TComboBox;
  28     PopupMenu: TPopupMenu;
  29     MenuShowThread: TMenuItem;
  30     N1: TMenuItem;
  31     MenuCopyURL: TMenuItem;
  32     MenuCopyThread: TMenuItem;
  33     MenuCopyThrURL: TMenuItem;
  34     MessageList: TListBox;
  35     Splitter1: TSplitter;
  36     ChkBbs: TCheckBox;
  37     PnlBbsName: TPanel;
  38     PnlBbsId: TPanel;
  39     BtnBbs: TButton;
  40     PopMenuBbs: TPopupMenu;
  41     Label5: TLabel;
  42     LblSite: TLabel;
  43     procedure FormCreate(Sender: TObject);
  44     procedure BtnSearchClick(Sender: TObject);
  45     procedure ResultListDblClick(Sender: TObject);
  46     procedure ChkTopClick(Sender: TObject);
  47     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  48     procedure MenuShowThreadClick(Sender: TObject);
  49     procedure MenuCopyURLClick(Sender: TObject);
  50     procedure MenuCopyThreadClick(Sender: TObject);
  51     procedure MenuCopyThrURLClick(Sender: TObject);
  52     procedure PopupMenuPopup(Sender: TObject);
  53     procedure ChkBbsClick(Sender: TObject);
  54     procedure BtnBbsClick(Sender: TObject);
  55     procedure FormShow(Sender: TObject);
  56     procedure FormDestroy(Sender: TObject);
  57     procedure LblSiteClick(Sender: TObject);
  58   private
  59     { Private \90é\8c¾ }
  60     BbsNmList: TStringList;
  61     BbsIdList: TStringList;
  62
  63     procedure AddHistory;
  64     function KWEncode(const KWSrc: String): String;
  65     function EncodeUtf8ToSJis(var SrcStream: TMemoryStream): String;
  66     procedure ParsHtml(HTML: String);
  67     function HTMLEncode(const SrcText: String): String;
  68     function SplitResCount(var Title: String): String;
  69     procedure InitHttpClient(client: TIdHttp);
  70     procedure ClearHttpClient(client: TIdHttp);
  71     procedure MenuBbsClick(Sender: TObject);
  72   public
  73     { Public \90é\8c¾ }
  74     procedure SaveSetting;
  75   end;
  76
  77 function ConvertINetString(lpdwMode: LPDWORD;
  78                             dwSrcEncoding: DWORD;
  79                             dwDstEncoding: DWORD;
  80                             lpSrcStr: PChar;
  81                             lpnSrcSize: pointer;
  82                             lpDstStr: PChar;
  83                             lpnDstSize: pointer): HRESULT;
  84                                                 stdcall; external 'mlang.dll';
  85
  86 var
  87   ThreadSrch: TThreadSrch;
  88 const
  89     ENC_SJIS: DWORD = 932;
  90     ENC_UTF8: DWORD = 65001;
  91
  92 implementation
  93
  94 uses GikoSystem, GikoDataModule;
  95
  96 {$R *.dfm}
  97
  98 procedure TThreadSrch.FormCreate(Sender: TObject);
  99 begin
 100     BbsNmList := TStringList.Create;
 101     BbsIdList := TStringList.Create;
 102
 103     Top    := GikoSys.Setting.ThrdSrchTop;
 104     Left   := GikoSys.Setting.ThrdSrchLeft;
 105     Width  := GikoSys.Setting.ThrdSrchWidth;
 106     Height := GikoSys.Setting.ThrdSrchHeight;
 107     if (GikoSys.Setting.ThrdSrchMax = True) then
 108         WindowState := wsMaximized;
 109     if (GikoSys.Setting.ThrdSrchStay = True) then begin
 110         ChkTop.Checked := True;
 111         FormStyle := fsStayOnTop;
 112     end;
 113     ResultList.Column[0].Width := GikoSys.Setting.ThrdSrchCol1W;
 114     ResultList.Column[1].Width := GikoSys.Setting.ThrdSrchCol2W;
 115     ResultList.Column[2].Width := GikoSys.Setting.ThrdSrchCol3W;
 116     ResultList.Column[3].Width := GikoSys.Setting.ThrdSrchCol4W;
 117     CmbKW.Items.AddStrings(GikoSys.Setting.ThrdSrchHistory);
 118 end;
 119
 120 procedure TThreadSrch.BtnSearchClick(Sender: TObject);
 121 const
 122     BBS_VALUE: array[0..19] of string = (
 123                                             'all',                              // \91S\82Ä\82Ì\94Â
 124                                             'newsplus',                 // \91¬\81{
 125                                             'mnewsplus',                // \8c|\81{
 126                                             'U_plus',                   // \81{\91S\95\94
 127                                             'U_live',                   // \8eÀ\8bµ\91S\95\94
 128                                             'G_game',                   // \83Q\81[\83\80G
 129                                             'G_entame',                 // \8c|\94\\81E\83e\83\8c\83rG
 130                                             'G_subcal',                 // \83T\83u\83J\83\8bG
 131                                             'G_base',                   // \96ì\8b\85G
 132                                             'G_soccer',                 // \83T\83b\83J\81[G
 133                                             'G_pc',                             // PC\8aÖ\8cWG
 134                                             'G_academy',                // \8aw\96â\81E\95¶\89»G
 135                                             'G_female',                 // \8f\97\90«\8cü\82¯G
 136                                             'G_world',                  // \8d\91\8dÛG
 137                                             'G_eastasia',               // \8d\91\8dÛ\81E\93\8c\88\9fG
 138                                             'G_fareast',                // \8bÉ\93\8cG
 139                                             'G_operate',                // \89^\89cG
 140                                             'S_bbspink',                // bbspink\8eI
 141                                             'morningcoffee',    // \98T\81B
 142                                             'poverty'                   // \8c\99\96×
 143                                         );
 144 var
 145     URL: String;
 146     RspStream: TMemoryStream;
 147     HTML: String;
 148     Ok: Boolean;
 149     Board: String;
 150 begin
 151     ResultList.Clear;
 152
 153     Screen.Cursor := crHourGlass;
 154
 155     AddHistory;
 156
 157     if (ChkBbs.Checked = True) then
 158         Board := PnlBbsId.Caption
 159     else
 160         Board := BBS_VALUE[CmbBoard.ItemIndex];
 161
 162     URL := 'http://dig.2ch.net/?keywords=' + KWEncode(CmbKW.Text)
 163             + '&AndOr='      + IntToStr(CmbType.ItemIndex)
 164             + '&maxResult='  + CmbMax.Text
 165             + '&atLeast='    + CmbLim.Text
 166             + '&Sort='       + IntToStr(CmbSort.ItemIndex)
 167             + '&Link=1&Bbs=' + Board
 168             + '&924='        + IntToStr(Cmb924.ItemIndex);
 169 //    Application.MessageBox(PChar(URL), 'debug', MB_OK);
 170
 171     RspStream := TMemoryStream.Create;
 172
 173     Ok := False;
 174     InitHttpClient(Indy);
 175     try
 176         Indy.Get(URL, RspStream);
 177         Ok := True;
 178     except
 179         on E: Exception do begin
 180             MessageList.Items.Add('\83G\83\89\81[\94\90¶\81F' + E.Message);
 181         end;
 182     end;
 183
 184     if (Ok = True) and (RspStream.Size > 0) then begin
 185         HTML := EncodeUtf8ToSJis(RspStream);
 186         if (HTML = '') then     // \95Ï\8a·\8e¸\94s\82Ì\8fê\8d\871\89ñ\82¾\82¯\83\8a\83g\83\89\83C
 187             HTML := EncodeUtf8ToSJis(RspStream);
 188         if (HTML = '') then begin
 189             Ok := False;
 190             MessageList.Items.Add('\83G\83\89\81[\94\90¶\81F\95¶\8e\9a\83R\81[\83h\95Ï\8a·\8e¸\94s');
 191         end;
 192     end;
 193
 194     RspStream.Free;
 195
 196     if (Ok = True) then begin
 197         if (Length(HTML) > 0) then
 198             ParsHtml(HTML);
 199         MessageList.Items.Add(Format('\81y%s\81z\8c\9f\8dõ\8c\8b\89Ê\81F%d\8c\8f', [CmbKW.Text, ResultList.Items.Count]));
 200     end;
 201
 202     MessageList.TopIndex := MessageList.Count - 1;
 203
 204     Screen.Cursor := crDefault;
 205 end;
 206
 207 procedure TThreadSrch.AddHistory;
 208 const
 209     HISTORY_MAX: Integer = 20;
 210 var
 211     KW: String;
 212     Idx: Integer;
 213 begin
 214     if (CmbKW.Text = '') then
 215         Exit;
 216     KW := CmbKW.Text;
 217     Idx := CmbKW.Items.IndexOf(KW);
 218     if (Idx <> 0) then begin
 219         if (Idx > 0) then
 220             CmbKW.Items.Delete(Idx);
 221         CmbKW.Items.Insert(0, KW);
 222         CmbKW.Text := KW;
 223     end;
 224     while (CmbKW.Items.Count > HISTORY_MAX) do begin
 225         CmbKW.Items.Delete(CmbKW.Items.Count - 1);
 226     end;
 227 end;
 228
 229 function TThreadSrch.KWEncode(const KWSrc: String): String;
 230 const
 231     BufSize: Integer = 1024;
 232 var
 233     KWEnc: String;
 234     CnvSjis: String;
 235     Utf8: array [0..1023] of Byte;
 236     Cnt: Integer;
 237     Cnt2: Integer;
 238     Len: Integer;
 239     SrcSize: Integer;
 240     DstSize: Integer;
 241     Stat: HRESULT;
 242     Max: Integer;
 243 begin
 244     Len := Length(KWSrc);
 245     if (Len < 1) then begin
 246         Result := '';
 247         Exit;
 248     end;
 249
 250     Cnt := 1;
 251     while (Cnt <= Len) do begin
 252         case ByteType(KWSrc, Cnt) of
 253             mbSingleByte: begin
 254                 if (KWSrc[Cnt] >= #$80) then begin
 255                     CnvSjis := CnvSjis + Copy(KWSrc, Cnt, 1);
 256                 end else begin
 257                     SrcSize := Length(CnvSjis);
 258                     if (SrcSize > 0) then begin
 259                         ZeroMemory(@Utf8, BufSize);
 260                         DstSize := BufSize;
 261                         Stat := ConvertINetString(nil, ENC_SJIS, ENC_UTF8,
 262                                     PChar(CnvSjis), @SrcSize, PChar(@Utf8), @DstSize);
 263                         if (Stat = S_OK) and (DstSize > 0) then begin
 264                             Max := DstSize - 1;
 265                             for Cnt2 := 0 to Max do begin
 266                                 KWEnc := KWEnc + '%' + Format('%02X', [Utf8[Cnt2], 0]);
 267                             end;
 268                         end;
 269                         CnvSjis := '';
 270                     end;
 271
 272                     if (((KWSrc[Cnt] >= '0') and (KWSrc[Cnt] <= '9')) or
 273                              ((KWSrc[Cnt] >= 'A') and (KWSrc[Cnt] <= 'Z')) or
 274                              ((KWSrc[Cnt] >= 'a') and (KWSrc[Cnt] <= 'z')) or
 275                              (KWSrc[Cnt] = '-') or (KWSrc[Cnt] = '.') or
 276                              (KWSrc[Cnt] = '_') or (KWSrc[Cnt] = '~')) then begin
 277                         KWEnc := KWEnc + Copy(KWSrc, Cnt, 1);
 278                     end else if (KWSrc[Cnt] = ' ') then begin
 279                         KWEnc := KWEnc + '+';
 280                     end else begin
 281                         KWEnc := KWEnc + '%' + Format('%02X', [Ord(KWSrc[Cnt])]);
 282                     end;
 283                 end;
 284             end;
 285             mbLeadByte: begin
 286                 CnvSjis := CnvSjis + Copy(KWSrc, Cnt, 2);
 287                 Cnt := Cnt + 1;
 288             end;
 289             mbTrailByte: begin
 290             end;
 291         end;
 292         Cnt := Cnt + 1;
 293     end;
 294
 295     SrcSize := Length(CnvSjis);
 296     if (SrcSize > 0) then begin
 297         ZeroMemory(@Utf8, BufSize);
 298         DstSize := BufSize;
 299         Stat := ConvertINetString(nil, ENC_SJIS, ENC_UTF8,
 300                                     PChar(CnvSjis), @SrcSize, PChar(@Utf8), @DstSize);
 301         if (Stat = S_OK) and (DstSize > 0) then begin
 302             Max := DstSize - 1;
 303             for Cnt2 := 0 to Max do begin
 304                 KWEnc := KWEnc + '%' + Format('%02X', [Utf8[Cnt2]]);
 305             end;
 306         end;
 307     end;
 308
 309     Result := KWEnc;
 310 end;
 311
 312 function TThreadSrch.EncodeUtf8ToSJis(var SrcStream: TMemoryStream): String;
 313 //const
 314 //    CNV_SRC: array[0..2] of Byte = ($E3, $80, $9C);
 315 //    CNV_DST: array[0..2] of Byte = ($EF, $BD, $9E);
 316 var
 317     Buf: PChar;
 318     BufSize: Integer;
 319     SrcSize: Integer;
 320     Stat: HRESULT;
 321 //    Data: PByteArray;
 322 //    Cnt: Integer;
 323 //    Max: Integer;
 324 begin
 325     SrcStream.Position := 0;
 326     SrcSize := SrcStream.Size;
 327     BufSize := SrcSize * 2;
 328     Buf := AllocMem(BufSize);
 329     ZeroMemory(Buf, BufSize);
 330 (*
 331     // \81u\81`\81v\82ªShiftJIS\82É\82È\82¢\83R\81[\83h\82Ì\95¶\8e\9a\82É\95Ï\8a·\82³\82ê\82Ä\82¢\82é\82½\82ß\92u\82«\8a·\82¦\82é
 332     Data := PByteArray(SrcStream.Memory);
 333     Max := SrcSize - 2;
 334     Cnt := 0;
 335     while (Cnt < Max) do begin
 336         if (Data[Cnt] = CNV_SRC[0]) then begin
 337             if (Data[Cnt + 1] = CNV_SRC[1]) and (Data[Cnt + 2] = CNV_SRC[2]) then begin
 338                 Data[Cnt    ] := CNV_DST[0];
 339                 Data[Cnt + 1] := CNV_DST[1];
 340                 Data[Cnt + 2] := CNV_DST[2];
 341                 Cnt := Cnt + 2;
 342             end;
 343         end;
 344         Cnt := Cnt + 1;
 345     end;
 346 *)
 347     Stat := ConvertINetString(nil, ENC_UTF8, ENC_SJIS,
 348                                 SrcStream.Memory, @SrcSize, Buf, @BufSize);
 349     if (Stat = S_OK) or (Stat = S_FALSE) then begin     // S_FALSE\81F\95Ï\8a·\82Å\82«\82È\82¢\95¶\8e\9a\82ª\82 \82Á\82½\82ª\8f\88\97\9d\8e©\91Ì\82Í\90¬\8c÷
 350         Result := String(Buf);
 351     end else begin
 352         Result := '';
 353     end;
 354
 355     FreeMem(Buf);
 356 end;
 357
 358 procedure TThreadSrch.ParsHtml(HTML: String);
 359 const
 360     KW_START: String = '\8c\8f\8c©\82Â\82©\82è\82Ü\82µ\82½ / \91S';
 361     KW_LINE_S: String = '%d[<a href=';
 362     KW_BBS_S: String = '<font color="saddlebrown">';
 363     KW_BBS_E: String = '</font>';
 364     KW_MAE_S: String = '<span class="mae">';
 365     KW_URL_S: String = '<a href="';
 366     KW_URL_E: String = '">';
 367     KW_THR_E: String = '</a>';
 368 var
 369     Pos1: Integer;
 370     Cnt: Integer;
 371     KW: String;
 372     Item: TListItem;
 373     Title: String;
 374     ResNum: String;
 375     URL: String;
 376 begin
 377
 378     Pos1 := Pos(KW_START, HTML);
 379     if (Pos1 < 1) then
 380         Exit;
 381     Delete(HTML, 1, Pos1);
 382
 383     for Cnt := 1 to 1000 do begin
 384         KW := Format(KW_LINE_S, [Cnt]);
 385         Pos1 := Pos(KW, HTML);
 386         if (Pos1 < 1) then
 387             Break;
 388         Delete(HTML, 1, Pos1);
 389
 390         Pos1 := Pos(KW_BBS_S, HTML);
 391         if (Pos1 < 1) then
 392             Break;
 393         Delete(HTML, 1, Pos1 + Length(KW_BBS_S) - 1);
 394
 395         Pos1 := Pos(KW_BBS_E, HTML);
 396         if (Pos1 < 1) then
 397             Break;
 398
 399         Item := ResultList.Items.Add;
 400         Item.Caption := Copy(HTML, 1, Pos1 - 1);
 401
 402         Pos1 := Pos(KW_MAE_S, HTML);
 403         if (Pos1 < 1) then
 404             Break;
 405         Delete(HTML, 1, Pos1);
 406
 407         Pos1 := Pos(KW_URL_S, HTML);
 408         if (Pos1 < 1) then
 409             Break;
 410         Delete(HTML, 1, Pos1 + Length(KW_URL_S) - 1);
 411
 412         Pos1 := Pos(KW_URL_E, HTML);
 413         if (Pos1 < 1) then
 414             Break;
 415         URL := Trim(Copy(HTML, 1, Pos1 - 1));
 416         Delete(HTML, 1, Pos1 + Length(KW_URL_E) - 1);
 417
 418         Pos1 := Pos(KW_THR_E, HTML);
 419         if (Pos1 < 1) then
 420             Break;
 421         Title := HTMLEncode(Copy(HTML, 1, Pos1 - 1));
 422         ResNum := SplitResCount(Title);
 423         Item.SubItems.Add(Title);
 424         Item.SubItems.Add(ResNum);
 425         Item.SubItems.Add(URL);
 426     end;
 427
 428 end;
 429
 430 function TThreadSrch.HTMLEncode(const SrcText: String): String;
 431 const
 432     KW_SRC: array[1..4] of String = ('&quot;', '&lt;', '&gt;', '&amp;');
 433     KW_DST: array[1..4] of String = ('"',      '<',    '>',    '&');
 434 var
 435     Cnt: Integer;
 436     PosKW: Integer;
 437     DstText: String;
 438 begin
 439     DstText := SrcText;
 440
 441     for Cnt := 1 to 4 do begin
 442         while (True) do begin
 443             PosKW := Pos(KW_SRC[Cnt], DstText);
 444             if (PosKW < 1) then
 445                 Break;
 446             Delete(DstText, PosKW, Length(KW_SRC[Cnt]));
 447             Insert(KW_DST[Cnt], DstText, PosKW);
 448         end;
 449     end;
 450     Result := DstText;
 451 end;
 452
 453 function TThreadSrch.SplitResCount(var Title: String): String;
 454 var
 455     Len: Integer;
 456     Cnt: Integer;
 457     Res: String;
 458 begin
 459     Len := Length(Title);
 460     if (Title[Len] <> ')') then
 461         Exit;
 462
 463     for Cnt := Len - 1 downto 1 do begin
 464         if (Title[Cnt] = '(') then begin
 465             Res := Copy(Title, Cnt + 1, Len - Cnt - 1);
 466             SetLength(Title, Cnt - 1);
 467             Break;
 468         end;
 469     end;
 470     Result := Res;
 471 end;
 472
 473 procedure TThreadSrch.InitHttpClient(client: TIdHttp);
 474 begin
 475         ClearHttpClient(client);
 476         client.Disconnect;
 477         client.Request.UserAgent := GikoSys.GetUserAgent;
 478         client.RecvBufferSize := Gikosys.Setting.RecvBufferSize;
 479         client.ProxyParams.BasicAuthentication := False;
 480         client.ReadTimeout := GikoSys.Setting.ReadTimeOut;
 481     client.ConnectTimeout := GikoSys.Setting.ReadTimeOut;
 482         {$IFDEF DEBUG}
 483         Writeln('------------------------------------------------------------');
 484         {$ENDIF}
 485         //FIndy.AllowCookies := False;
 486         if GikoSys.Setting.ReadProxy then begin
 487                 if GikoSys.Setting.ProxyProtocol then
 488                         client.ProtocolVersion := pv1_1
 489                 else
 490                         client.ProtocolVersion := pv1_0;
 491                 client.ProxyParams.ProxyServer := GikoSys.Setting.ReadProxyAddress;
 492                 client.ProxyParams.ProxyPort := GikoSys.Setting.ReadProxyPort;
 493                 client.ProxyParams.ProxyUsername := GikoSys.Setting.ReadProxyUserID;
 494                 client.ProxyParams.ProxyPassword := GikoSys.Setting.ReadProxyPassword;
 495                 if GikoSys.Setting.ReadProxyUserID <> '' then
 496                         client.ProxyParams.BasicAuthentication := True;
 497                 {$IFDEF DEBUG}
 498                 Writeln('\83v\83\8d\83L\83V\90Ý\92è\82 \82è');
 499                 Writeln('\83z\83X\83g: ' + GikoSys.Setting.ReadProxyAddress);
 500                 Writeln('\83|\81[\83g: ' + IntToStr(GikoSys.Setting.ReadProxyPort));
 501                 {$ENDIF}
 502         end else begin
 503                 if GikoSys.Setting.Protocol then
 504                         client.ProtocolVersion := pv1_1
 505                 else
 506                         client.ProtocolVersion := pv1_0;
 507                 client.ProxyParams.ProxyServer := '';
 508                 client.ProxyParams.ProxyPort := 80;
 509                 client.ProxyParams.ProxyUsername := '';
 510                 client.ProxyParams.ProxyPassword := '';
 511                 {$IFDEF DEBUG}
 512                 Writeln('\83v\83\8d\83L\83V\90Ý\92è\82È\82µ');
 513                 {$ENDIF}
 514         end;
 515 end;
 516
 517 procedure TThreadSrch.ClearHttpClient(client: TIdHttp);
 518 begin
 519         client.Request.CustomHeaders.Clear;
 520         client.Request.RawHeaders.Clear;
 521         client.Request.Clear;
 522         client.Response.CustomHeaders.Clear;
 523         client.Response.RawHeaders.Clear;
 524         client.Response.Clear;
 525
 526         client.ProxyParams.Clear;
 527 end;
 528
 529 procedure TThreadSrch.ResultListDblClick(Sender: TObject);
 530 begin
 531     MenuShowThreadClick(MenuShowThread);
 532 end;
 533
 534 procedure TThreadSrch.ChkTopClick(Sender: TObject);
 535 begin
 536     if (ChkTop.Checked = True) then
 537         FormStyle := fsStayOnTop
 538     else
 539         FormStyle := fsNormal;
 540 end;
 541
 542 procedure TThreadSrch.SaveSetting;
 543 begin
 544     GikoSys.Setting.ThrdSrchTop := Top;
 545     GikoSys.Setting.ThrdSrchLeft := Left;
 546     GikoSys.Setting.ThrdSrchWidth := Width;
 547     GikoSys.Setting.ThrdSrchHeight := Height;
 548     if (WindowState = wsMaximized) then
 549         GikoSys.Setting.ThrdSrchMax := True
 550     else
 551         GikoSys.Setting.ThrdSrchMax := False;
 552     if (ChkTop.Checked = True) then
 553         GikoSys.Setting.ThrdSrchStay := True
 554     else
 555         GikoSys.Setting.ThrdSrchStay := False;
 556     GikoSys.Setting.ThrdSrchCol1W := ResultList.Column[0].Width;
 557     GikoSys.Setting.ThrdSrchCol2W := ResultList.Column[1].Width;
 558     GikoSys.Setting.ThrdSrchCol3W := ResultList.Column[2].Width;
 559     GikoSys.Setting.ThrdSrchCol4W := ResultList.Column[3].Width;
 560     GikoSys.Setting.ThrdSrchHistory.Clear;
 561     GikoSys.Setting.ThrdSrchHistory.AddStrings(CmbKW.Items);
 562 end;
 563
 564 procedure TThreadSrch.FormClose(Sender: TObject; var Action: TCloseAction);
 565 begin
 566     SaveSetting;
 567 end;
 568
 569 procedure TThreadSrch.MenuShowThreadClick(Sender: TObject);
 570 begin
 571     if (ResultList.Selected <> nil) then
 572         GikoDM.MoveURLWithHistory(ResultList.Selected.SubItems[2]);
 573 end;
 574
 575 procedure TThreadSrch.MenuCopyURLClick(Sender: TObject);
 576 begin
 577     if (ResultList.Selected <> nil) then
 578         Clipboard.AsText := ResultList.Selected.SubItems[2];
 579 end;
 580
 581 procedure TThreadSrch.MenuCopyThreadClick(Sender: TObject);
 582 begin
 583     if (ResultList.Selected <> nil) then
 584         Clipboard.AsText := ResultList.Selected.SubItems[0];
 585 end;
 586
 587 procedure TThreadSrch.MenuCopyThrURLClick(Sender: TObject);
 588 begin
 589     if (ResultList.Selected <> nil) then
 590         Clipboard.AsText := ResultList.Selected.SubItems[0] + #13#10
 591                           + ResultList.Selected.SubItems[2];
 592 end;
 593
 594 procedure TThreadSrch.PopupMenuPopup(Sender: TObject);
 595 var
 596     Enb: Boolean;
 597 begin
 598     if (ResultList.Selected = nil) then
 599         Enb := False
 600     else
 601         Enb := True;
 602     MenuShowThread.Enabled := Enb;
 603     MenuCopyURL.Enabled    := Enb;
 604     MenuCopyThread.Enabled := Enb;
 605     MenuCopyThrURL.Enabled := Enb;
 606 end;
 607
 608 procedure TThreadSrch.ChkBbsClick(Sender: TObject);
 609 begin
 610     if (ChkBbs.Checked = True) then begin
 611         CmbBoard.Enabled := False;
 612         PnlBbsName.Font.Color := clWindowText;
 613         PnlBbsId.Font.Color := clWindowText;
 614         BtnBbs.Enabled := True;
 615     end else begin
 616         CmbBoard.Enabled := True;
 617         PnlBbsName.Font.Color := clGrayText;
 618         PnlBbsId.Font.Color := clGrayText;
 619         BtnBbs.Enabled := False;
 620     end;
 621 end;
 622
 623 procedure TThreadSrch.BtnBbsClick(Sender: TObject);
 624 var
 625     CliPos: TPoint;
 626     ScrPos: TPoint;
 627 begin
 628     CliPos.X := PnlBbsName.Left;
 629     CliPos.Y := 0;
 630     ScrPos := ClientToScreen(CliPos);
 631
 632     PopMenuBbs.Popup(ScrPos.X, ScrPos.Y);
 633 end;
 634
 635 procedure TThreadSrch.FormShow(Sender: TObject);
 636 var
 637     Ini: TIniFile;
 638     Sec: TStringList;
 639     Itm: TStringList;
 640     IdxSec: Integer;
 641     IdxItm: Integer;
 642     MaxSec: Integer;
 643     MaxItm: Integer;
 644     SecItem: TMenuItem;
 645     BbsItem: TMenuItem;
 646     SecName: String;
 647     BbsName: String;
 648     BbsId: String;
 649     SepPos: Integer;
 650 begin
 651     ResultList.Clear;
 652     MessageList.Clear;
 653     CmbKW.Text := '';
 654     CmbType.ItemIndex := 0;
 655     CmbMax.ItemIndex := 3;
 656     CmbLim.ItemIndex := 0;
 657     CmbSort.ItemIndex := 5;
 658     CmbBoard.ItemIndex := 0;
 659     Cmb924.ItemIndex := 1;
 660     ChkBbs.Checked := False;
 661     ChkBbsClick(ChkBbs);
 662     PnlBbsName.Caption := '';
 663     PnlBbsId.Caption := '';
 664
 665     PopMenuBbs.Items.Clear;
 666     BbsNmList.Clear;
 667     BbsIdList.Clear;
 668
 669     Sec := TStringList.Create;
 670     Itm := TStringList.Create;
 671     Ini := TIniFile.Create(GikoSys.GetBoardFileName);
 672
 673     Ini.ReadSections(Sec);
 674
 675     MaxSec := Sec.Count - 1;
 676     if (MaxSec > 0) then begin
 677         for IdxSec := 0 to MaxSec do begin
 678             SecName := Sec.Strings[IdxSec];
 679             SecItem := TMenuItem.Create(PopMenuBbs);
 680             PopMenuBbs.Items.Add(SecItem);
 681             SecItem.Caption := SecName;
 682
 683             Ini.ReadSection(SecName, Itm);
 684             MaxItm := Itm.Count - 1;
 685             if (MaxItm > 0) then begin
 686                 for IdxItm := 0 to MaxItm do begin
 687                     BbsName := Itm.Strings[IdxItm];
 688                     BbsId   := Ini.ReadString(SecName, BbsName, '');
 689                     SepPos := Pos('.2ch.net/', BbsId);
 690                     if (SepPos > 0) then
 691                         Delete(BbsId, 1, SepPos + Length('.2ch.net/') - 1);
 692                     SepPos := Pos('.bbspink.com/', BbsId);
 693                     if (SepPos > 0) then
 694                         Delete(BbsId, 1, SepPos + Length('.bbspink.com/') - 1);
 695                     SepPos := Pos('/', BbsId);
 696                     if (SepPos > 0) then
 697                         SetLength(BbsId, SepPos - 1);
 698
 699                     BbsItem := TMenuItem.Create(PopMenuBbs);
 700                     SecItem.Add(BbsItem);
 701                     BbsItem.Caption := BbsName;
 702                     BbsNmList.Add('\81y' + SecName + '\81z\81y' + BbsName + '\81z');
 703                     BbsIdList.Add(BbsId);
 704                     BbsItem.Tag := BbsIdList.Count - 1;
 705                     BbsItem.OnClick := MenuBbsClick;
 706                 end;
 707             end;
 708         end;
 709     end;
 710
 711     Ini.Free;
 712     Itm.Free;
 713     Sec.Free;
 714
 715 end;
 716
 717 procedure TThreadSrch.MenuBbsClick(Sender: TObject);
 718 var
 719     SelItem: TMenuItem;
 720     BbsName: String;
 721     BbsId: String;
 722 begin
 723     if (Sender <> nil) then begin
 724         SelItem := TMenuItem(Sender);
 725         if (SelItem.Tag >= 0) and (SelItem.Tag < BbsNmList.Count) then begin
 726             BbsName := BbsNmList.Strings[SelItem.Tag];
 727             BbsId   := BbsIdList.Strings[SelItem.Tag];
 728         end;
 729     end;
 730     PnlBbsName.Caption := BbsName;
 731     PnlBbsId.Caption   := BbsId;
 732 end;
 733
 734 procedure TThreadSrch.FormDestroy(Sender: TObject);
 735 begin
 736     BbsNmList.Free;
 737     BbsIdList.Free;
 738 end;
 739
 740 procedure TThreadSrch.LblSiteClick(Sender: TObject);
 741 begin
 742         GikoSys.OpenBrowser(PChar(LblSite.Caption), gbtAuto);
 743 end;
 744
 745 end.