win７のエクスプローラ表示の「ライブラリ」直下のフォルダのアドレスの取得は (ID:42580)

名前

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

本文

auさん、
とりあえずこのようになりました。急ごしらえでテストOKならもうちょっと整理して。
Libraries_TBLはフォルダパスの格納、起動時終了時に作成、後始末をする。

procedure TForm1.ShellTreeView1Click(Sender: TObject);
var Path:string;
begin
    if shellTreeView1.Selected=nil then exit;
    Path:=GetFolderPath(ShellTreeView1.Path);
    if DirectoryExists(Path)=true then
     begin
        webbrowser1.Navigate(Path)
    end
    else
    begin
	//最初から中を展開する気がないものは除外する
        if AnsiPos(Path,'マイ コンピューター ライブラリ ホームグループ')>0 then exit;
        showmessage(Path+#13#10+'を登録してください');
    end;
end;

function TForm1.GetFolderPath(Path:string):string;
var
     PersonalPath:string;
     i,count:integer;
    str,str2,ClickPath:string;
    cp:integer;
    StringList2:TStringList;
begin
    result:=Path;
    if DirectoryExists(Path)=true then
    begin
        result:=Path;
        exit;
    end
    else
    begin
        //最初からパスが不要と思われて  破棄する  ノード
        if AnsiPos(Path,'マイ コンピューター ライブラリ ホームグループ')>0 then exit;

PersonalPath:= GetSpecialFolder(CSIDL_PERSONAL);
        //win7 か  XPを判定する方法を知らないのでローテクで
        //ＸＰと７で違うのでやっかいだった
        count:=0;
        for i:=1 to Length(PersonalPath) do
        if Copy(PersonalPath,i,1)='\' then Inc(count);

if count>=3 then
            PersonalPath:=ExtractFilePath(PersonalPath)//'Documentsを捨てる
        else
            PersonalPath:=PersonalPath+'\';

//ほぼ、そうなっているだろうなのとｘｐの場合を想定して
        if (Path='ドキュメント') or (Path='マイ ドキュメント')      then
        begin
            result:=PersonalPath+'Documents';
            if DirectoryExists(result)=true then exit;
        end
        else
        if (Path='ピクチャ') or (Path='マイ ピクチャ')              then
        begin
             result:=PersonalPath+'Pictures';
             if DirectoryExists(result)=true then exit;
        end
        else
        if (Path='ミュージック') or (Path='マイ ミュージック')
        or (AnsiPos('music',Path)>0) or (AnsiPos('Music-',Path)>0) then
        begin
            result:=PersonalPath+'Music';
            if DirectoryExists(result)=true then exit;
        end
        else
        if (Path='ビデオ') or (Path='マイ ビデオ')
        or (AnsiPos('Videos',Path)>0) or (AnsiPos('Videos-',Path)>0) then
        begin
            result:=PersonalPath+'Videos';
            if DirectoryExists(result)=true then exit;
        end;

//元々ライブラリに登録するのは任意の手動登録だから
        //専用テーブルに名前が検索してなければ登録するようにした。
        //ライブラリーの名前は任意に変更できるから元フォルダ名と
        //同期しない可能性があるので名前で検索する

StringList2:=TStringList.Create;
        try
            ClickPath:='\'+Path;
            for i:=0 to Libraries_TBL.Count-1 do
            begin        //未登録である
                StringList2.CommaText:= Libraries_TBL.Strings[i];
                str:=StringList2.Strings[1];
                //前半部分が同じ可能性があるので長さまでチェックする
                cp:=LastDelimiter('\', str);
                str2:=Copy(str,cp, Length(str));

if ClickPath=str2 then
                begin  //頭だけでないか検査する
                    result:=str;
                    exit;
                end;
            end;
            //なければパスを登録する登録する
            if SelectDirectory('フォルダを指定します','', str) then 
            begin
                Libraries_TBL.Add(AnsiQuotedStr(ClickPath,'"')+','+AnsiQuotedStr(str,'"') );
                if DirectoryExists(str)=true then
                begin
                    result:= str;
                end;
            end;
        finally
             StringList2.Free;
        end;
   end;
end;

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

戻る