Develop and Download Open Source Software

Browse CVS Repository

Diff of /gikonavigoeson/gikonavi/Giko.pas

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

revision 1.510 by h677, Thu Mar 31 13:01:55 2005 UTC revision 1.511 by h677, Sat Apr 2 03:08:05 2005 UTC
# Line 954  type Line 954  type
954      procedure SortActiveColumnActionExecute(Sender: TObject);      procedure SortActiveColumnActionExecute(Sender: TObject);
955      procedure SortNextColumnActionExecute(Sender: TObject);      procedure SortNextColumnActionExecute(Sender: TObject);
956      procedure SortPrevColumnActionExecute(Sender: TObject);      procedure SortPrevColumnActionExecute(Sender: TObject);
     procedure BrowserExit(Sender: TObject);  
957      procedure MessageListViewAdvancedCustomDrawItem(      procedure MessageListViewAdvancedCustomDrawItem(
958        Sender: TCustomListView; Item: TListItem; State: TCustomDrawState;        Sender: TCustomListView; Item: TListItem; State: TCustomDrawState;
959        Stage: TCustomDrawStage; var DefaultDraw: Boolean);        Stage: TCustomDrawStage; var DefaultDraw: Boolean);
# Line 1137  type Line 1136  type
1136                  procedure SetSelectWord( const text : string );                  procedure SetSelectWord( const text : string );
1137                  //ブラウザの再描画 true:全てのタブ false:アクティブなタブのみ                  //ブラウザの再描画 true:全てのタブ false:アクティブなタブのみ
1138                  procedure RepaintAllTabsBrowser();                  procedure RepaintAllTabsBrowser();
1139            //リンクの文字列からレスポップアップ用のURLに変換する
1140            function GetRespopupURL(AText, AThreadURL : string): string;
1141          protected          protected
1142                  procedure CreateParams(var Params: TCreateParams); override;                  procedure CreateParams(var Params: TCreateParams); override;
1143                  procedure WndProc(var Message: TMessage); override;                  procedure WndProc(var Message: TMessage); override;
# Line 1360  begin Line 1361  begin
1361                  FBrowsers.Add(TWebBrowser.Create(nil));                  FBrowsers.Add(TWebBrowser.Create(nil));
1362                  newBrowser := FBrowsers[FBrowsers.Count - 1];                  newBrowser := FBrowsers[FBrowsers.Count - 1];
1363                  TOleControl(newBrowser).Parent := BrowserPanel;                  TOleControl(newBrowser).Parent := BrowserPanel;
1364                  newBrowser.Align := alNone;                  TOleControl(newBrowser).Align := alNone;
1365                  newBrowser.Left := 0;                  TOleControl(newBrowser).Left    := 0;
1366                  newBrowser.Top  := 0;                  TOleControl(newBrowser).Top     := 0;
1367                  //newBrowser.StatusBar  := false;                  //newBrowser.StatusBar  := false;
1368                  //newBrowser.MenuBar            := false;                  //newBrowser.MenuBar            := false;
1369                  //newBrowser.AddressBar         := false;                  //newBrowser.AddressBar         := false;
# Line 2997  begin Line 2998  begin
2998                          end;                          end;
2999                  end else begin                  end else begin
3000                          threadItem := GetActiveContent;                          threadItem := GetActiveContent;
3001                          if Pos('about:blank..', Text) = 1 then begin              URL := GetRespopupURL(Text, threadItem.URL);
                                 wkInt := LastDelimiter( '/', threadItem.URL );  
                                 if Pos( '?', Copy( threadItem.URL, wkInt, MaxInt ) ) = 0 then begin  
                                         // Thread.URL は PATH_INFO 渡し  
                                         URL := Copy( threadItem.URL, 1,  LastDelimiter( '/', threadItem.URL ) );  
                                         wkInt := LastDelimiter( '/', Text );  
                                         if Pos( '?', Copy( Text, wkInt, MaxInt ) ) = 0 then  
                                                 // Text も PATH_INFO 渡し  
                                                 URL := URL + Copy( Text, LastDelimiter( '/', Text ) + 1, MaxInt )  
                                         else  
                                                 // Text は QUERY_STRING 渡し  
                                                 URL := URL + Copy( Text, LastDelimiter( '?', Text ) + 1, MaxInt );  
                                 end else begin  
                                         // Thread.URL は QUERY_STRING 渡し  
                                         URL := Copy( threadItem.URL, 1,  LastDelimiter( '?', threadItem.URL ) );  
                                         wkInt := LastDelimiter( '/', Text );  
                                         if Pos( '?', Copy( Text, wkInt, MaxInt ) ) = 0 then begin  
                                                 // Text は PATH_INFO 渡し  
                                                 // URL に板とキーが足らないので Text から頂戴する  
                                                 wkInt := LastDelimiter( '/', Copy( Text, 1, wkInt - 1 ) );  
                                                 wkInt := LastDelimiter( '/', Copy( Text, 1, wkInt - 1 ) );  
                                                 URL := Copy( URL, 1, Length( URL ) - 1 ) + Copy( Text, wkInt, MaxInt );  
                                         end else begin  
                                                 // Text も QUERY_STRING 渡し  
                                                 URL := URL + Copy( Text, LastDelimiter( '?', Text ) + 1, MaxInt )  
                                         end;  
                                 end;  
                         end else begin  
                                 URL := Text;  
                         end;  
   
3002                          PathRec := Gikosys.Parse2chURL2(URL);                          PathRec := Gikosys.Parse2chURL2(URL);
3003                          if (PathRec.FNoParam) then begin                          if (PathRec.FNoParam) then begin
3004                                  PathRec.FSt := 1;                                  PathRec.FSt := 1;
# Line 3055  begin Line 3026  begin
3026                                          wkIntTo := wkIntSt;                                          wkIntTo := wkIntSt;
3027                                          wkIntSt := wkInt;                                          wkIntSt := wkInt;
3028                                  end;                                  end;
                                 //if wkIntSt = 0 then  
                                 //      wkIntSt := 1;  
                                 //if wkINtTo = 0 then  
                                 //      wkIntTo := 1;  
                                 //if PathRec.FFirst then  
                                 //      wkIntSt := 1;  
                                 //if PathRec.FStBegin then //http://〜〜〜〜/-50というとき  
                                 //      wkIntSt := 1;          //  
                                 //if PathRec.FToEnd then   //http://〜〜〜〜/50-というとき  
                                 //      wkIntTo := 9999;       // どちらの場合も、GetPopupResNumberでうまく番号を調整するのでふよう。  
   
                                 //ATitle := ActiveFileName <> PathRec.FKey;  
3029                                  if (FActiveContent <> nil) and (FActiveContent.Thread.URL = URL) then                                  if (FActiveContent <> nil) and (FActiveContent.Thread.URL = URL) then
3030                                          ATitle := false                                          ATitle := false
3031                                  else                                  else
# Line 6418  var Line 6377  var
6377          wkIntSt: Integer;          wkIntSt: Integer;
6378          wkIntTo: Integer;          wkIntTo: Integer;
6379          document: IHTMLDocument2;          document: IHTMLDocument2;
6380        BNum, BRes: string;
6381        threadItem: TThreadItem;
6382  begin  begin
6383    
6384          Cancel := True;          Cancel := True;
# Line 6452  begin Line 6413  begin
6413    
6414                          end;                          end;
6415                  end else begin                  end else begin
6416                ////'http://be.2ch.net/test/p.php?i='+id+'&u=d:'+bas+num
6417    
6418                          URL := GikoSys.GetHRefText(Html);                          URL := GikoSys.GetHRefText(Html);
6419                          URL := GikoSys.HTMLDecode(URL);                          URL := GikoSys.HTMLDecode(URL);
6420                if AnsiPos('BE:', URL) = 1 then begin
6421                    BNum := Copy(URL, 4, AnsiPos('/', URL) - 4);
6422                    BRes := Copy(URL, AnsiPos('/', URL) + 1,  Length(URL));
6423                    threadItem := FActiveContent.Thread;
6424                    if threadItem = nil then Exit;
6425                    URL := BE_PHP_URL + BNum + '&u=d'
6426                            + CustomStringReplace(threadItem.URL, 'l50', '') + BRes;
6427                end;
6428    
6429                          if( AnsiPos('http://', URL) = 1) or (AnsiPos('https://', URL) = 1) or                          if( AnsiPos('http://', URL) = 1) or (AnsiPos('https://', URL) = 1) or
6430                                  ( AnsiPos('ftp://', URL) = 1) then begin                                  ( AnsiPos('ftp://', URL) = 1) then begin
6431                                  //アドレスバーの履歴                                  //アドレスバーの履歴
# Line 12174  begin Line 12146  begin
12146    
12147  end;  end;
12148    
 procedure TGikoForm.BrowserExit(Sender: TObject);  
 begin  
         IDAnchorPopup('');  
 end;  
   
12149  procedure TGikoForm.RepaintAllTabsBrowser();  procedure TGikoForm.RepaintAllTabsBrowser();
12150  var  var
12151          i : Integer;          i : Integer;
# Line 12214  begin Line 12181  begin
12181          if (GikoSys.Setting.BeLogin) then BeLogInOutAction.Checked := true          if (GikoSys.Setting.BeLogin) then BeLogInOutAction.Checked := true
12182          else BeLogInOutAction.Checked := false;          else BeLogInOutAction.Checked := false;
12183          BeLogInOutAction.Enabled := true          BeLogInOutAction.Enabled := true
12184      end else      end else
12185          BeLogInOutAction.Enabled := false;          BeLogInOutAction.Enabled := false;
12186    
12187  end;  end;
12188    //リンクの文字列からレスポップアップ用のURLに変換する
12189    function TGikoForm.GetRespopupURL(AText, AThreadURL : string): string;
12190    var
12191            wkInt: Integer;
12192    begin
12193        Result := '';
12194        if Pos('about:blank..', AText) = 1 then begin
12195            wkInt := LastDelimiter( '/', AThreadURL );
12196            if Pos( '?', Copy( AThreadURL, wkInt, MaxInt ) ) = 0 then begin
12197                // Thread.URL は PATH_INFO 渡し
12198                Result := Copy( AThreadURL, 1,  LastDelimiter( '/', AThreadURL ) );
12199                wkInt := LastDelimiter( '/', AText );
12200                if Pos( '?', Copy( AText, wkInt, MaxInt ) ) = 0 then
12201                    // Text も PATH_INFO 渡し
12202                    Result := Result + Copy( AText, LastDelimiter( '/', AText ) + 1, MaxInt )
12203                else
12204                    // Text は QUERY_STRING 渡し
12205                    Result := Result + Copy( AText, LastDelimiter( '?', AText ) + 1, MaxInt );
12206            end else begin
12207                // Thread.URL は QUERY_STRING 渡し
12208                Result := Copy( AThreadURL, 1,  LastDelimiter( '?', AThreadURL ) );
12209                wkInt := LastDelimiter( '/', AText );
12210                if Pos( '?', Copy( Text, wkInt, MaxInt ) ) = 0 then begin
12211                    // Text は PATH_INFO 渡し
12212                    // URL に板とキーが足らないので Text から頂戴する
12213                    wkInt := LastDelimiter( '/', Copy( AText, 1, wkInt - 1 ) );
12214                    wkInt := LastDelimiter( '/', Copy( AText, 1, wkInt - 1 ) );
12215                    Result := Copy( Result, 1, Length( Result ) - 1 ) + Copy( AText, wkInt, MaxInt );
12216                end else begin
12217                    // Text も QUERY_STRING 渡し
12218                    Result := Result + Copy( Text, LastDelimiter( '?', AText ) + 1, MaxInt )
12219                end;
12220            end;
12221        end else if Pos('about:blank/bbs/', AText) = 1 then begin
12222            //したらばJBBSの仕変の吸収
12223            AText := CustomStringReplace(AText, 'about:blank/bbs/', 'about:blank../../bbs/');
12224            Result := GetRespopupURL(AText, AThreadURL);
12225        end else begin
12226            Result := AText;
12227        end;
12228    
12229    end;
12230    
12231    
12232    
12233  initialization  initialization
12234                                  OleInitialize(nil);                                  OleInitialize(nil);

Legend:
Removed from v.1.510  
changed lines
  Added in v.1.511

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