Fórum Como evitar erro na importado do listox se tiver ´ no doc. #347069

function RetiraExt(S: String): String;
Var
  Extensao: Integer;
begin
    Extensao := Pos(´.´, S);
    Delete(S, Extensao, 4);
    Result := S;
end;

function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam, lpData: LPARAM):
  Integer; stdcall;
var
  Path: array[0..MAX_PATH] of Char;
begin
  case uMsg of
    BFFM_INITIALIZED:
      begin
        SendMessage(hwnd, BFFM_SETSELECTION, 1, lpData);
        SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, lpData);
      end;
    BFFM_SELCHANGED:
      begin
        if SHGetPathFromIDList(Pointer(lParam), Path) then
          SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, Integer(@Path));
      end;
  end;
  Result := 0;
end;

function SelectDir(hOwner: THandle; const Caption, InitialDir: string;
  const Root: WideString; ShowStatus: Boolean; out Directory: string): Boolean;
var
  BrowseInfo: TBrowseInfo;
  Buffer: PChar;
  RootItemIDList,
    ItemIDList: PItemIDList;
  ShellMalloc: IMalloc;
  IDesktopFolder: IShellFolder;
  Eaten, Flags: LongWord; //LongInt;//
  Windows: Pointer;//^Integer;//
  Path: string;
begin
  Result := False;
  Directory := ´´;
  Path := InitialDir;
  if (Length(Path) > 0) and (Path[Length(Path)] = ´\´) then
    Delete(Path, Length(Path), 1);

  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
  begin
    Buffer := ShellMalloc.Alloc(MAX_PATH);
    try
      SHGetDesktopFolder(IDesktopFolder);
      IDesktopFolder.ParseDisplayName(hOwner, nil, PWideChar(Root), Eaten, RootItemIDList, Flags);
      with BrowseInfo do
      begin
        hwndOwner := hOwner;
        pidlRoot := RootItemIDList;
        pszDisplayName := Buffer;
        lpszTitle := PChar(Caption);
        ulFlags := BIF_RETURNONLYFSDIRS;
        if ShowStatus then
          ulFlags := ulFlags or BIF_STATUSTEXT;
        lParam := Integer(PChar(Path));
        lpfn := BrowseCallbackProc;
        iImage := 0;
      end;

      // Make the browser dialog modal.
      Windows := DisableTaskWindows(hOwner);
      try
        ItemIDList := ShBrowseForFolder(BrowseInfo);
      finally
        EnableTaskWindows(Windows);
      end;

      Result := ItemIDList <> nil;
      if Result then
      begin
        ShGetPathFromIDList(ItemIDList, Buffer);
        ShellMalloc.Free(ItemIDList);
        Directory := Buffer;
      end;
    finally
      ShellMalloc.Free(Buffer);
    end;
  end;
end;


procedure TFImportar.btnprocurarClick(Sender: TObject);
Var
   SearchFile: TSearchRec;
   FindResult: Integer;
   FilesDir, DirSelect: String;
Const
   DefaultExt = ´*.*´;
begin
     Listbox1.Clear;
     if SelectDir((Sender as TSpTBXButton).Parent.Handle, ´Procurar Diretório´, FilesDir, ´´, False, DirSelect) then
        FilesDir := DirSelect;
     if FilesDir = ´´ then
        Exit;
     if FilesDir[Length(FilesDir)] <> ´\´  then
        FilesDir := FilesDir + ´\´;
     if FilesDir <> ´´ then
        FindResult := FindFirst(FilesDir+DefaultExt, faArchive, SearchFile);
        try
           While FindResult = 0 do
           begin
                Application.ProcessMessages;
                ListBox1.Items.Add(UpperCase((RetiraExt(SearchFile.Name))));
                //ListBox1.Items.Add((RetiraExt(SearchFile.Name)));
                FindResult := FindNext(SearchFile);
           end;
        finally
              FindClose(SearchFile)
        end;
end;