Форум по программированию Delphi Sources

 



Вернуться   Форум по программированию Delphi Sources > Все о Delphi > Файловая система
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 04.05.2018, 02:08
billgate billgate вне форума
Прохожий
 
Регистрация: 04.05.2018
Сообщения: 2
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Странное поведение MultiByteToWideChar

Добрый день!

Написал простое приложение для загрузки дерева каталогов в 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.

Последний раз редактировалось billgate, 04.05.2018 в 05:39.
Ответить с цитированием
  #2  
Старый 04.05.2018, 14:02
Аватар для dr. F.I.N.
dr. F.I.N. dr. F.I.N. вне форума
I Like it!
 
Регистрация: 12.12.2009
Адрес: Россия, г. Новосибирск
Сообщения: 615
Версия Delphi: D6/D7
Репутация: 26643
По умолчанию

Код:
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:\
__________________
Грамотно поставленный вопрос содержит не менее 50% ответа.
Грамотно поставленная речь вызывает уважение, а у некоторых даже зависть.
Ответить с цитированием
Этот пользователь сказал Спасибо dr. F.I.N. за это полезное сообщение:
billgate (04.05.2018)
  #3  
Старый 04.05.2018, 21:44
billgate billgate вне форума
Прохожий
 
Регистрация: 04.05.2018
Сообщения: 2
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию

Огромное спасибо!
Ответить с цитированием
Ответ



Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 14:57.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources", 2004-2018

ВКонтакте   Facebook   Twitter