Странное поведение MultiByteToWideChar

billgate · #1 04.05.2018, 02:08

Добрый день!

Написал простое приложение для загрузки дерева каталогов в TTreeView. Использую FindFirstFileW, FindNextFileW для поиска в каталоге, а также WideCharToMultiByte и MultiByteToWideChar для конвертации аргументов, при передаче в первые две функции. Собственно, проблема с MultiByteToWideChar.
Программа вроде бы строила дерево, но часть каталогов была пропущена. Поскольку код с FindFirstFileW, FindNextFileW был помещен в критические секции, и при ошибке процедура поиска в каталоге завершалась - сначала грешил на эти функции. Анализ GetLastError(), показал, что ошибку вызывали не они, а MultiByteToWideChar. Поместил ее вызов в блок try/except, и отладочные сообщения показывают, что эта функция дает исключение ACCESS_VIOLATION, причем дает в СЛУЧАЙНЫЕ моменты. Т.е. при новом запуске, данная ошибка возникает при обходе других каталогов. Самое интересное - выяснилось, что функция все равно работает и дает правильный результат! Если просто ИГНОРИРОВАТЬ исключение (в секции except), то программа работает и загружает дерево каталогов без ошибок! Но мне такое решение кажется очень странным и идеологически неправильным.
Соответственно, вопрос: в чем может быть причина access violation при вызове MultiByteToWideChar? И почему при игнорировании этого исключения, программа работает?
Буду признателен за любые идеи.

Среда разработки - Delphi 7.
Код программы приведен ниже. Если нужно выкинуть что-то лишнее из цитируемого кода, прошу сообщить мне.
(Основная работа выполняется функциями GetDirectoryTree и ProcessDirectoryNode -> в ней и появлялось исключение).
* примечание: TFlatLabel и TAlignedEdit мои собственные компоненты, их можно (нужно) заменить на просто TLabel и TEdit при проверке кода

Код:

unit Main;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ShellApi, StdCtrls, AlignedEdit, FlatLabel, ComCtrls;
 
type
 
  TWideCharBuffer = array[0..MAX_PATH - 1] of WideChar;
 
  TNodeArray = array [1..MaxListSize] of TTreeNode;
 
  TNodeList = class
 
  private
    FCount: cardinal;
    FItems: TNodeArray;
    procedure Clear;
    function Add(const aNode: TTreeNode): cardinal;
  public
    constructor Create;
    property Count: cardinal read FCount;
    property Items: TNodeArray read FItems;
    procedure Assign(const NodeList: TNodeList);
  end;
 
  TfmMain = class(TForm)
    meDebug: TMemo;
    Button1: TButton;
    FlatLabel1: TFlatLabel;
    AlignedEdit1: TAlignedEdit;
    Button2: TButton;
    Memo2: TMemo;
    twMain: TTreeView;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    procedure Display(s: string);
    function faToString(fa: integer): string;
    function IsDirectory(fa: Integer): boolean;
    function IsSpecialFile(fa: Integer): boolean;
    function IsFile(fa: Integer): boolean;
    function GetFilenameLength(S: PAnsiChar): integer;
    function InitTree(const S: string; const TreeView: TTreeView): TTreeNode;
    function ProcessDirectoryNode(const aNode: TTreeNode; const TreeView: TTreeView; const NodeList: TNodeList): cardinal;
    function GetDirectoryTree(const Root: string; const TreeView: TTreeView): integer;
    procedure StringToWidechar(S: PChar; const Buffer: TWideCharBuffer);
  public
    { Public declarations }
  end;
 
var
  fmMain: TfmMain;
  Nodes, NewNodes: TNodeList;
  NodeCount: cardinal;
 
implementation
 
{$R *.dfm}
 
{ TfmMain }
 
procedure TfmMain.Button1Click(Sender: TObject);
var
  S: String;
  Count: cardinal;
begin
    meDebug.Clear;
    S:= AlignedEdit1.Text;
    Count:=GetDirectoryTree(S,twMain);
    Memo2.Lines.Add('Found ' + IntToStr(Count) + ' sub-directories in ' + S);
end;
 
procedure TfmMain.Display(s: string);
begin
  meDebug.Lines.Append(s);
end;
 
function TfmMain.IsDirectory(fa: Integer): boolean;
begin
  Result:= (fa and faDirectory) = faDirectory;
end;
 
function TfmMain.IsFile(fa: Integer): boolean;
begin
  Result:=((fa and faAnyFile) = faAnyFile);
end;
 
function TfmMain.InitTree(const S: string; const TreeView: TTreeView): TTreeNode;
begin
  Result:=nil;
  if not DirectoryExists(S) then Exit;
  with TreeView do begin
    Items.Clear;
    Result:=Items.Add(nil,S);
  end;
end;
 
procedure TfmMain.FormCreate(Sender: TObject);
begin
 Nodes:=TNodeList.Create;
 NewNodes:=TNodeList.Create;
end;
 
function TfmMain.ProcessDirectoryNode(const aNode: TTreeNode;
  const TreeView: TTreeView; const NodeList: TNodeList): cardinal;
var
  tWDF: WIN32_FIND_DATAW;
  h: Cardinal;
  gwError: Cardinal;
  Count: integer;
  found: boolean;
  s: string;
  wSearchName: array[0..MAX_PATH - 1] of WideChar;
  searchName: PChar;
  foundName: array[0..MAX_PATH - 1] of Char;
  NewNode: TTreeNode;
  Path: string;
begin
  Result:= 0;
  if (aNode = nil) or (NodeList = nil) then Exit;
  Path:=aNode.Text;
  searchName:=PChar(Path + '\*.*');
  Count:=0;
  try
    MultiByteToWideChar(CP_UTF8, 0, searchName, MAX_PATH, wSearchName, MAX_PATH);
  except
    Display('Error in MultiByteToWideChar for ' + searchName);
    //Exit; <------- ВОТ ЗДЕСЬ, ЕСЛИ ЗАКОММЕНТИРОВАТЬ Exit, ТО ВСЕ РАБОТАЕТ! Т.Е. ПРОСТО ИГНОРИРУЕМ ИСКЛЮЧЕНИЕ
  end;
  try
    h:=FindFirstFileW(wSearchName, tWDF);
  except
    Display('FindFirstFileW error in ' + wSearchName);
    Exit;
  end;
  WideCharToMultiByte(CP_UTF8, 0, tWDF.cFileName, MAX_PATH, foundName, MAX_PATH, nil, nil);
  with tWDF do
    begin
      Application.ProcessMessages;
      if h = INVALID_HANDLE_VALUE then
        begin
          Display('INVALID_HANDLE_VALUE for search in '+Path + '\*.*');
          Result:=h;
          Windows.FindClose(h);
          Exit;
        end;
        if cFileName[0]<>'.' then
        begin
          if IsDirectory(dwFileAttributes) then
            begin
              NewNode:=TreeView.Items.AddChild(aNode,Path + '\' + cFileName);
              NodeList.Add(NewNode);
              Inc(Result);
              TreeView.Update;
            end
          else Exit;
        end;
    while true do
      begin
        Application.ProcessMessages;
        try
        if FindNextFileW(h,tWDF)then
          begin
            WideCharToMultiByte(CP_UTF8, 0, tWDF.cFileName, MAX_PATH, foundName, MAX_PATH, nil, nil);
            if cFileName[0] <> '.' then
              begin
                if IsDirectory(dwFileAttributes) then
                begin
                  NewNode:=TreeView.Items.AddChild(aNode,Path + '\'+ foundName);
                  NodeList.Add(NewNode);
                  TreeView.Update;
                end
                else
                begin
                  //Process file
                end;
              end;
          end
        else Break;
        except
          //Display('FindNextFileW(h,tWDF) error in '+ cFileName);
          //Break;
        end;
      end;
   end;
end;
 
function TfmMain.GetDirectoryTree(const Root: string;
  const TreeView: TTreeView): integer;
var
  aNode: TTreeNode;
  ParentNode: TTreeNode;
  Count: cardinal;
  i: cardinal;
  DirectoryCount: cardinal;
begin
  Result:=0;
  DirectoryCount:=0;
  if (Root = '') or (TreeView = nil) then Exit;
  TreeView.Items.Clear;
  Nodes.Clear;
  NewNodes.Clear;
  ParentNode:=InitTree(Root,twMain);
  ProcessDirectoryNode(ParentNode,twMain,Nodes);
  if Nodes.Count = 0 then Exit;
  Inc(DirectoryCount, Nodes.Count);
  while true do begin
    Count:=Nodes.Count;
    NewNodes.Clear;
    for i:=1 to Count do begin
      ParentNode:=Nodes.Items[i];
      ProcessDirectoryNode(ParentNode, twMain, NewNodes);
    end;
    if NewNodes.Count = 0 then break;
    Inc(DirectoryCount, NewNodes.Count);
    Nodes.Assign(NewNodes);
  end;
  Result:=DirectoryCount;
end;
 
{ TNodeList }
 
function TNodeList.Add(const aNode: TTreeNode): cardinal;
begin
  Result:= 0;
  if aNode = nil then Exit;
  Inc(FCount);
  FItems[FCount]:=aNode;
end;
 
procedure TNodeList.Assign(const NodeList: TNodeList);
begin
  FItems:=NodeList.Items;
  FCount:=NodeList.Count;
end;
 
procedure TNodeList.Clear;
begin
  if FCount = 0 then Exit;
  FCount:=0;
end;
 
constructor TNodeList.Create;
begin
  FCount:=0;
end;
 
 
end.

dr. F.I.N. · #2 04.05.2018, 14:02

Код:

function TForm1.ProcessDirectoryNode(const aNode: TTreeNode; const TreeView: TTreeView; const NodeList: TNodeList): cardinal;
var
  tWDF: WIN32_FIND_DATAW;
  h: Cardinal;
  wSearchName: PWideChar; // <--------
  searchName: PChar;
  foundName: array[0..MAX_PATH - 1] of Char;
  NewNode: TTreeNode;
  Path: string;
  res_len: Integer;
begin
  Result := 0;
  if (aNode = nil) or (NodeList = nil) then
    Exit;
  Path := aNode.Text;
  searchName := PChar(Path + '\*.*');
 
  res_len := MultiByteToWideChar(CP_UTF8, 0, searchName, Length(searchName), nil, 0);  // <-------- Определяем длину выходного буфера
  h := INVALID_HANDLE_VALUE;
  if res_len > 0 then
  begin
    wSearchName := GetMemory(res_len * SizeOf(WideChar) + 2); // <-------- выделяем память под выходной буфер
    try
      FillMemory(wSearchName, res_len, 0); // <-------- очищаем выходной буфер
      res_len := MultiByteToWideChar(CP_UTF8, 0, searchName, Length(searchName), wSearchName, res_len); // <-------- конвертируем
      if res_len = 0 then
        RaiseLastOSError
      else
        h := FindFirstFileW(wSearchName, tWDF);
    finally
      FreeMemory(wSearchName); // <-------- не забываем подчистить за собой
    end;
  end;
 
  WideCharToMultiByte(CP_UTF8, 0, tWDF.cFileName, MAX_PATH, foundName, MAX_PATH, nil, nil);
  with tWDF do
  begin
    Application.ProcessMessages;
    if h = INVALID_HANDLE_VALUE then
....

Win7, D7 отрабатывает без ошибок и почти моментально на забитом C:\

billgate · #3 04.05.2018, 21:44

Огромное спасибо!

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты

Этот пользователь сказал Спасибо dr. F.I.N. за это полезное сообщение:
billgate (04.05.2018)