daily dayflower

2010-06-30

SHDocVw で表示中のページをファイルに保存

せめて月イチくらいでは何かかきたいので書く。

んで,ブラウザコンポーネント(SHDocVw)で,表示中のページをファイルに保存する方法。ただし画像等のリソースファイルの保存(Web ページ、完全)や Web アーカイブとしての保存はできない。「Web ページ、HTML のみ」のイメージ。リソース込みで保存したい場合の方策はあるのかな。

ほぼ how to save html file in VC++ で引用されているサンプルのまま。

ほんとはフォームの pas ファイルからの切り出しなので FWebBrowser が外在化してたりおかしいけど,サンプルなので。

uses
  OleCtrls, ActiveX, SHDocVw;

var
  FWebBrowser: TWebBrowser;

procedure SaveWebPage(AFileName: string);
var
  PFile: IPersistentFile;
  WFileName: PWideChar;
begin
  PFile := FWebBrowser.Document as IPersistFile;

  WFileName := StringToOleStr(AFileName);

  try
    PFile.Save(WFileName, False);
  finally
    SysFreeString(WFileName);
  end;
end;

独立したプロシジャになってるけど,ほんとは NavigateComplete2 イベントが発火したあとに実行するなど,いろいろ考えなくてはいけない。

メリット
  • Cookie 等について考える必要がない
デメリット
  • エンコードミスマッチ文字化けしていた場合はどうなる?
  • Excel や Word などが内部で開かれた場合はどうなる?
  • エラー(5xx や 4xx 系)がおきた場合のハンドリングがめんどう(イベントドリブンなので)

つまり。

すでに SHDocVw コンポーネントを(オートパイロット的に)使っている場合には使ってもいい(価値がある)。そうでなくて wget 的ことがしたいときにわざわざ SHDocVw を使うのは意味がない。そのような場合たとえば WinInet などを使えばよい(.Net だと webClient を使うほうがお気楽かな)。WinInet で Cookie 込みで使うノウハウはまだもってないので,暇ができたらやってみたい。

2007-10-31

Delphi 6 で XP Style に対応する

Delphi 7 以降を買えという気もしますが,未だに Delphi 6 Personal 版を愛用している人もいるかと。

俗に manifest 書けばできるよ(⇒ Windows XP の Luna スタイルに対応しよう)といわれていますが,TPageControl とか対応してないコントロールがあったり,ちまちまと WS_EX_TRANSPARENT スタイルを指定しても TCheckBox や TRadioBox の背景が塗りつぶされたり,と悲惨な目にあいます。

で,あれこれ面倒をみてくれるのが,Soft Gems の Windows XP Theme Manager (⇒Soft Gems Homepage)です。なんといっても Delphi 7 以降にはこいつが付属した(そして XP Style 対応とした)といわれているくらいなので,お墨付き度満点です。

こいつを使って XP Style 化するには,こいつをインストールしてメインのフォームに TThemeManager をおいて,manifest を用意すれば*1できます。

んでも,実はビジュアルコンポーネントである必要はないんですよね。なので,他所にもっていっても動くプロジェクトソースにすることができます。

プロジェクトディレクトリ

  • ThemeMgr.pas
  • ThemeSrv.pas
  • TmSchema.pas
  • UxTheme.pas
  • Compliers.inc

をコピーして,メインのフォームで下記のようにすれば,実行時に自動的に XP Style を適用してくれます。Delphi 側にインストールしておく必要はありません。

uses
  Forms,
  ThemeMgr;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FThemeManager: TThemeManager;
  end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FThemeManager := TThemeManager.Create(Self);
  FThemeManager.Options := DefaultThemeOptions - [ toSubclassSpeedButtons ];
  FThemeManager.CollectForms();
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FThemeManager.Free;
end;

FThemeManager.CollectForms を実行しないと,メインフォームだけ XP Style 対象外になってしまったりしてはまりました。あと TSpeedButton に XP Style が適用された見た目が(個人的に)気にくわなかったので,上記サンプルではそのオプションを外してあります。

ちなみに,実行時パッケージなしで Theme Manager を組み込むと 200KB ほど実行ファイルのサイズが増えますので臨機応変に。

*1:コントロールの整合性をとるため manifest がないと XP style にならないようになってるのです

2007-10-26

TWebBrowser を実行時に生成する

使ってる人には常識的な話でしょうけど。

TWebBrowser は COM コンポーネント側に Parent という(IDispatch 型の)プロパティを持っています。で,これが VCL の Parent プロパティを隠してしまうので,実行時生成しようとすると困ります。

FWebBrowser := TWebBroser.Create(Form1);

FWebBrowser.Parent := Form1;

とかやると,「読み込み専用のプロパティ Parent に値を設定しようとしました」とかなんとか怒られます。

TWebBrowserTObject ⇒……⇒ TWinControlTOleControl な継承ツリーの下にいるので,TWinControl にキャストしてやれば OK です。

で勇んで

(FWebBrowser1 as TOleControl).Parent := Form1;

とやるとまだ怒られる罠。Object Pascal むずかしーな。

TOleControl(FWebBrowser).Parent := Form1;

とほんとに静的キャストする必要があるのでした。

Panel1 の内部に alClient で動的に作成する例。

FWebBrowser := TWebBrowser.Create(Form1);

with TOleControl(FWebBrowser) do begin
  Parent := Panel1;
  Name   := 'FWebBrowser';
end;

with FWebBrowser do begin
  Align := alClient;

  AddressBar  := False;
  FullScreen  := False;
  MenuBar     := False;
  Offline     := False;
  Silent      := False;
  StatusBar   := False;
  TheaterMode := False;

  Visible := True;
end;

ちなみに動的に生成するメリットは,ですが,

  • TWebBrowserActiveX コントロールなので,生成に時間がかかる。このため,普通にフォームに貼り付けると起動時にもっさりしてしまうので,自力で生成して挙動を完全に自力でコントロールしたい。
  • SHDocVw.pas をプロジェクトソースに添付しておける。自己流に手を加えている場合とか,人にソースを送りつけるときとか,いちいち「タイプライブラリから取り込んどいてね」とかいわなくていい。

などがあります。このコンポーネントについてはフォームデザイナからインタラクティブにぐりぐりいじる必要性があんまりないですしね。

2007-10-24

Delphi で暗号化するなら CAPICOM を使うと楽

Delphi に限った話でもないですが。

win32 で DES 等の暗号化をしようと思った場合,Windows に標準で付属している Crypto API を使うと,外部ライブラリ等を自力でコンパイルする必要がありません。この Crypto API の使い方はトラスト・ソフトウェア・システムさんの文書(簡単な暗号化 - 共通鍵暗号化)に詳しく書いてあります。

ですが,Wincrypt.h というの,Delphi 6(等)には標準で付属していないんですよね。FreePascal の h2pas を使って必要な部分だけコピペしてあれこれやろうとしていたんですが,この API を使うこと自体も面倒くさい。

と思って Windows SDK の文書を眺めていたら,Crypto API だけでなく,CAPICOM というものがあるそうな。C(rypto)API COM interface ……つまり Crypto API が COM オブジェクト化されてるらしいです。おお,これなら Delphi とかから使うの楽そうだ。

ということで,使ってみました。といっても CAPICOM の使い方はとっても簡単。VBScript の例ですが,no title のような記事もあります。

Delphi で CAPICOM を使うには,

  • 「タイプライブラリの取り込み」で「CAPICOM v2.1 Type Library」を取り込む
  • コンポーネントラッパーの作成」はどちらでもよい。ですが,私は Delphi チックに TEncryptedData 等々使いたかったのでチェックしておきました。
  • ビジュアルコンポーネントがあるわけではないので,プロジェクトのフォルダにもってきて取り込んでよい(念のため Register プロシージャを削除)
  • ユニットの initialization 節に CoInitialize(nil); を,finalization 節に CoUninitialize(); を追加

な手順を踏めば OK。

実際使用するコードの例ですが,拙いものを下記においときます。

uses CAPICOM_TLB;

var
  enc: TEncryptedData;
  tut: TUtilities;
begin
  enc := TEncryptedData.Create(Self);
  try
    enc.Algorithm.Name      := CAPICOM_ENCRYPTION_ALGORITHM_DES;
    enc.Algorithm.KeyLength := CAPICOM_ENCRYPTION_KEY_LENGTH_128_BITS;
    enc.SetSecret('secret', CAPICOM_SECRET_PASSWORD);

    enc.Content := MemoDecrypted.Text;

    tut := TUtilities.Create(Self);
    try
      MemoEncrypted.Text := tut.BinaryToHex(enc.Encrypt(CAPICOM_ENCODE_BINARY));
    finally
      tut.Free();
    end;
  finally
    enc.Free();
  end;
end;

Algorithm プロパティをあれこれ操作していますが,特に設定しなくてもデフォルト設定のまま動きます。

また,デフォルトで CAPICOM.EncryptedData::Encrypt() メソッドは Base64 なデータを返すので,サンプルの意味もこめて,CAPICOM.Utilities オブジェクトの BinaryToHex を使用して hex で取得しています*1

Crypto API のように細かい調整はかけにくいですが,お手軽に使うのなら CAPICOM でいいんではないでしょうか。


問題は CAPICOM オブジェクトがどの Windows において標準で登録されているか,ですが,わかりません。一応 Redistributable なコンポーネントではあります。

2007/11/02 追記

標準で登録されてるかどうかについて。

んー条件がよくわからないですが,

  • Windows XP SP 2: OK (開発機)
  • Windows XP SP 2: NG (他の機)
  • Windows Vista: OK
  • Windows 2000 SP 4: OK

という結果でした。

どうも,We are sorry, the page you requested cannot be found ことにより,Microsoft Update した機種だとインストールされるっぽい(⇒CAPICOM が突如搭載されることになった)です。

なお(少なくとも)上記のパッチを手動でインストールすると,システムフォルダではなくて Program Files のあるフォルダにインストールされます。その理由についてはこちらのブログ参照ってことで。

で,SDK Redistributable ですが,

ここからダウンロードできるのですが,表記は 2.1.0.1 になってますが,中身は 2.1.0.2 (脆弱性対策済)でした。

*1:無論 VCL 標準の BinToHex 関数を使ってもいいんですが,サンプルとしての意味合いとして

2007-10-19

TDateTime のナゾ

ほとんどの VCL オブジェクト は TDateTime 型を使って日付値と時刻値を示します。TDateTime 値の整数部は西暦 1899 年 12 月 30 日からの経過日数を示します。小数部はその日の経過時間(24 時間制)です。

んーなぜ 1899/12/30 からなんでしょうね。でもそういえば Visual Basic も日付時刻型って実質浮動小数点値だった気がする。

Date の場合、時刻は 00:00:00 であり、その日の午前0時である。Time の場合日付は1899年12月30日となっているが、これは VB 6 の日付を扱う起点となる日付である。具体的な起点はというと、値がゼロになる位置を表示させれば分かる。VB 6 の日付時刻は倍精度浮動小数点数値で扱われるので、0# の値を渡せば良い。具体的には、プログラムの10行目に書いたとおりである。実行結果を見て分かるとおり、1899/12/30 00:00:00 が起点となる。

連載:プロフェッショナルVB.NETプログラミング 第5回 日付時刻の取得とフォーマット(1/3) - @IT

んあーこっちが先なのか。たぶん*1

まだしも 1899/12/31 00:00:00 を起点とすれば 1900/1/1 が 1 になって心情的に理解できなくもないですが*2,実際には 2 ですよね。謎。

ちなみに(少なくとも Delphi の場合)

TDateTime 値が負の値である場合は,時刻部分を別個に扱わなければなりません。小数部は TDateTime 値の符号とは無関係に 1 日 24 時間の端数を表します。たとえば,1899 年 12 月 29 日の午前 6:00 は -1 + 0.25(-0.75)ではなく -1.25 です。-1 と 0 の間の TDateTime 値は存在しません。

日付・時間の差分の計算が楽になるから浮動小数点値にしてると思ったんですが 1989/12/30 をまたぐと計算がおかしくなりますね。自力で計算するんじゃなくて SecondSpan 等使うほうが吉,と。

追記

なんとなく理由の予想はついたような。TDateTime も TDate も TTime も実質同じ浮動小数点型なわけですが,「時間」だけ(つまり TTime)を扱うなら,日付部分(つまり整数部分)は 0 として利用する局面が多いかと思います。

でもやっぱり 12/30 じゃなくて 12/31 でいいじゃん,と思いますが,おそらく,24:00 (= 1.0)が欲しかったんではないか,と。もちろん時刻としてはありえない値ですが,span として考えたときに 24:00 がやっぱりいるなぁ,じゃあバッファとして2日分にしておくか,と。

憶測にすぎませんが一応。

*1:VB.NET だと基数は 0001/01/01 です。ちなみに Delphi 1.0 もそう。なぜか扱いが逆転してます。

*2:でも 0 のほうが好み

2007-10-12

trac のレポジトリブラウザで Delphi のコードを syntax highlighting

trac のレポジトリブラウザでソースコードに色付けをするには,下記の2つのコンポーネントのうちいずれかをインストールする必要があります。

ただ,後者は別プロセスを立ち上げるので重そう。前者を使うことにします。

SilverCity は rpmforge 等でも rpm はなさそうなので,自らセットアップします。このへんの手順は lapis25 さんのtracでソースコードの色つけと権限設定 - LAPISLAZULI HILL#Hatenaが詳しいです。ので省略。

で,Delphi (Pascal) についてですが,SilverCity がバックエンドで利用している Scintilla のコード上ではサポートされているのですが,残念ながら SilverCity のレベルでサポートされていません。 SilverCityAddLanguage ? The Trac Project の手順に沿って Pascal 用のコードを自分で書く必要があります*1

上記ドキュメントによると SilverCity を展開したツリーの下に最新版の Scintilla のコードを展開せよ,とのことになっていますが,なぜかうまくコンパイルできませんでした。幸い SilverCity 同梱の Scintilla コードに Pascal のレキシカルアナライザが含まれているので最新版は使いませんでした。

ということで,上記ドキュメントと手順が異なるので要所要所を書いておくと,

  1. SilverCity を展開
  2. python setup.py build で一度ビルドしておく
  3. 同梱の Scintilla ライブラリを使うので ScintillaConstants.py の再生成は必要ない
  4. PySilverCity/SilverCity/Pascal.py というファイルを YAML.py あたりをベースにでっちあげる
  5. SCLEX_YAMLSCLEX_PASCAL に置き換えればいいんだけど,Pascal のアナライザはレキシカルステートとして C のものを利用しているので SCE_YAML という文字列リテラルはすべて SCE_C に置き換え
  6. Keywords.py に pascal_keywordspascal_classwords を追加する(後述)
  7. LanguageInfo.py の do_registrationimport Pascal を追加
  8. css まわりはなぜかスクリプトがみつからなかったので放置。先ほど上げたように,Pascal の場合 C と同じ css class を利用するので変更する必要はない
  9. setup.py の py_modules"SilverCity.Pascal" を追加
  10. 再度 python setup.py build を行う
  11. sudo python setup.py installインストール

と,これで Pascal 対応の SilverCity がインストールされました。Perl, HTML 等デフォルトで対応しているコードについては自動的に色がつきますが,Pascal については trac.ini を書き換える必要があります。

重要な部分だけ抽出すると,こんな感じ。

[mimeviewer]
mime_map = text/x-pascal:pas
silvercity_modes = text/x-pascal:Pascal:5

mime_map で拡張子と対応する mime-type を関連付けます。silvercity_modes に記述しておくと,指定された mime-type のものについてはたとえ Enscript がインストールされていたとしても SilverCity で色付けしてくれます。「mime-type:SilverCityの対応モジュール:品質優先度」の順になります。品質優先度,のところは私もよくわからないので適当に 5 とかしてます。

はてさて,これでようやく無事 Delphi のコードに色がつく……はずなのです。ですが私の場合,各ファイルの svn:mime-type を「text/plain; charset=Shift_JIS」としていたため*2Pascal ファイルとして認識してくれませんでした。なので,「text/x-pascal; charset=Shift_JIS」のようにする必要があります。つまり上記の mime_map で設定した mime-type を指定する必要があります。

以下,私のでっちあげた Pascal.py とか。


import HTMLGenerator
import Keywords
import Lexer
from DispatchHandler import DispatchHandler
from _SilverCity import find_lexer_module_by_id, PropertySet, WordList
from ScintillaConstants import SCLEX_PASCAL
import LanguageInfo

class PascalLexer(Lexer.Lexer):
    def __init__(self, properties = PropertySet()):
        self._properties = properties
        self._lexer = find_lexer_module_by_id(SCLEX_PASCAL)
        self._keyword_lists = [
            WordList(Keywords.pascal_keywords),
            WordList(Keywords.pascal_classwords),
                               ]
            
class PascalHandler(DispatchHandler):
    def __init__(self):
        DispatchHandler.__init__(self, 'SCE_C')

class PascalHTMLGenerator(HTMLGenerator.SimpleHTMLGenerator, PascalHandler):
    name = 'pascal'
    description = 'Pascal'

    def __init__(self):
        PascalHandler.__init__(self)
        HTMLGenerator.SimpleHTMLGenerator.__init__(self, 'SCE_C')
            
    def generate_html(self, file, buffer, lexer = PascalLexer()):
        self._file = file
        
        lexer.tokenize_by_style(buffer, self.event_handler)


pascal_language_info = LanguageInfo.LanguageInfo(
                'Pascal',
                 ['pas', 'dpr'],
                 ['.*?pascal.*?'],
                 [PascalHTMLGenerator]
            ) 

LanguageInfo.register_language(pascal_language_info)

んで,Keywords に追加する pascal_keywords と pascal_classwords は以下の通り(といってもウェブで拾ったものですが)。

pascal_keywords = \
    "and array asm begin case cdecl class const constructor " \
    "default destructor div do downto else end end. except exit " \
    "exports external far file finalization finally for function " \
    "goto if implementation in index inherited initialization " \
    "inline interface label library message mod near nil not " \
    "object of on or out overload override packed pascal private " \
    "procedure program property protected public published raise " \
    "read record register repeat resourcestring safecall set shl " \
    "shr stdcall stored string then threadvar to try type unit " \
    "until uses var virtual while with write xor"

pascal_classwords = \
    "array boolean char integer file pointer real set string " \
    "text variant write read default public protected private " \
    "property published stored"

*1:ということで仮に rpm が存在したとしても手ビルドする必要があるのでした

*2:Windows のコードですからそうしたくなりますよね

2007-10-05

クロージャの持つ関数ポインタを得るには @ 演算子を使う

type
  THogehoge = class
  public
    procedure Dummy;
  end;

var
  cl: procedure of object;
  fp: procedure;
begin
  fp := @cl;  // 関数ポインタだけ取り出し

  if @cl = @THogehoge.Dummy then
    // クロージャの関数ポインタと THogehoge の Dummy 関数が等しかったら
    ...
end;

以下,解説。


type
  TDummy = class
  private
    FMyName: string;
  public
    constructor Create(AMyName: string);
    procedure Greeting;
  end;

constructor TDummy.Create(AMyName: string);
begin
  FMyName := AMyName;
end;
  
procedure TDummy.Greeting;
begin
  Writeln('hello, ' + FMyName + '.');
end;

みたいな単純なクラスがあったとして(ありがちな例ですけど)。

var
  o1: TDummy;
begin
  o1 := TDummy.Create('hogehoge');
  o1.Greeting;
end.

こいつを実行すると,

hello, hogehoge.

と(当然)出力されますが,Delphi 用語でいうところのクロージャというのを使うと,

var
  o1: TDummy;
  cl: procedure of object;
begin
  o1 := TDummy.Create('hogehoge');
  cl := o1.Greeting;
  cl();     // クロージャの実行
end.

こいつを実行しても hello, hogehoge と表示されます。このクロージャというのはいわゆる一般的な言語の closure とはちとちがっていて,インスタンスへのポインタ+関数ポインタをまとめて熱かっているだけです。なので,この内部構造をみてみよう,というのが今回のお話。


クロージャ自身はどうせポインタだろうから,とむりやり Cardinal に変換して

var
  o1: TDummy;
  cl: procedure of object;
begin
  o1 := TDummy.Create('hogehoge');
  Writeln(Format('o1: %8.8x', [Cardinal(o1)]));

  cl := o1.Greeting;
  Writeln(Format('cl: %8.8x', [Cardinal(cl)]));
end.

このようにしても,コンパイル時に,

[エラー] 正しくない型キャスト

のように怒られてしまいます。

ともかく,クロージャの示す先を @@ という表記で取り出してみます。

var
  o1: TDummy;
  cl: procedure of object;
  pd: PLongword;
begin
  o1 := TDummy.Create('hogehoge');
  Writeln(Format('o1: %8.8x', [Cardinal(o1)]));

  cl := o1.Greeting;
  pd := PLongword(@@cl);
  Writeln(Format('cl[0]: %8.8x', [Cardinal(pd^)]));
  Inc(pd);
  Writeln(Format('cl[1]: %8.8x', [Cardinal(pd^)]));
end.

cl の示す先は @cl でいいんじゃないの?と一瞬思いますが,今は pd がクロージャを示したポインタ(を PLongword でキャストしたもの)と思いねえ。ともかくこいつを実行すると,

o1: 00CF0920
cl[0]: 00408174
cl[1]: 00CF0920

このように,クロージャの中身がさらされました。cl[1] はまぎれもなく o1 と同じ値を示しています。では,cl[0] は,いったい何なのか?

var
  o1: TDummy;
  cl: procedure of object;
  pd: PLongword;
begin
  o1 := TDummy.Create('hogehoge');
  Writeln(Format('o1: %8.8x', [Cardinal(o1)]));

  cl := o1.Greeting;
  pd := PLongword(@@cl);
  Writeln(Format('cl[0]: %8.8x', [Cardinal(pd^)]));
  Inc(pd);
  Writeln(Format('cl[1]: %8.8x', [Cardinal(pd^)]));

  Writeln(Format('TDummy.Greeting: %8.8x', [Cardinal(@TDummy.Greeting)]));
end.

これを実行すると(最後の一行が追加されただけ),

o1: 00CF0920
cl[0]: 00408174
cl[1]: 00CF0920
TDummy.Greeting: 00408174

おお,cl[0] というのは実際には TDummy の Greeting という関数へのポインタだった,と。

と書くと非常にしらじらしいですが,実際にクロージャというものが「関数ポインタ」+「インスタンスへのポインタ」で構成されていたことがわかります。


これを使うことがあるのか,といわれると微妙ですが,まったくなくもない,ということにしておきます。問題は,クロージャを関数ポインタに分解することはできても,逆はできない(みたい)だということです。

var
  cl: procedure (Arg: string) of object;
  fp: procedure (Arg: string);
  o1, o2: THogehoge;
begin
  cl := o1.MyProc;
  fp := @cl;

  o2.fp('fugafuga');
end.

みたいなことができればいいのですが。