结构化存储的问题？求助高手!


procedure TForm1.BtnAddClick(Sender: TObject);
begin
  MakeStgFile('E:\abc\', 'E:\StsMon.stg');
end;procedure TForm1.Read2Click(Sender: TObject);
begin
  ExportStgToDir('E:\StsMon2\', 'E:\StsMon.stg');
end;procedure TForm1.ExportStgToDir(const Dir, Filename: WideString);//这函数是把一个结构化文件导出到一个目录中去。
var
  StgRoot, StgSub: ^IStorage;
  Stm: IStream;
  hr: HRESULT;
  CLS:TCLSID;    //是一个16字节的唯一数字
  Sta:TStatStg;  //保存IStorage .Stat()返回的信息
  EnumStg: IEnumStatStg;
  statstg: tagSTATSTG;
  DirList: TStringList;
  Fhandle: THandle;
  Buffer: String;
  StgQueue: TQueue;
begin
  DirList := TStringList.Create;
  StgQueue := TQueue.Create;
  if StgIsStorageFile(PWideChar(Filename)) <> S_OK then exit;  New(StgRoot);
  hr := StgOpenStorage(PWideChar(Filename), nil, STGM_READ  or STGM_SHARE_EXCLUSIVE, nil, 0, StgRoot^);
  if not Succeeded(hr) then
     exit;
  DirList.Add(Dir);
  StgQueue.Push(StgRoot);
  While StgQueue.Count <>0 do
  begin
    StgRoot := StgQueue.Pop;
    StgRoot.EnumElements(0, nil, 0, EnumStg);
    hr := EnumStg.Next(1, Statstg, nil);
    while (hr = S_OK ) do
    begin
      if (Statstg.dwType = STGTY_STORAGE) then
      begin
        New(StgSub);
        hr := StgRoot.OpenStorage(Statstg.pwcsName, nil, STGM_READ or STGM_SHARE_EXCLUSIVE , nil, 0, StgSub^);
        DirList.Add(DirList.Strings[0] + Statstg.pwcsName + '\');        // add directory to List
        CreateDirectory(PAnsiChar(DirList.Strings[0] + Statstg.pwcsName), nil);
        if Succeeded(hr) then
           StgQueue.Push(StgSub);
      end
      else begin
        hr := StgRoot.OpenStream(Statstg.pwcsName, nil, STGM_READ or STGM_SHARE_EXCLUSIVE, 0, Stm);
        if Succeeded(hr) then
        begin
          SetLength(Buffer, Statstg.cbSize + 1);
          Stm.Read(@Buffer[1], Statstg.cbSize, nil);
          FHandle := FileCreate(DirList.Strings[0] + Statstg.pwcsName);
          FileWrite(FHandle, Buffer[1], Statstg.cbSize);
          FileClose(FHandle);
        end;
      end;//if
      hr := EnumStg.Next(1, Statstg, nil);
    end;  //while
  DirList.Delete(0);
 // Dispose(StgRoot);   //这句要加上注释才能运行，否则会内存出错，为什么呢？
  end; //while
end;procedure TForm1.MakeStgFile(Dir, Filename: WideString);　　//这函数是把一个目录及子目录和文件放一个结构化文件中，但不知什么原因，不成功。
var
  StgRoot, StgSub: ^IStorage;
  Stm: IStream;
  FS: TSearchRec;
  R: integer;
  FileStream: TFileStream;
  Buffer: String;
  DirList: TStringList;
  hr: HRESULT;
  StgQueue: TQueue;
begin
  DirList := TStringList.Create;
  StgQueue := TQueue.Create;
  new(StgRoot);
  StgCreateDocfile(PWideChar(Filename), STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, 0, StgRoot^);   //建立结构化存储文件  DirList.Add(Dir);
  StgQueue.Push(StgRoot);
  While (StgQueue.Count <>0) do     //保存目录到列表中
  begin
    R := FindFirst(DirList.Strings[0] + '*.*', faAnyFile, FS);   //读取每一个目录下的所有文件
    StgRoot := StgQueue.Pop;                           // pop the first point    While (R=0) do                   //到找到文件
    begin
      if (FS.Attr and faDirectory) <>0 then
      begin
        if (FS.Name <>'.') and (FS.Name <> '..') then
        begin
          DirList.Add(DirList.Strings[0] + FS.Name + '\');          //Add Directory to List
          new(StgSub);             //  Create a new Storage unit
          hr := StgRoot.CreateStorage(PWideChar(FS.Name), STGM_READWRITE or STGM_CREATE or STGM_SHARE_EXCLUSIVE, 0, 0, StgSub^); //再创建一个子存储空间
          if hr = S_OK then
             StgQueue.Push(StgSub);
        end;
      end
      else begin
        hr := StgRoot.CreateStream(PWideChar(FS.name), STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, 0, 0, Stm);  //Create File
        if hr = S_OK then
        begin
          FileStream := TFileStream.Create(DirList.Strings[0] + FS.Name, fmOpenReadWrite);  //Get file to Stream
          SetLength(Buffer, FileStream.Size);
          FileStream.ReadBuffer(Buffer[1], FileStream.Size);   // Reads bytes from the stream into Buffer.
          Stm.Write(@Buffer[1], FileStream.Size, nil);
          FileStream.Free;
        end;
      end;
      R := FindNext(FS);
    end;
    DirList.Delete(0);
    Dispose(StgRoot);   //这句存在也能正确运行
  end;
  DirList.Free;
  StgQueue.Free;        
end;高手帮忙看下，多谢。