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