uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ExtCtrls, StdCtrls, IdBaseComponent, IdComponent,
- IdTCPConnection, IdTCPClient, IdHTTP, Menus, Clipbrd, IniFiles;
+ IdTCPConnection, IdTCPClient, IdHTTP, Menus, Clipbrd, IniFiles, uLkJSON,
+ OleCtrls, SHDocVw;
type
TThreadSrch = class(TForm)
+ Indy: TIdHTTP;
+ PopupMenu: TPopupMenu;
+ MenuShowThread: TMenuItem;
+ N1: TMenuItem;
+ MenuCopyURL: TMenuItem;
+ MenuCopyThread: TMenuItem;
+ MenuCopyThrURL: TMenuItem;
+ PopMenuBbs: TPopupMenu;
Panel1: TPanel;
- ResultList: TListView;
+ Splitter1: TSplitter;
+ Panel3: TPanel;
Label1: TLabel;
+ Label2: TLabel;
+ Label3: TLabel;
+ Label4: TLabel;
+ Label5: TLabel;
+ LblSite: TLabel;
BtnSearch: TButton;
CmbType: TComboBox;
- Label2: TLabel;
CmbMax: TComboBox;
- Label3: TLabel;
CmbLim: TComboBox;
- Label4: TLabel;
CmbSort: TComboBox;
CmbBoard: TComboBox;
Cmb924: TComboBox;
- Indy: TIdHTTP;
ChkTop: TCheckBox;
CmbKW: TComboBox;
- PopupMenu: TPopupMenu;
- MenuShowThread: TMenuItem;
- N1: TMenuItem;
- MenuCopyURL: TMenuItem;
- MenuCopyThread: TMenuItem;
- MenuCopyThrURL: TMenuItem;
- MessageList: TListBox;
- Splitter1: TSplitter;
ChkBbs: TCheckBox;
PnlBbsName: TPanel;
PnlBbsId: TPanel;
BtnBbs: TButton;
- PopMenuBbs: TPopupMenu;
- Label5: TLabel;
- LblSite: TLabel;
+ ResultList: TListView;
+ Splitter2: TSplitter;
+ MessageList: TListBox;
+ CmBrowser: TWebBrowser;
+ ChkNG: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure BtnSearchClick(Sender: TObject);
procedure ResultListDblClick(Sender: TObject);
{ Private \90é\8c¾ }
BbsNmList: TStringList;
BbsIdList: TStringList;
+ CmPath: String;
+ CmUrl: String;
procedure AddHistory;
function KWEncode(const KWSrc: String): String;
- function EncodeUtf8ToSJis(var SrcStream: TMemoryStream): String;
- procedure ParsHtml(HTML: String);
- function HTMLEncode(const SrcText: String): String;
- function SplitResCount(var Title: String): String;
+ function ParsJson(JsonStream: TMemoryStream): Boolean;
+ procedure SetCm(Content: string);
+ function HTMLEncode(const HTML: string): String;
procedure InitHttpClient(client: TIdHttp);
procedure ClearHttpClient(client: TIdHttp);
procedure MenuBbsClick(Sender: TObject);
stdcall; external 'mlang.dll';
var
- ThreadSrch: TThreadSrch;
+ ThreadSrch: TThreadSrch = nil;
const
+ HTML_HD: String = '<html><head><meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS"><title></title></head><body>';
+ HTML_FT: String = '</body></html>';
ENC_SJIS: DWORD = 932;
ENC_UTF8: DWORD = 65001;
implementation
-uses GikoSystem, GikoDataModule;
+uses GikoSystem, GikoDataModule, MojuUtils, BoardGroup;
{$R *.dfm}
procedure TThreadSrch.FormCreate(Sender: TObject);
+var
+ PathLen: Integer;
+ Sep: Integer;
begin
BbsNmList := TStringList.Create;
BbsIdList := TStringList.Create;
ResultList.Column[2].Width := GikoSys.Setting.ThrdSrchCol3W;
ResultList.Column[3].Width := GikoSys.Setting.ThrdSrchCol4W;
CmbKW.Items.AddStrings(GikoSys.Setting.ThrdSrchHistory);
+
+ SetLength(CmPath, 1024);
+ PathLen := GetTempPath(1024, PAnsiChar(CmPath));
+ if (PathLen > 0) then begin
+ SetLength(CmPath, PathLen);
+ if (CmPath[PathLen] <> '\') then
+ CmPath := CmPath + '\';
+ CmPath := CmPath + 'gikonavi';
+ ForceDirectories(CmPath);
+ CmPath := CmPath + '\cm.html';
+ CmUrl := CmPath;
+ while (True) do begin
+ Sep := Pos('\', CmUrl);
+ if (Sep < 1) then
+ Break;
+ CmUrl[Sep] := '/';
+ end;
+ while (True) do begin
+ Sep := Pos(' ', CmUrl);
+ if (Sep < 1) then
+ Break;
+ Delete(CmUrl, Sep, 1);
+ Insert('%20', CmUrl, Sep);
+ end;
+ CmUrl := 'file://' + CmUrl;
+ end else begin
+ CmPath := '';
+ end;
end;
procedure TThreadSrch.BtnSearchClick(Sender: TObject);
var
URL: String;
RspStream: TMemoryStream;
- HTML: String;
Ok: Boolean;
Board: String;
begin
ResultList.Clear;
+// CmBrowser.Navigate('about:blank');
Screen.Cursor := crHourGlass;
+ '&atLeast=' + CmbLim.Text
+ '&Sort=' + IntToStr(CmbSort.ItemIndex)
+ '&Link=1&Bbs=' + Board
- + '&924=' + IntToStr(Cmb924.ItemIndex);
+ + '&924=' + IntToStr(Cmb924.ItemIndex)
+ + '&json=1';
// Application.MessageBox(PChar(URL), 'debug', MB_OK);
RspStream := TMemoryStream.Create;
end;
end;
- if (Ok = True) and (RspStream.Size > 0) then begin
- HTML := EncodeUtf8ToSJis(RspStream);
- if (HTML = '') then // \95Ï\8a·\8e¸\94s\82Ì\8fê\8d\871\89ñ\82¾\82¯\83\8a\83g\83\89\83C
- HTML := EncodeUtf8ToSJis(RspStream);
- if (HTML = '') then begin
- Ok := False;
- MessageList.Items.Add('\83G\83\89\81[\94\90¶\81F\95¶\8e\9a\83R\81[\83h\95Ï\8a·\8e¸\94s');
- end;
- end;
-
- RspStream.Free;
-
if (Ok = True) then begin
- if (Length(HTML) > 0) then
- ParsHtml(HTML);
- MessageList.Items.Add(Format('\81y%s\81z\8c\9f\8dõ\8c\8b\89Ê\81F%d\8c\8f', [CmbKW.Text, ResultList.Items.Count]));
+ if (RspStream.Size > 0) then
+ Ok := ParsJson(RspStream);
+ if (Ok = True) then
+ MessageList.Items.Add(Format('\81y%s\81z\8c\9f\8dõ\8c\8b\89Ê\81F%d\8c\8f', [CmbKW.Text, ResultList.Items.Count]));
end;
MessageList.TopIndex := MessageList.Count - 1;
+ RspStream.Free;
+
Screen.Cursor := crDefault;
end;
Result := KWEnc;
end;
-function TThreadSrch.EncodeUtf8ToSJis(var SrcStream: TMemoryStream): String;
-//const
-// CNV_SRC: array[0..2] of Byte = ($E3, $80, $9C);
-// CNV_DST: array[0..2] of Byte = ($EF, $BD, $9E);
+function TThreadSrch.ParsJson(JsonStream: TMemoryStream): Boolean;
var
- Buf: PChar;
- BufSize: Integer;
- SrcSize: Integer;
- Stat: HRESULT;
-// Data: PByteArray;
-// Cnt: Integer;
-// Max: Integer;
+ vJsonObj: TlkJsonObject;
+ vCm: TlkJSONbase;
+ vRoot: TlkJSONbase;
+ vRec: TlkJSONbase;
+ vField: TlkJSONbase;
+ RecMax: Integer;
+ Cnt: Integer;
+ CmHtml: String;
+ Title: String;
+ Item: TListItem;
begin
- SrcStream.Position := 0;
- SrcSize := SrcStream.Size;
- BufSize := SrcSize * 2;
- Buf := AllocMem(BufSize);
- ZeroMemory(Buf, BufSize);
-(*
- // \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é
- Data := PByteArray(SrcStream.Memory);
- Max := SrcSize - 2;
- Cnt := 0;
- while (Cnt < Max) do begin
- if (Data[Cnt] = CNV_SRC[0]) then begin
- if (Data[Cnt + 1] = CNV_SRC[1]) and (Data[Cnt + 2] = CNV_SRC[2]) then begin
- Data[Cnt ] := CNV_DST[0];
- Data[Cnt + 1] := CNV_DST[1];
- Data[Cnt + 2] := CNV_DST[2];
- Cnt := Cnt + 2;
+ Result := False;
+ try
+ JsonStream.Position := 0;
+ vJsonObj := TlkJSONstreamed.LoadFromStream(JsonStream) as TlkJsonObject;
+
+ try
+ for Cnt := 0 to 2 do begin;
+ vCm := vJsonObj.Field['cm' + IntToStr(Cnt)];
+ if (vCm <> nil) then begin
+ CmHtml := CmHtml + String(vCm.Value);
+ end;
end;
- end;
- Cnt := Cnt + 1;
- end;
-*)
- Stat := ConvertINetString(nil, ENC_UTF8, ENC_SJIS,
- SrcStream.Memory, @SrcSize, Buf, @BufSize);
- 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÷
- Result := String(Buf);
- end else begin
- Result := '';
- end;
+ if (CmHtml <> '') then
+ SetCm(HTML_HD + CmHtml + HTML_FT);
- FreeMem(Buf);
-end;
+ vRoot := vJsonObj.Field['result'];
+ if (vRoot <> nil) then begin
+ RecMax := vRoot.Count - 1;
+ for Cnt := 0 to RecMax do begin;
+ vRec := vRoot.Child[Cnt];
-procedure TThreadSrch.ParsHtml(HTML: String);
-const
- KW_START: String = '\8c\8f\8c©\82Â\82©\82è\82Ü\82µ\82½ / \91S';
- KW_LINE_S: String = '%d[<a href=';
- KW_BBS_S: String = '<font color="saddlebrown">';
- KW_BBS_E: String = '</font>';
- KW_MAE_S: String = '<span class="mae">';
- KW_URL_S: String = '<a href="';
- KW_URL_E: String = '">';
- KW_THR_E: String = '</a>';
-var
- Pos1: Integer;
- Cnt: Integer;
- KW: String;
- Item: TListItem;
- Title: String;
- ResNum: String;
- URL: String;
-begin
+ vField := vRec.Field['subject'];
+ Title := HTMLEncode(String(vField.Value));
+ if (ChkNG.Checked = True) and (ThreadNgList.IsNG(Title) = True) then
+ Continue;
- Pos1 := Pos(KW_START, HTML);
- if (Pos1 < 1) then
- Exit;
- Delete(HTML, 1, Pos1);
-
- for Cnt := 1 to 1000 do begin
- KW := Format(KW_LINE_S, [Cnt]);
- Pos1 := Pos(KW, HTML);
- if (Pos1 < 1) then
- Break;
- Delete(HTML, 1, Pos1);
-
- Pos1 := Pos(KW_BBS_S, HTML);
- if (Pos1 < 1) then
- Break;
- Delete(HTML, 1, Pos1 + Length(KW_BBS_S) - 1);
-
- Pos1 := Pos(KW_BBS_E, HTML);
- if (Pos1 < 1) then
- Break;
-
- Item := ResultList.Items.Add;
- Item.Caption := Copy(HTML, 1, Pos1 - 1);
-
- Pos1 := Pos(KW_MAE_S, HTML);
- if (Pos1 < 1) then
- Break;
- Delete(HTML, 1, Pos1);
-
- Pos1 := Pos(KW_URL_S, HTML);
- if (Pos1 < 1) then
- Break;
- Delete(HTML, 1, Pos1 + Length(KW_URL_S) - 1);
-
- Pos1 := Pos(KW_URL_E, HTML);
- if (Pos1 < 1) then
- Break;
- URL := Trim(Copy(HTML, 1, Pos1 - 1));
- Delete(HTML, 1, Pos1 + Length(KW_URL_E) - 1);
-
- Pos1 := Pos(KW_THR_E, HTML);
- if (Pos1 < 1) then
- Break;
- Title := HTMLEncode(Copy(HTML, 1, Pos1 - 1));
- ResNum := SplitResCount(Title);
- Item.SubItems.Add(Title);
- Item.SubItems.Add(ResNum);
- Item.SubItems.Add(URL);
- end;
+ vField := vRec.Field['ita'];
+ Item := ResultList.Items.Add;
+ Item.Caption := String(vField.Value);
-end;
+ Item.SubItems.Add(Title);
-function TThreadSrch.HTMLEncode(const SrcText: String): String;
-const
- KW_SRC: array[1..4] of String = ('"', '<', '>', '&');
- KW_DST: array[1..4] of String = ('"', '<', '>', '&');
-var
- Cnt: Integer;
- PosKW: Integer;
- DstText: String;
-begin
- DstText := SrcText;
+ vField := vRec.Field['resno'];
+ Item.SubItems.Add(String(vField.Value));
- for Cnt := 1 to 4 do begin
- while (True) do begin
- PosKW := Pos(KW_SRC[Cnt], DstText);
- if (PosKW < 1) then
- Break;
- Delete(DstText, PosKW, Length(KW_SRC[Cnt]));
- Insert(KW_DST[Cnt], DstText, PosKW);
+ vField := vRec.Field['url'];
+ Item.SubItems.Add(String(vField.Value));
+ end;
+ end;
+ Result := True;
+ except
+ on E: Exception do begin
+ MessageList.Items.Add('JSON\89ð\90Í\83G\83\89\81[\94\90¶\81F' + E.Message);
+ end;
+ end;
+ vJsonObj.Free;
+ except
+ on E: Exception do begin
+ MessageList.Items.Add('JSON\93Ç\8d\9e\83G\83\89\81[\94\90¶\81F' + E.Message);
end;
end;
- Result := DstText;
end;
-function TThreadSrch.SplitResCount(var Title: String): String;
+procedure TThreadSrch.SetCm(Content: string);
var
- Len: Integer;
- Cnt: Integer;
- Res: String;
+// doc: OleVariant;
+ Html: TStringList;
begin
- Len := Length(Title);
- if (Title[Len] <> ')') then
- Exit;
-
- for Cnt := Len - 1 downto 1 do begin
- if (Title[Cnt] = '(') then begin
- Res := Copy(Title, Cnt + 1, Len - Cnt - 1);
- SetLength(Title, Cnt - 1);
- Break;
+(*
+ if Assigned(CmBrowser.ControlInterface.Document) then begin
+ doc := OleVariant(CmBrowser.Document);
+ doc.Clear;
+ doc.open;
+ doc.charset := 'Shift_JIS';
+ doc.Write(Content);
+ doc.Close;
+ end else begin
+ MessageList.Items.Add('CM\95\\8e¦\83G\83\89\81[\94\90¶');
+ end;
+*)
+ if (CmPath = '') then begin
+ MessageList.Items.Add('CM\95\\8e¦\83G\83\89\81[\94\90¶\81F\88ê\8e\9e\83p\83X\8eæ\93¾\8e¸\94s');
+ end else begin
+ Html := TStringList.Create;
+ try
+ Html.Text := Content;
+ Html.SaveToFile(CmPath);
+ CmBrowser.Navigate(CmUrl);
+ except
+ on E: Exception do begin
+ MessageList.Items.Add('CM\95\\8e¦\83G\83\89\81[\94\90¶\81F' + E.Message);
+ end;
end;
- end;
- Result := Res;
+ Html.Free;
+ end;
+end;
+
+function TThreadSrch.HTMLEncode(const HTML: string): String;
+var
+ DstStr: String;
+begin
+ DstStr := CustomStringReplace(HTML, '<', '<');
+ DstStr := CustomStringReplace(DstStr, '>', '>');
+ DstStr := CustomStringReplace(DstStr, '"', '"');
+ Result := CustomStringReplace(DstStr, '&', '&');
end;
procedure TThreadSrch.InitHttpClient(client: TIdHttp);
end;
procedure TThreadSrch.FormShow(Sender: TObject);
+const
+ 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>';
var
Ini: TIniFile;
Sec: TStringList;
ChkBbsClick(ChkBbs);
PnlBbsName.Caption := '';
PnlBbsId.Caption := '';
+// CmBrowser.Navigate('about:blank');
+ SetCm(HTML_HD + HTML_INF + HTML_FT);
PopMenuBbs.Items.Clear;
BbsNmList.Clear;
OSDN Git Service
