Delphiの将来 (ID：48738)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

これに乗じて…文字化け対応ブラウザ（ミニマム版）を投稿しておきますね (^^;
※Button2Clickで、本掲示板特有の文字化けを修復します。

implementation

{$R *.dfm}

uses
  UrlMon,     // URLOpenBlockingStream
  ActiveX;    // IStream、他

// 生のHTMLソースをダウンロードする
// 理由： ブラウザから取得すると、化けているデータのうちShift_JISに存在しない
// 文字コードに化けた部分（た行、だ行など）は「・」に置換されているためデータが
// 失われた状態となり、文字化けを復元する際に正しく元の文字に戻すことが出来ない。
// 参考： http://stackoverflow.com/questions/11074772/urlopenblockingstream-gives-same-page
function DownloadFromURL(URL : String): AnsiString;
var
  ppStream: IStream;
  statstg: TStatStg;
  dwRead: Integer;
begin
  Result:='';
  if Failed(URLOpenBlockingStream(nil, PChar(URL), ppStream, 0, nil)) then Exit;

try
    if Succeeded(ppStream.Stat(statstg, STATFLAG_NONAME)) and
       (statstg.cbSize>0) then begin
      SetLength(Result, statstg.cbSize);
      ppStream.Read(Pointer(Result), statstg.cbSize, @dwRead);
    end;
  finally
    ppStream:=nil;
  end;
end;

// データが誤って1byte毎にUTF-8エンコードされてしまった文字化けを修復する
// 副作用： 化けてない正しいデータだと$C2や$C3を含む文字（つ・板など）は化ける。
function UTF8MojibakeFix(const Str: AnsiString): AnsiString;
var
  Flag: Boolean;
  I: Integer;
begin
  Result:='';
  Flag:=False;
  for I:=1 to Length(Str) do begin
    if Flag then begin
      Result:=Result+AnsiChar(Byte(Str[I])+$40);
      Flag:=False;
    end else begin
      case Str[I] of
        AnsiChar($C2): Flag:=False;
        AnsiChar($C3): Flag:=True;
      else
        Result:=Result+Str[I];
      end;
    end;
  end;
end;

// #$00 を #$20 に置換する
// 理由： AnsiString内にNull文字が混入していると、そこまでしか出力されないため。
function DeleteNull(const Str: AnsiString): AnsiString;
var
  I: Integer;
begin
  Result:=Str;
  for I:=1 to Length(Result) do begin
    if Result[I]=AnsiChar($00) then Result[I]:=AnsiChar($20);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text:='http://madia.world.coocan.jp/cgi-bin/DelphiBBS/wwwlng.cgi';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  WebBrowser1.Navigate(Edit1.Text);
end;

procedure TForm1.Button2Click(Sender: TObject);
const
  ScriptStr =
    'function ReplaceBody(Html){'+
    '  document.body.innerHTML=Html.replace('+
    '    /^[\s\S]*<\s*body(\s+[^>]*)?>|<\s*\/\s*body\s*>[\s\S]*$/ig, ""'+
    '  );'+
    '}';
var
  ExactHTML: AnsiString;
begin
  if VarIsClear(WebBrowser1.Document) then Exit;

ExactHTML:=DownloadFromURL(WebBrowser1.LocationURL);
  ExactHTML:=UTF8MojibakeFix(ExactHTML);
  ExactHTML:=DeleteNull(ExactHTML);

WebBrowser1.OleObject.document.parentWindow.execScript(ScriptStr);
  WebBrowser1.OleObject.document.parentWindow.ReplaceBody(ExactHTML);
end;

initialization
  OleInitialize(nil);

finalization
  OleUninitialize;

end.

←解決時は質問者本人がここをチェックしてください。

戻る