5

我正在尝试编写两个函数来从IShellLibrary. 我从这个开始,但该函数在System._IntfClear

第一次机会例外在 $000007FEFE 168BC4。带有消息“c0000005 ACCESS_VIOLATION”的异常类 $C0000005。

SHAddFolderPathToLibrary是导致异常的行

我想我需要将库名称添加到函数中?

function AddFolderToLibrary(AFolder: string): HRESULT;
{ Add AFolder to Windows 7 library. }
var
  plib: IShellLibrary;
begin
  Result := CoCreateInstance(CLSID_ShellLibrary, nil, CLSCTX_INPROC_SERVER,
    IID_IShellLibrary, plib);
  if SUCCEEDED(Result) then
  begin
    Result := SHAddFolderPathToLibrary(plib, PWideChar(AFolder));
  end;
end;

function RemoveFolderFromLibrary(AFolder: string): HRESULT;
{ Remove AFolder from Windows 7 library. }
var
  plib: IShellLibrary;
begin
  Result := CoCreateInstance(CLSID_ShellLibrary, nil, CLSCTX_INPROC_SERVER,
    IID_IShellLibrary, plib);
  if SUCCEEDED(Result) then
  begin
    Result := SHRemoveFolderPathFromLibrary(plib, PWideChar(AFolder));
  end;
end;
4

2 回答 2

7

这里的问题是翻译的Embarcadero工程师SHAddFolderPathToLibrary不了解COM引用计数,以及不同编译器是如何处理的。

下面是如何SHAddFolderPathToLibrary在 C++ 头文件中实现的Shobjidl.h。它实际上是其他核心 API 调用的内联包装器:

__inline HRESULT SHAddFolderPathToLibrary(_In_ IShellLibrary *plib, 
    _In_ PCWSTR pszFolderPath)
{
    IShellItem *psiFolder;
    HRESULT hr = SHCreateItemFromParsingName(pszFolderPath, NULL, 
        IID_PPV_ARGS(&psiFolder));
    if (SUCCEEDED(hr))
    {
        hr = plib->AddFolder(psiFolder);
        psiFolder->Release();
    }
    return hr;
}

而且德尔福翻译非常忠实,确实太忠实了:

function SHAddFolderPathToLibrary(const plib: IShellLibrary;
  pszFolderPath: LPCWSTR): HResult;
var
  psiFolder: IShellItem;
begin
  Result := SHCreateItemFromParsingName(pszFolderPath, nil, IID_IShellItem,
    psiFolder);
  if Succeeded(Result) then
  begin
    Result := plib.AddFolder(psiFolder);
    psiFolder._Release();
  end;
end;

问题是调用_Release. Delphi 编译器管理引用计数,因此这个显式调用_Release是虚假的,不应该存在。由于编译器会安排对 的调用_Release,因此这个额外的调用只会使引用计数失衡。之所以_AddRef加上_Release前缀_是为了提醒人们不要调用它们,让编译器来做。

C++ 版本中的调用是准确的,因为除非您将接口包装在 COM 智能指针中,否则ReleaseC++ 编译器不会自动为您调用。Release但是 Embarcadero 工程师盲目地抄袭了它,后果自负。显然,Embarcadero 工程师甚至从未执行过此代码。

您需要提供自己更正的此功能的实现。以及任何其他错误翻译的功能。_Release在单元中搜索ShlObj,并在您的更正版本中删除它们。翻译中还有其他错误,所以要小心。例如, (和其他人)声明应该是的SHLoadLibraryFromItem局部变量。plib: ^IShellLibraryplib: IShellLibrary

我提交了一份质量控制报告:QC#117351

于 2013-07-23T14:32:45.410 回答
1

我发明了我自己在这里提出的算法,它是非递归的,它占用很少的内存并删除任何深度的文件夹和具有特殊属性的文件。不幸的是,评论仍然是意大利语。为了解释它是如何工作的:您必须使用该过程初始化文件或文件夹的删除InitDelT (Dir: String; Var DelTRec: TDelTRec); 并运行多次,例如在某种循环中,函数DelT (Var DelTRec: TDelTRec): Byte;,它返回: 2 -> Deletion completed successfully. 3 -> Deletion failed. DelTRec 变量: TDelTRec 包含: PathName, BaseDir, Msg: String; Status: Byte; {Status: 0 -> Deleting (no items deleted yet). 1 -> Deleting (1 item just deleted). 2 -> Deletion completed successfully. 3 -> Deletion failed}

Unit DelTU;

Interface

Type TDelTRec=Record
      PathName,BaseDir,Msg:String;
      Status:Byte;
     {Status: 0 -> Eliminazione in corso (nessun elemento ancora eliminato).
              1 -> Eliminazione in corso (1 elemento appena eliminato).
              2 -> Eliminazione terminata con successo.
              3 -> Eliminazione fallita}
     End;

Function  KeepExtendedDir    (Dir:String):String;

{Preleva la Dir non normalizzata
 (con BACKSLASH) da Dir.

 NOTE: Non effettua alcun accesso ad UNITà A DISCO}

Function  KeepNormDir        (Dir:String):String;

{Preleva la Dir normalizzata
 (senza BACKSLASH) da Dir.

 NOTE: Non effettua alcun accesso ad UNITà A DISCO}

Function  GetPathNameDir     (PathName:String):String;

{Ritorna l' UNITà ed il PERCORSO DI PathName}

Procedure FileSplit          (FileName:String;
                              Var Drive,Dir,Name,Ext:String);

{Scompone un PERCORSO DI FILE FileName
 IN UNITà (DRIVE), Dir (Dir), nome (Name)
 ed estensione (Ext).

 NOTE: Non effettua alcun accesso ad UNITà A DISCO}

Procedure FSplit             (FileName:String;
                              Var Dir,Name,Ext:String);

{Scompone un PERCORSO DI FILE FileName
 Path (Dir), nome (Name)
 ed estensione (Ext).

 NOTE: Non effettua alcun accesso ad UNITà A DISCO}

Function  Is_Drive_Or_Root  (Dir:String):Boolean;

{Verifica Se la Dir specificata da Dir è
 una ROOT Dir o un DRIVE (IN questo caso ritorna TRUE).

 Ritorna FALSE Se Dir è una Sub-DIRECTORY}

Function  File_Exists_Sub    (FileName:String;Attr:Integer;
                              Var Attr_Read:Integer):Boolean;

{Verifica che un FILE o una Dir FileName esista
 ed abbia attributi compresi IN Attr.
 Se FileName ha uno o più attributi che differiscono da Attr, ritorna FALSE.
 Se FileName non ha attributi, ritorna TRUE.

 Ritorna FALSE solo IN caso DI ERRORE,
 altrimenti Attr_Read contiene gli attributi DI FileName.

 NOTE: Per trovare qualsiasi FILE:

       Attr= faAnyFile-
             faVolumeId-
             faDirectory.

       Per trovare qualsiasi FILE E DIRECTORY:

       Attr= faAnyFile-
             faVolumeId.

       Per trovare qualsiasi DIRECTORY:

       Found:=File_Exists_Sub(FileName,faAnyFile-faVolumeId,Attr_Read) AND
              ((Attr_Read AND faDirectory)<>0)}

Function  File_Exists        (FileName:String):Boolean;

(* Controlla che FileName sia un FILE esistente *)

Function  Dir_Exists         (FileName:String):Boolean;

(* Controlla che FileName sia una DIRECTORY esistente *)

Function  FDel               (Source:String):Boolean;

(* Rimuove qualsiasi file, anche con attributi speciali;
   non imposta ErrorMsg *)

Function  RmDir              (Source:String):Boolean;

(* Rimuove qualsiasi directory vuota, anche con attributi speciali;
   non imposta ErrorMsg *)

Procedure InitDelT           (Dir:String;
                              Var DelTRec:TDelTRec);

{Inizializzazione funzione "remove not empty folder" alias DelT().

 Dir è il percorso assoluto della cartella da rimuovere;
 può essere specificato anche senza il backslash finale.

 Nel caso Dir non esista, questa funzione disabilita la rimozione;
 altrimenti essa potrà avvenire in background, chiamando DelT()}

Function  DelT               (Var DelTRec:TDelTRec):Byte;

{Funzione "remove not empty folder" alias DelT().

 La rimozione potrà avvenire in background, chiamando DelT() dopo
 aver inizializzato DelTRec con InitDelT().

 Ritorna: 0 -> Eliminazione in corso (nessun elemento ancora eliminato).
          1 -> Eliminazione in corso (1 elemento appena eliminato).
          2 -> Eliminazione terminata con successo.
          3 -> Eliminazione fallita.

 ALGORITMO:
 ---------:
 - specificare full-path-name PathName con filtro *.*;
   es.: c:\programs.pf\graphic.pf\*.*
 - Copiare nella base-path BaseDir il percorso della cartella da rimuovere;
   es.: c:\programs.pf

 - RemoveDir <- False.
 - Preleva FileName1 e Dir da PathName.
 - Se FileName1="<Rm_Dir>":
   - RemoveDir <- True.
   - Preleva FileName1 e Dir da Dir (normalizzata).
 - NoSuchFile1 <- False
 - Cerca la prima ricorrenza di FileName1 in Dir.:
   - Imposta NoSuchFile1 <- True, se non esiste.
 - NoSuchFile2 <- True
 - SetFileName2 <- False
 - Se NoSuchFile1 = False:
   - Cerca il file o dir. successivo FileName2 in Dir:
     - Imposta NoSuchFile2 <- True, se non esiste.
   - Se RemoveDir=True:
     - Rimuove la dir. FileName1
     - Se Dir=BaseDir, ha finito.
     - SetFileName2 <- True
   - Se RemoveDir=False:
     - Se FileName1 è un file:
       - Rimuove il file FileName1.
       - SetFileName2 <- True
     - Se FileName1 è una dir.:
       - Imposta PathName con Dir., FileName1 e *.*
 - Se (NoSuchFile2 = False) E SetFileName2:
   - Se FileName2 è un file, imposta PathName con Dir. e FileName2
   - Se FileName2 è una dir., imposta PathName con Dir., FileName2 e *.*
 - Se (NoSuchFile2 = True) E SetFileName2 O
      (NoSuchFile1 = True):
   - Imposta PathName con Dir. e "<Rm_Dir>"}

{-----------------------------------------------------------------------}

Implementation

Uses SysUtils;

Function KeepExtendedDir(Dir:String):String;

Var Len:Integer;

Begin
 Len:=Length(Dir);
 If (Len>0) And Not (Dir[Len] In [':','\']) Then
  KeepExtendedDir:=Dir+'\'
 Else
  KeepExtendedDir:=Dir;
End;

Function KeepNormDir(Dir:String):String;

Var Len:Integer;

Begin
 Len:=Length(Dir);
 If (Len>1) And
    (Dir[Len]='\') And
    (Dir[Len-1]<>':') Then
  KeepNormDir:=Copy(Dir,1,Len-1)
 Else
  KeepNormDir:=Dir;
End;

Function GetPathNameDir(PathName:String):String;

Var Index:Integer;

Begin
 Index:=Length(PathName);
 While (Index>0) And Not (PathName[Index] In ['\',':']) Do
  Dec(Index);
 GetPathNameDir:=Copy(PathName,1,Index);
End;

Procedure FileSplit(FileName:String;
                    Var Drive,Dir,Name,Ext:String);

Var Ch:Char;
    Index,Flag:Integer;

Begin
 Drive:='';
 Dir:='';
 Name:='';
 Ext:='';
 Flag:=0;
 Index:=Length(FileName);
 While Index>0 Do
  Begin
   Ch:=FileName[Index];
   Case Ch Of
    '\':If Flag<3 Then
         Flag:=2;
    ':':Flag:=3;
    '.':If Flag=0 Then
         Flag:=1;
   End;
   Case Flag Of
    0:Name:=Ch+Name;
    1:If Ext='' Then
       Begin
        Ext:=Ch+Name;
        Name:='';
       End
      Else
       Name:=Ch+Name;
    2:Dir:=Ch+Dir;
    3:Drive:=Ch+Drive;
   End;
   Dec(Index);
  End;
End;

Procedure FSplit(FileName:String;
                 Var Dir,Name,Ext:String);

Var Drive:String;

Begin
 FileSplit(FileName,Drive,Dir,Name,Ext);
 Dir:=Drive+Dir;
End;

Function Is_Drive_Or_Root(Dir:String):Boolean;

Const Special_Chars:Array[Boolean] Of Char=(':','\');

Var Len:Integer;

Begin
 Len:=Length(Dir);
 Is_Drive_Or_Root:=((Len=1) Or (Len=2) Or (Len=3) And (Dir[2]=':')) And
                   (Dir[Len]=Special_Chars[Odd(Len)]);
End;

Function File_Exists_Sub(FileName:String;Attr:Integer;
                         Var Attr_Read:Integer):Boolean;

(* per trovare qualsiasi FILE:

   Attr= faAnyFile-
         faVolumeId-
         faDirectory *)

Var TempOut:Boolean;
    SR:TSearchRec;

Begin
 Attr_Read:=0;
 TempOut:=((Attr And faDirectory)<>0) And
          Is_Drive_Or_Root(FileName);
 If Not TempOut And
    (FindFirst(FileName,Attr,SR)=0) Then
  Begin
   TempOut:=True;
   Attr_Read:=SR.Attr;
   FindClose(SR);
  End;
 File_Exists_Sub:=TempOut;
End;

Function File_Exists(FileName:String):Boolean;

Var Attr_Read:Integer;

Begin
 File_Exists:=File_Exists_Sub(FileName,SysUtils.faAnyFile-
                                       SysUtils.faVolumeId-
                                       SysUtils.faDirectory,
                              Attr_Read);
End;

Function Dir_Exists(FileName:String):Boolean;

Var Attr_Read:Integer;

Begin
 Dir_Exists:=File_Exists_Sub(FileName,SysUtils.faAnyFile-
                                      SysUtils.faVolumeId,
                             Attr_Read) And
             ((Attr_Read And faDirectory)<>0);
End;

Function FDel(Source:String):Boolean;

Var Attr:Integer;

Begin
 FDel:=False;
 Source:=KeepNormDir(Source);
 Attr:=SysUtils.FileGetAttr(Source);
 If (Attr And SysUtils.faDirectory)=0 Then
  Begin
   If (Attr And (SysUtils.faReadOnly+
                 SysUtils.faHidden+
                 SysUtils.faSysFile))<>0 Then
    SysUtils.FileSetAttr(Source,
                         Attr And Not (SysUtils.faReadOnly+
                                       SysUtils.faHidden+
                                       SysUtils.faSysFile));
   FDel:=DeleteFile(Source);
  End;
End;

Function RmDir(Source:String):Boolean;

Var Attr:Integer;

Begin
 RmDir:=False;
 Source:=KeepNormDir(Source);
 Attr:=SysUtils.FileGetAttr(Source);
 If (Attr And SysUtils.faDirectory)<>0 Then
  Begin
   If (Attr And (SysUtils.faReadOnly+
                 SysUtils.faHidden+
                 SysUtils.faSysFile))<>0 Then
    SysUtils.FileSetAttr(Source,
                         Attr And Not (SysUtils.faReadOnly+
                                       SysUtils.faHidden+
                                       SysUtils.faSysFile));
   RmDir:=RemoveDir(Source);
  End;
End;

Procedure InitDelT(Dir:String;
                   Var DelTRec:TDelTRec);

Begin
 With DelTRec Do
  Begin
   PathName:=KeepExtendedDir(Dir)+'*.*';
   Dir:=KeepNormDir(Dir);
   Status:=3 And -Byte(Not Dir_Exists(Dir));
   BaseDir:=GetPathNameDir(Dir);
   Msg:='';
  End;
End;

Function DelT(Var DelTRec:TDelTRec):Byte;

Var RemoveDir,SuchFile1,SuchFile2,SetFileName2,FF:Boolean;
    Dir,Name,Ext:String;
    SR1,SR2:TSearchRec;

Begin
 With DelTRec Do
  Begin
   If Status<2 Then
    Begin
     Status:=0;
     RemoveDir:=False;
     FSplit(PathName,Dir,Name,Ext);
     If Name+Ext='<Rm_Dir>' Then
      Begin
       RemoveDir:=True;
       FSplit(KeepNormDir(Dir),Dir,Name,Ext);
      End;
     FF:=FindFirst(Dir+'*.*',
                   SysUtils.faAnyFile-
                   SysUtils.faVolumeId,SR2)=0;
     SuchFile1:=FF;
     While SuchFile1 And
           ((SR2.Name='.') Or (SR2.Name='..')) Do
      SuchFile1:=FindNext(SR2)=0;
     SuchFile2:=False;
     SetFileName2:=False;
     If SuchFile1 Then
      Begin
       SR1:=SR2;
       SuchFile2:=FindNext(SR2)=0;
       If RemoveDir Then
        Begin
         Msg:=Dir+Name+Ext;
         If Not RmDir(Msg) Then
          Status:=3
         Else
         If Dir=BaseDir Then
          Status:=2
         Else
          Status:=1;
         SetFileName2:=True;
        End
       Else
       If (SR1.Attr And SysUtils.faDirectory)=0 Then
        Begin
         Msg:=Dir+SR1.Name;
         If FDel(Msg) Then
          Status:=1
         Else
          Status:=3;
         SetFileName2:=True;
        End
       Else
        PathName:=Dir+SR1.Name+'\*.*';
      End;
     If SuchFile2 And SetFileName2 Then
     If (SR2.Attr And SysUtils.faDirectory)=0 Then
      PathName:=Dir+SR2.Name
     Else
      PathName:=Dir+SR2.Name+'\*.*';
     If Not SuchFile2 And SetFileName2 Or Not SuchFile1 Then
      PathName:=Dir+'<Rm_Dir>';
     If FF Then
      FindClose(SR2);
    End;
   DelT:=Status;
  End;
End;

End.

这是一个例子(DelTUT.DPR):

program DelTUT;

{$APPTYPE CONSOLE}

uses SysUtils,
     DelTU in 'DelTU.pas';

Var  DelTRec:TDelTRec;
     Dir:String;

begin
 { TODO -oUser -cConsole Main : Insert code here }
 WriteLn('Insert the full path-name of the folder to remove it:');
 ReadLn(Dir);
 WriteLn('Press ENTER to proceed ...');
 InitDelT(Dir,DelTRec);
 WriteLn('Removing...');
 While Not (DelT(DelTRec) In [2,3]) Do
  Write(#13,DelTRec.Msg,#32);
 WriteLn;
 If DelTRec.Status=3 Then
  WriteLn('Error!')
 Else
  WriteLn('Ok.')
end.
于 2021-04-21T13:23:33.970 回答