,

　ブラウザのメールリンクをクリックするとポスペが立ち上がるという
　ソフトを作ったんですが　メーラーとしてインストールするのでは無くて
　今レジストリに登録されている、

    HKEY_CLASSES_ROOT\mailto\shell\open\command

　、を書き換えるだけですますという手抜きな処理のためなのかどうなのか
　立て続けに不具合報告をもらったので　任意のキー以下の情報を
　テキストに書き出すプログラムを作って　ユーザーに使ってもらいました。

　という訳で　間に合わせで作った手抜きソースです。(^^;
　begin … end. の所にあるように EnumRegKeys に任意のキーを渡せ
　下層キーと値を output に書き出します。


program TestPP;

uses
    Registry, Classes, Windows, Messages, SysUtils;

var
    reg : TRegistry;
    output : String;

function StrDump(str: string): String;
var
    idx : Integer;
begin
    Result := '';
    idx := 1;
    while idx<Length( str ) do begin
        Result := Result+
            format( '%.02x ', [ord( str[idx] )+ord( str[idx+1] )*$100] );
        idx := idx+2;
    end;
end;

procedure GetKeyEtc;
var
    s, s1 : String;
    ss : TStringList;
    idx : Integer;
begin
    ss := TStringList.Create;
    try
        reg.GetValueNames( ss );
        for idx := 0 to ss.Count-1 do begin
            s1 := '?';
            case reg.GetDataType( ss[idx] ) of
                rdUnknown   : s := 'unk';
                rdString    : begin
                    s := 'str';
                    s1 := reg.ReadString( ss[idx] );
                end;
                rdExpandString  : begin
                    s := 'exs';
                    s1 := reg.ReadString( ss[idx] );
                end;
                rdInteger   : begin
                    s := 'int';
                    s1 := IntToStr( reg.ReadInteger( ss[idx] ) );
                end;
                rdBinary    : begin
                    s := 'bin';
                    SetLength( s1, reg.GetDataSize( ss[idx] ) );
                    reg.ReadBinaryData( ss[idx], s1[1], Length( s1 ) );
                    s1 := StrDump( s1 );
                end;
            end;
            output := output+format( '   %s:"%s"    {%s}',
                                [s, ss[idx], s1] )+#13#10;
        end;
    finally
        ss.free;
    end;
end;

procedure EnumRegKeys(Key: String);
var
    ss : TStringList;
    idx : Integer;
begin
    ss := TStringList.Create;
    try
        if reg.OpenKey( key, false ) then begin
            try
                output := output+key+#13#10;
                GetKeyEtc;
                reg.GetKeyNames( ss );
                for idx := 0 to ss.Count-1 do begin
                    EnumRegKeys( Key+'\'+ss[idx] );
                end;
            finally
                reg.CloseKey;
            end;
        end;
    finally
        ss.Free;
    end;
end;

var
    f : TextFile;
begin
    output := '';
    reg := TRegistry.Create;
    try
        output := output+#13#10+#13#10+'- HKEY_LOCAL_MACHINE -'+#13#10;
        Reg.Rootkey := HKEY_LOCAL_MACHINE;
        EnumRegKeys( '\SOFTWARE\Clients\Mail' );

        output := output+#13#10+#13#10+'- HKEY_CLASSES_ROOT -'+#13#10;
        Reg.Rootkey := HKEY_CLASSES_ROOT;
        EnumRegKeys( '\mailto' );

        output := output+#13#10+#13#10+'- HKEY_LOCAL_MACHINE -'+#13#10;
        Reg.Rootkey := HKEY_LOCAL_MACHINE;
        EnumRegKeys( '\SOFTWARE\Classes\mailto' );

        reg.Free;
    end;

    AssignFile( f, ExtractFilePath( ParamStr( 0 ) )+'testpp.txt' );
    Rewrite( f );
    Writeln( f, output );
    CloseFile( f );

    messagebox( 0, '完了', 'TestPP.exe', MB_OK );
end.


(PXC07042) - とらじ -       URL
http://member.nifty.ne.jp/trazi

Original document by 寅次            氏 ID:(PXC07042)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。