Цитата(Riply @ 10.3.2008, 17:17  ) | Я почему спрашиваю, если да, то мне имеет смысл его скопировать,
и попробовать найти прчину |
Лень было разбираться (ленивая я, что тут поделать).
Нашла у себя в старых проектах.
Предупреждаю сразу: с тех пор как я этот код написала, я им не пользовалась.
Нуждается в доработке и тестировании.
| Код |
uses
WideStrings;
// Alx enum const (usually - retern value of callback functions)
const
ALX_SCAN_CURRENT = 0;
ALX_SKIP_CURRENT = ALX_SCAN_CURRENT + 1;
ALX_STOP_SCAN_CURRENT = ALX_SCAN_CURRENT + 2;
ALX_STOP_SCAN = ALX_SCAN_CURRENT + 3;
ALX_SUCCESS_SCAN = ALX_SCAN_CURRENT + 4;
type
PWIN32_FIND_DATAW = ^WIN32_FIND_DATAW;
TFDFiles_CallBack = function(const pSeachW: PWIN32_FIND_DATAW; const wDirPath: WideString; const Index: integer; pParam: Pointer): DWord;
type
TWideString_Array = array of WideString;
const
SR_DIR_COUNT = 64;
PathDelimW: WideString = '\';
function Ws_IsRoot(PW: PWideChar): Boolean;
begin
if PW^ = '.' then
begin
Inc(PW);
Result := (PW^ = #0) or ((PW^ = '.') and ((PW + 1)^ = #0));
end
else Result := False;
end;
function Enum_FilesFDW(const wDirName: WideString; CallBack: TFDFiles_CallBack; pParam: Pointer; Recurs: Boolean; const pLastErr: PDWord = nil): TPoint;
var
ContinueScan : Boolean;
procedure FindFilesRec(const wRootPath: WideString; Rcrs: Boolean);
var
FindDataW: WIN32_FIND_DATAW;
FDHandle: THandle;
i, DirCount: integer;
DirArr: TWideString_Array;
begin
FDHandle := FindFirstFileW(PWideChar(wRootPath + '*.rar'), FindDataW);
if FDHandle <> INVALID_HANDLE_VALUE then
try
DirCount := 0;
while ContinueScan do
begin
with FindDataW do { TODO -oSashka : Test attributes for FILE_ATTRIBUTE_REPARSE_POINT !!! }
if (dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY then
case CallBack(@FindDataW, wRootPath, Result.X + Result.Y, pParam) of
ALX_STOP_SCAN: ContinueScan := False;
ALX_STOP_SCAN_CURRENT: Break;
ALX_SKIP_CURRENT: ;
else inc(Result.x);
end
else
if not Ws_IsRoot(@cFileName) then
case CallBack(@FindDataW, wRootPath, - (Result.X + Result.Y), pParam) of
ALX_STOP_SCAN: ContinueScan := False;
ALX_STOP_SCAN_CURRENT: Break;
ALX_SKIP_CURRENT: ;
else
begin
if Rcrs and ContinueScan then
begin
if Length(DirArr) <= DirCount then SetLength(DirArr, Length(DirArr) + SR_DIR_COUNT);
DirArr[DirCount] := FindDataW.cFileName;
inc(DirCount);
end;
inc(Result.Y);
end;
end;
if not FindNextFileW(FDHandle, FindDataW) then Break;
end;
finally
Windows.FindClose(FDHandle);
end
else
begin
DirCount := 0;
if (pLastErr <> nil) and (pLastErr^ = ERROR_SUCCESS) then pLastErr^ := GetLastError;
end;
if Rcrs then
for i:= 0 to DirCount - 1 do
if ContinueScan then FindFilesRec(WRootPath + DirArr[i] + PathDelimW, Rcrs) else Exit;
end;
begin
FillChar(Result, SizeOf(TPoint), 0);
if pLastErr <> nil then pLastErr^ := ERROR_SUCCESS;
ContinueScan := True;
try
FindFilesRec(IncludeTrailingPathDelimiter(wDirName), Recurs);
finally
CallBack(nil, '', Result.X + Result.Y, pParam);
end;
end;
|
Ну и пример вызова:
| Код |
function Enum_CallBack(const pSeachW: PWIN32_FIND_DATAW; const wDirPath: WideString; const Index: integer; ListW: TWideStrings): DWord;
begin
if pSeachW <> nil then ListW.Add(wDirPath + pSeachW.cFileName);
Result := ALX_SCAN_CURRENT;
end;
procedure TMainForm.Button1Click(Sender: TObject);
var
ListW: TWideStringList;
ObjCount: TPoint;
DirName: WideString;
RetErr: DWord;
begin
inherited;
DirName := 'E:\Delete Files';
ListW := TWideStringList.Create;
try
ObjCount := Enum_FilesFDW(DirName, @Enum_CallBack, ListW, True, @RetErr);
ListW.Sort;
ShowMessage(SysErrorMessage(RetErr) + sLineBreak + 'FileCount: ' + IntToStr(ObjCount.X) + ', ' +
'DirCount: ' + IntToStr(ObjCount.y) + sLineBreak + ListW.Text);
finally
ListW.Free;
end;
end;
|
Еще раз предупреждаю: требуется доработка. |
), подскажите пожалуйста, как мне сделать поиск по директориям, допустим по диску D найти все архивные файлы (*.rar)
) правильнее 
