[billgate]

Добрый день!

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

Код:

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]

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