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