Develop and Download Open Source Software

Browse CVS Repository

Diff of /gikonavigoeson/gikonavi/HTMLCreate.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.4 by h677, Thu Aug 25 16:11:02 2005 UTC revision 1.5 by h677, Sun Nov 13 10:47:21 2005 UTC
# Line 36  type Line 36  type
36                  procedure CreateUseCSSHTML(doc: Variant; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );                  procedure CreateUseCSSHTML(doc: Variant; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
37                  procedure CreateDefaultHTML (doc: Variant; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );                  procedure CreateDefaultHTML (doc: Variant; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
38                  function ConvertResAnchor(res: string): string;                  function ConvertResAnchor(res: string): string;
39                    procedure separateNumber(var st: String; var et: String; const Text, Separator: String);
40          public          public
41                  { Public 宣言 }                  { Public 宣言 }
42                  function AddAnchorTag(s: string): string;                  function AddAnchorTag(s: string): string;
43                  function LoadFromSkin(fileName: string; ThreadItem: TThreadItem; SizeByte: Integer): string;                  function LoadFromSkin(fileName: string; ThreadItem: TThreadItem; SizeByte: Integer): string;
44                  function SkinedRes(skin: string; Res: TResRec; No: string): string;                  function SkinedRes(skin: string; Res: TResRec; No: string): string;
45                  function ConvRes(const Body, Bbs, Key,  ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue : string; DatToHTML: boolean = false): string; overload;                  function ConvRes(const Body, Bbs, Key,  ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue : string; DatToHTML: boolean = false): string; overload;
46                  function ConvRes(const Body, Bbs, Key,  ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue, FullURL : string): string; overload;  //              function ConvRes(const Body, Bbs, Key,  ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue, FullURL : string): string; overload;
47                  procedure CreateHTML2(doc: Variant; ThreadItem: TThreadItem; var sTitle: string);                  procedure CreateHTML2(doc: Variant; ThreadItem: TThreadItem; var sTitle: string);
48                  procedure CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);                  procedure CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
49          end;          end;
# Line 296  begin Line 297  begin
297          end else          end else
298                  Result := AID;                  Result := AID;
299  end;  end;
300    procedure THTMLCreate.separateNumber(var st: String; var et: String; const Text, Separator: String);
301    var
302            p : Integer;
303    begin
304            p := Pos(Separator,Text);
305            if (p > 0 ) then begin
306                    st := Copy(Text, 1, p - 1);
307                    et := Copy(Text, p + Length(Separator), Length(Text));
308            end else begin
309                    st := Text;
310                    et := Text;
311            end;
312    end;
313  (*************************************************************************  (*************************************************************************
314   *   *
315   * from HotZonu   * from HotZonu
# Line 303  end; Line 317  end;
317  function THTMLCreate.ConvRes(const Body, Bbs, Key,  function THTMLCreate.ConvRes(const Body, Bbs, Key,
318          ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue : string;          ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue : string;
319          DatToHTML: boolean = false): string;          DatToHTML: boolean = false): string;
 type  
         PIndex = ^TIndex;  
         TIndex = record  
                 FIndexFrom      : integer;  
                 FIndexTo                : integer;  
                 FNo                              : string;  
         end;  
320  const  const
321          GT      = '>';          GT      = '>';
322          SN      = '0123456789-';          SN      = '0123456789';
323          ZN      = '0123456789−';          FORMAT_LINK = '<a href="../test/read.cgi?%s=%s&%s=%s&%s=%s&%s=%s&%s=%s" target="_blank">';
324  var  var
325          i : integer;          i : integer;
326          s,r : string;          s : string;
         b : TMbcsByteType;  
327          sw: boolean;          sw: boolean;
328          sp: integer;          cm: boolean;
329          No: string;          No: string;
         sx: string;  
         List: TList;  
330          oc      : string;          oc      : string;
331          st, et: string;          pos, pmin : integer;
332          chk : boolean;          j : integer;
333          al : boolean;          token : array[0..5] of string;
334          procedure Add(IndexFrom, IndexTo: integer; const No: string);          ch : string;
335          var          db : boolean;
336                  FIndex : PIndex;          len : integer;
337          begin          rink : string;
338                  New(FIndex);          function addResAnchor(const Left :string) : string;
                 FIndex.FIndexFrom       := IndexFrom;  
                 FIndex.FIndexTo         := IndexTo;  
                 FIndex.FNo                               := No;  
                 List.Add(FIndex);  
         end;  
         function ChooseString(const Text, Separator: string; Index: integer): string;  
339          var          var
340                  S : string;                  st,et : string;
                 i, p : integer;  
341          begin          begin
342                  S :=    Text;                  //終端まで行っての終了かチェック
343                  for i :=        0 to    Index - 1 do    begin                  if j <= len then begin
344                          if      (AnsiPos(Separator, S) = 0) then        S :=    ''                          if db then j := j - 2
345                          else    S :=    Copy(S, AnsiPos(Separator, S) + Length(Separator), Length(S));                          else j := j - 1;
346                    end;
347                    //何も数字が見つからないとき
348                    if No = '' then begin
349                            Result := Left + Copy(s, 1, j - 1);
350                    end else begin
351                            separateNumber(st, et, No, '-');
352    
353                            if not DatToHTML then begin
354                                    Result := Left + Format(FORMAT_LINK,
355                                                            [ParamBBS, Bbs, ParamKey, Key, ParamStart, st, ParamTo, et, ParamNoFirst, ParamTrue]);
356                            end else begin
357                                    Result := Left + Format('<a href="#%s">', [st]);
358                            end;
359                            Result := Result + Copy(s, 1, j - 1) + '</a>';
360                  end;                  end;
361                  p :=    AnsiPos(Separator, S);                  Delete(s, 1, j - 1);
                 if      (p > 0) then    Result  :=      Copy(S, 1, p - 1) else Result :=        S;  
362          end;          end;
363  begin  
364          { v1.0 b2 - 03 }          procedure getNumberString;
365          s        :=     Body;          begin
366          r        :=     Body;                  while (j <= len) do begin
367          i        :=     1;                          if (ByteType(s, j) = mbSingleByte) then begin
368          sw      :=      False;                                  //1byte文字
369          No      :=      '';                                  ch := s[j];
370          List:=  TList.Create;                                  Inc(j);
371          oc      :=      '';                                  db := false;
372          sp      :=      0;                          end else begin
373          chk :=  False;                                  //2byte文字
374          al      :=      False;                                  ch := ZenToHan(Copy(s, j, 2));
375          while true      do      begin                                  Inc(j, 2);
376                  b :=    ByteType(s, i);                                  db := true;
                 case    b of  
                         mbSingleByte    : begin  
                                 if      (not sw) and (Copy(s,i,8) = GT + GT) then       begin  
                                         if      (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 0) then        begin  
                                                 sw      :=      True;  
                                                 sp      :=      i;  
                                                 i :=    i + 7;  
                                                 oc:='';  
                                                 chk :=  True;  
                                         end;  
                                 end else  
                                 if      (not sw) and (Copy(s,i,8) = GT + GT) then       begin  
                                         if      (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 1) then        begin  
                                                 i :=    i + 7;  
                                                 oc:='';  
                                                 chk :=  True;  
                                         end;  
                                 end else  
                                 if      (not sw) and (Copy(s,i,4) = GT) then    begin  
                                         if      (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 0) then        begin  
                                                 sw      :=      True;  
                                                 sp      :=      i;  
                                                 i :=    i + 3;  
                                                 oc:='';  
                                                 chk :=  True;  
                                         end;  
                                 end else  
                                 if      ((not sw) and (Copy(s,i,1) = ',')) or  
                                                 ((not sw) and (Copy(s,i,1) = '=')) then begin  
                                         if      ((not Chk) and (AnsiLowerCase(oc) = '</a>')) or  
                                                         ((Chk) and      (oc = '')) or  
                                                         ((not Chk) and (al)) then  
                                         begin  
                                                 sw      :=      True;  
                                                 sp      :=      i;  
                                                 //i :=  i + 1;  
                                                 oc:='';  
                                         end;  
                                 end else  
                                 if      (sw) then begin  
                                         sx      :=      Copy(s,i,1);  
                                         if      (AnsiPos(sx, SN) > 0)   then    begin  
                                                 No      :=      No      + sx;  
                                         end else begin  
                                                 if      (No <> '') and (No <> '-')       then   begin  
                                                         Add(sp, i, No);  
                                                         al := True;  
                                                 end;  
                                                 sw      :=      False;  
                                                 //  
                                                 i := i - 1;  
                                                 //  
                                                 No      := '';  
                                                 oc:='';  
                                                 //chk :=        False;  
                                         end;  
                                 end else begin  
                                         if      Copy(s,i,1) = '<' then  oc      :=      '';  
                                         oc      :=      oc + Copy(s,i,1);  
                                         chk :=  False;  
                                         al      :=      False;  
                                 end;  
                         end;  
                         mbLeadByte      : begin  
                                 if      (not sw) and (Copy(s,i,4) = '>>') then        begin  
                                         sw      :=      True;  
                                         sp      :=      i;  
                                         i :=    i + 3;  
                                         chk :=  True;  
                                 end else  
                                 if      (not sw) and (Copy(s,i,2) = '>') then  begin  
                                         sw      :=      True;  
                                         sp      :=      i;  
                                         i :=    i + 1;  
                                         chk :=  True;  
                                 end else  
                                 if      (sw) then begin  
                                         sx      :=      Copy(s,i,2);  
                                         if      (AnsiPos(sx, ZN) > 0)   then    begin  
                                                 No      :=      No      + ZenToHan(sx);  
                                         end else begin  
                                                 if      (No <> '') and (No <> '-')      and (No <> '−') then   begin  
                                                         Add(sp, i, No);  
                                                 end;  
                                                 sw      :=      False;  
                                                 i := i - 1;  
                                                 No      :=      '';  
                                         end;  
                                 end else begin  
                                         oc      :=      '';  
                                         chk :=  False;  
                                 end;  
                                 al      :=      False;  
377                          end;                          end;
378                  end;  
379                  inc(i);                          if System.Pos(ch, SN) > 0 then begin
380                  if      (i > Length(Body))      then    begin                                  No := No + ch;
381                          if      (sw)    then    begin                          end else if (ch = '-') then begin
382                                  if      (No <> '')      then    Add(sp, i, No);                                  if sw then break;
383                                    if No = '' then break;
384                                    No := No + ch;
385                                    sw := true;
386                            end else begin
387                                    break;
388                          end;                          end;
                         Break;  
389                  end;                  end;
390          end;          end;
         for i :=        List.Count - 1  downto  0 do    begin  
                 if      (AnsiPos('-', PIndex(List[i]).FNo) > 0) then    begin  
                         st      :=      ChooseString(PIndex(List[i]).FNo, '-', 0);  
                         et      :=      ChooseString(PIndex(List[i]).FNo, '-', 1);  
                 end else begin  
                         st      :=      PIndex(List[i]).FNo;  
                         et      :=      PIndex(List[i]).FNo;  
                 end;  
                 if not DatToHTML then  
                 r :=    Copy(r,0, PIndex(List[i]).FIndexFrom - 1) +  
                                         Format('<a href="../test/read.cgi?%s=%s&%s=%s&%s=%s&%s=%s&%s=%s" target="_blank">',  
                                                                 [ParamBBS, Bbs, ParamKey, Key, ParamStart, st, ParamTo, et, ParamNoFirst, ParamTrue]) +  
                                         Copy(r,PIndex(List[i]).FIndexFrom, PIndex(List[i]).FIndexTo - PIndex(List[i]).FIndexFrom) + '</A>' +  
                                         Copy(r,PIndex(List[i]).FIndexTo,Length(r))  
                 else  
                 r :=    Copy(r,0, PIndex(List[i]).FIndexFrom - 1) +  
                                         Format('<a href="#%s">', [st]) +  
                                         Copy(r,PIndex(List[i]).FIndexFrom, PIndex(List[i]).FIndexTo - PIndex(List[i]).FIndexFrom) + '</A>' +  
                                         Copy(r,PIndex(List[i]).FIndexTo,Length(r));  
391    
392                  Dispose(PIndex(List[i]));          function checkComma : boolean;
         end;  
         List.Free;  
         Result  :=      r;  
 end;  
   
 function THTMLCreate.ConvRes(  
         const Body, Bbs, Key, ParamBBS, ParamKey,  
         ParamStart, ParamTo, ParamNoFirst,  
         ParamTrue, FullURL : string  
 ): string;  
 type  
         PIndex = ^TIndex;  
         TIndex = record  
                 FIndexFrom      : integer;  
                 FIndexTo                : integer;  
                 FNo                              : string;  
         end;  
 const  
         GT      = '&gt;';  
         SN      = '0123456789-';  
         ZN      = '0123456789−';  
 var  
         i : integer;  
         s,r : string;  
         b : TMbcsByteType;  
         sw: boolean;  
         sp: integer;  
         No: string;  
         sx: string;  
         List: TList;  
         oc      : string;  
         st, et: string;  
         chk : boolean;  
         al : boolean;  
         procedure Add(IndexFrom, IndexTo: integer; const No: string);  
         var  
                 FIndex : PIndex;  
393          begin          begin
394                  New(FIndex);                  j := 1;
395                  FIndex.FIndexFrom       := IndexFrom;                  len := Length(s);
396                  FIndex.FIndexTo         := IndexTo;                  if ((len > 0) and (s[j] = ',')) or ((len > 1) and (ZenToHan(Copy(s, j ,2)) = ','))  then begin
397                  FIndex.FNo                               := No;                          Result := true;
398                  List.Add(FIndex);                          if (ByteType(s, j) = mbSingleByte) then
399          end;                                  Inc(j)
400          function ChooseString(const Text, Separator: string; Index: integer): string;                          else
401          var                                  Inc(j, 2);
402                  S : string;                          No := '';
403                  i, p : integer;                  end else begin
404          begin                          Result := false;
                 S :=    Text;  
                 for i :=        0 to    Index - 1 do    begin  
                         if      (AnsiPos(Separator, S) = 0) then        S :=    ''  
                         else    S :=    Copy(S, AnsiPos(Separator, S) + Length(Separator), Length(S));  
405                  end;                  end;
                 p :=    AnsiPos(Separator, S);  
                 if      (p > 0) then    Result  :=      Copy(S, 1, p - 1) else Result :=        S;  
406          end;          end;
407  begin  begin
408          { v1.0 b2 - 03 }          //s に本文を全部入れる
409          s        :=     Body;          s        :=     Body;
410          r        :=     Body;          //結果をクリア
411          i        :=     1;          Result   :=     '';
412          sw      :=      False;          //検索対象の文字列郡
413          No      :=      '';          token[0] := GT + GT;
414          List:=  TList.Create;          token[1] := GT;
415          oc      :=      '';          token[2] := '>>';
416          sp      :=      0;          token[3] := '>';
417          chk :=  False;          token[4] := '<a ';
418          al      :=      False;          token[5] := '<A ';
419          while true      do      begin  
420                  b :=    ByteType(s, i);          //
421                  case    b of          while Length(s) > 2 do begin
422                          mbSingleByte    : begin                  pmin := Length(s) + 1;
423                                  if      (not sw) and (Copy(s,i,8) = GT + GT) then       begin                  i       := Length(token);
424                                          if      (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 0) then        begin                  for j := 0 to 5 do begin
425                                                  sw      :=      True;                          pos := AnsiPos(token[j], s);
426                                                  sp      :=      i;                          if pos <> 0 then begin
427                                                  i :=    i + 7;                                  if pos < pmin then begin
428                                                  oc:='';                                          //どれでヒットしたか保存
429                                                  chk :=  True;                                          i := j;
430                                          end;                                          //最小値を更新
431                                  end else                                          pmin := pos;
                                 if      (not sw) and (Copy(s,i,8) = GT + GT) then       begin  
                                         if      (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 1) then        begin  
                                                 i :=    i + 7;  
                                                 oc:='';  
                                                 chk :=  True;  
                                         end;  
                                 end else  
                                 if      (not sw) and (Copy(s,i,4) = GT) then    begin  
                                         if      (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 0) then        begin  
                                                 sw      :=      True;  
                                                 sp      :=      i;  
                                                 i :=    i + 3;  
                                                 oc:='';  
                                                 chk :=  True;  
                                         end;  
                                 end else  
                                 if      ((not sw) and (Copy(s,i,1) = ',')) or  
                                                 ((not sw) and (Copy(s,i,1) = '=')) then begin  
                                         if      ((not Chk) and (AnsiLowerCase(oc) = '</a>')) or  
                                                         ((Chk) and      (oc = '')) or  
                                                         ((not Chk) and (al)) then  
                                         begin  
                                                 sw      :=      True;  
                                                 sp      :=      i;  
                                                 //i :=  i + 1;  
                                                 oc:='';  
                                         end;  
                                 end else  
                                 if      (sw) then begin  
                                         sx      :=      Copy(s,i,1);  
                                         if      (AnsiPos(sx, SN) > 0)   then    begin  
                                                 No      :=      No      + sx;  
                                         end else begin  
                                                 if      (No <> '') and (No <> '-')       then   begin  
                                                         Add(sp, i, No);  
                                                         al := True;  
                                                 end;  
                                                 sw      :=      False;  
                                                 //  
                                                 i := i - 1;  
                                                 //  
                                                 No      := '';  
                                                 oc:='';  
                                                 //chk :=        False;  
                                         end;  
                                 end else begin  
                                         if      Copy(s,i,1) = '<' then  oc      :=      '';  
                                         oc      :=      oc + Copy(s,i,1);  
                                         chk :=  False;  
                                         al      :=      False;  
432                                  end;                                  end;
433                          end;                          end;
434                          mbLeadByte      : begin                  end;
435                                  if      (not sw) and (Copy(s,i,4) = '>>') then        begin  
436                                          sw      :=      True;                  //ヒットした文字列の一つ手前まで結果にコピー
437                                          sp      :=      i;                  Result := Result + Copy(s, 1, pmin - 1);
438                                          i :=    i + 3;                  Delete(s, 1, pmin - 1);
439                                          chk :=  True;  
440                                  end else                  if i = 6 then begin
441                                  if      (not sw) and (Copy(s,i,2) = '>') then  begin                          //ヒットなし
442                                          sw      :=      True;                  end else if (i = 4) or (i = 5) then begin
443                                          sp      :=      i;                          //'<a ' or '<A' でヒット '</a>' or '</A>' までコピー
444                                          i :=    i + 1;                          pmin := AnsiPos('</a>' , s);
445                                          chk :=  True;                          pos := AnsiPos('</A>' , s);
446                                  end else                          if (pmin <> 0) and (pos <> 0) then begin
447                                  if      (sw) then begin                                  if (pmin > pos) then begin
448                                          sx      :=      Copy(s,i,2);                                          pmin := pos;
449                                          if      (AnsiPos(sx, ZN) > 0)   then    begin                                  end;
450                                                  No      :=      No      + ZenToHan(sx);                          end else if (pos <> 0) then begin
451                                          end else begin                                  pmin := pos;
452                                                  if      (No <> '') and (No <> '-')      and (No <> '−') then   begin                          end;
453                                                          Add(sp, i, No);                          rink := Copy(s, 1, pmin + 3);
454                                                  end;                          Result := Result + rink;
455                                                  sw      :=      False;                          Delete(s, 1, pmin + 3);
456                                                  i := i - 1;  
457                                                  No      :=      '';                          pmin := Length(rink);
458                            i       := Length(token);
459                            for j := 0 to 3 do begin
460                                    pos := AnsiPos(token[j], rink);
461                                    if pos <> 0 then begin
462                                            if pos < pmin then begin
463                                                    //どれでヒットしたか保存
464                                                    i := j;
465                                                    //最小値を更新
466                                                    pmin := pos;
467                                          end;                                          end;
                                 end else begin  
                                         oc      :=      '';  
                                         chk :=  False;  
468                                  end;                                  end;
                                 al      :=      False;  
469                          end;                          end;
470                  end;                          // レスアンカーが含まれていたら,が続く限りアンカーとして扱う
471                  inc(i);                          if i <= 3 then begin
472                  if      (i > Length(Body))      then    begin                                  No := '';
473                          if      (sw)    then    begin                                  cm := checkComma;
474                                  if      (No <> '')      then    Add(sp, i, No);                                  len := Length(s);
475                                    while cm do begin
476                                            oc := '';
477                                            No := '';
478                                            sw := false;
479                                            db := false;
480                                            getNumberString;
481                                            Result := addResAnchor(Result);
482                                            cm := checkComma;
483                                    end;
484                          end;                          end;
                         Break;  
                 end;  
         end;  
         for i :=        List.Count - 1  downto  0 do    begin  
                 //plName := Copy(PluginName, LastDelimiter('\',PluginName) + 1, Length(PluginName) - LastDelimiter('/',PluginName) -1 );  
                 if      (AnsiPos('-', PIndex(List[i]).FNo) > 0) then    begin  
                         st      :=      ChooseString(PIndex(List[i]).FNo, '-', 0);  
                         et      :=      ChooseString(PIndex(List[i]).FNo, '-', 1);  
485                  end else begin                  end else begin
486                          st      :=      PIndex(List[i]).FNo;                          //何かしら見つかったパターン
487                          et      :=      PIndex(List[i]).FNo;                          j := Length(token[i]) + 1;
488                            oc := '';
489                            No := '';
490                            sw := false;
491                            db := false;
492                            len := Length(s);
493                            getNumberString;
494                            Result := addResAnchor(Result);
495                  end;                  end;
                 r :=    Copy(r,0, PIndex(List[i]).FIndexFrom - 1) +  
                                         Format('<a href="%s&%s=%s&%s=%s&%s=%s" target="_blank">',  
                                                                 [FullURL, ParamStart, st, ParamTo, et, ParamNoFirst, ParamTrue]) +  
                                         Copy(r,PIndex(List[i]).FIndexFrom, PIndex(List[i]).FIndexTo - PIndex(List[i]).FIndexFrom) + '</A>' +  
                                         Copy(r,PIndex(List[i]).FIndexTo,Length(r));  
                 Dispose(PIndex(List[i]));  
496          end;          end;
497          List.Free;          Result := Result + s;
         Result  :=      r;  
498  end;  end;
499    
500  function THTMLCreate.ConvertResAnchor(res: string): string;  function THTMLCreate.ConvertResAnchor(res: string): string;

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26