|
 Forum
Grundkurs
»Introduktion
»Snabbguide
»Komponenter
»Händelser
»Strängar
»Räkna med Delphi »Egna
typer
»Selektion
»Iteration
»Menyer
»Funktioner
»Arraystrukturer
Tips & Tricks
»Nya tips
»Blandat
»Databaser
»Filer
»Forms
»Grafik
»Internet
»Komponenter
»Matematik
»Multimedia
»Objekt/ActiveX
»Skrivare
»Strängar
»System
»Mest lästa tips
Artiklar
»Delphi och ADO
»Bygga en DLL
»Skapa en enkel rapport
»Hantera registret
»Enheter, units
»Klassen TCanvas
»Använd LookUp Controls
 Nya
tips
 Lägg
till tips
 Delphilänkar
 Gästbok
|
|
|
|
|
|
Kontrollera om en mapp är delad
|
Kategori: Filer
Inlagt: 2005-03-04
Läst: 1336
Inlagt av: Staffan Berg
|
|
Beskrivning |
|
Denna funktion kontrollerar om angiven mapp är delad eller ej.
|
|
Kod |
function TForm1.IfFolderShared(FullFolderPath: string ): Boolean;
//Convert TStrRet to string
function StrRetToString(PIDL: PItemIDList; StrRet: TStrRet; Flag: string = ''): string ;
var
P: PChar;
begin
case StrRet.uType of
STRRET_CSTR:
SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr));
STRRET_OFFSET:
begin
P := @PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)];
SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset);
end;
STRRET_WSTR:
if Assigned(StrRet.pOleStr) then
Result := StrRet.pOleStr
else
Result := '';
end;
{ This is a hack bug fix to get around Windows Shell Controls returning
spurious "?"s in date/time detail fields }
if (Length(Result) > 1) and (Result[1] = '?') and (Result[2] in ['0'..'9']) then
Result := StringReplace(Result, '?', '', [rfReplaceAll]);
end;
//Get Desktop's IShellFolder interface
function DesktopShellFolder: IShellFolder;
begin
OleCheck(SHGetDesktopFolder(Result));
end;
//delete the first ID from IDList
function NextPIDL(IDList: PItemIDList): PItemIDList;
begin
Result := IDList;
Inc(PChar(Result), IDList^.mkid.cb);
end;
//get the length of IDList
function GetPIDLSize(IDList: PItemIDList): Integer;
begin
Result := 0;
if Assigned(IDList) then
begin
Result := SizeOf(IDList^.mkid.cb);
while IDList^.mkid.cb <> 0 do
begin
Result := Result + IDList^.mkid.cb;
IDList := NextPIDL(IDList);
end;
end;
end;
//get ID count from IDList
function GetItemCount(IDList: PItemIDList): Integer;
begin
Result := 0;
while IDList^.mkid.cb <> 0 do
begin
Inc(Result);
IDList := NextPIDL(IDList);
end;
end;
//create an ItemIDList object
function CreatePIDL(Size: Integer): PItemIDList;
var
Malloc: IMalloc;
begin
OleCheck(SHGetMalloc(Malloc));
Result := Malloc.Alloc(Size);
if Assigned(Result) then
FillChar(Result^, Size, 0);
end;
function CopyPIDL(IDList: PItemIDList): PItemIDList;
var
Size: Integer;
begin
Size := GetPIDLSize(IDList);
Result := CreatePIDL(Size);
if Assigned(Result) then
CopyMemory(Result, IDList, Size);
end;
//get the last ItemID from AbsoluteID
function RelativeFromAbsolute(AbsoluteID: PItemIDList): PItemIDList;
begin
Result := AbsoluteID;
while GetItemCount(Result) > 1 do
Result := NextPIDL(Result);
Result := CopyPIDL(Result);
end;
//remove the last ID from IDList
procedure StripLastID(IDList: PItemIDList);
var
MarkerID: PItemIDList;
begin
MarkerID := IDList;
if Assigned(IDList) then
begin
while IDList.mkid.cb <> 0 do
begin
MarkerID := IDList;
IDList := NextPIDL(IDList);
end;
MarkerID.mkid.cb := 0;
end;
end;
//if Flag include Element
function IsElement(Element, Flag: Integer): Boolean;
begin
Result := Element and Flag <> 0;
end;
var
P: Pointer;
NumChars, Flags: LongWord;
ID, NewPIDL, ParentPIDL: PItemIDList;
ParentShellFolder: IShellFolder;
begin
Result := False;
NumChars := Length(FullFolderPath);
P := StringToOleStr(FullFolderPath);
//get the folder's full ItemIDList
OleCheck(DesktopShellFolder.ParseDisplayName(0, nil, P, NumChars, NewPIDL, Flags));
if NewPIDL <> nil then
begin
ParentPIDL := CopyPIDL(NewPIDL);
StripLastID(ParentPIDL); //get the folder's parent object's ItemIDList
ID := RelativeFromAbsolute(NewPIDL); //get the folder's relative ItemIDList
//get the folder's parent object's IShellFolder interface
OleCheck(DesktopShellFolder.BindToObject(ParentPIDL, nil, IID_IShellFolder,
Pointer(ParentShellFolder)));
if ParentShellFolder <> nil then
begin
Flags := SFGAO_SHARE;
//get the folder's attributes
OleCheck(ParentShellFolder.GetAttributesOf(1, ID, Flags));
if IsElement(SFGAO_SHARE, Flags) then Result := True;
end;
end;
end;
{How to use the function?
The parameter in is the full path of a folder}
procedure TForm1.Button1Click(Sender: TObject);
begin
if IfFolderShared('C:\My Documents\WinPopup') then ShowMessage('shared')
else
ShowMessage('not shared');
end;
|
|
|