?? fileutil.pas
字號:
finally
Free;
end;
end
else Result := SelectDirectory(AFolderName, [], AHelpContext);
end;
function BrowseComputer(var ComputerName: string; const DlgText: string;
AHelpContext: THelpContext): Boolean;
begin
with TBrowseFolderDlg.Create(Application) do
try
BrowseKind := bfComputers;
DialogText := DlgText;
FolderName := ComputerName;
HelpContext := AHelpContext;
Result := Execute;
if Result then ComputerName := FolderName;
finally
Free;
end;
end;
{ TRxFileOperator }
type
TFileOperation = (foCopy, foDelete, foMove, foRename);
TFileOperFlag = (flAllowUndo, flConfirmMouse, flFilesOnly, flMultiDest,
flNoConfirmation, flNoConfirmMkDir, flRenameOnCollision, flSilent,
flSimpleProgress, flNoErrorUI);
TFileOperFlags = set of TFileOperFlag;
TRxFileOperator = class(TComponent)
private
FAborted: Boolean;
FOperation: TFileOperation;
FOptions: TFileOperFlags;
FProgressTitle: string;
FSource: string;
FDestination: string;
function TaskModalDialog(DialogFunc: Pointer; var DialogData): Boolean;
public
constructor Create(AOwner: TComponent); override;
function Execute: Boolean; virtual;
property Aborted: Boolean read FAborted;
published
property Destination: string read FDestination write FDestination;
property Operation: TFileOperation read FOperation write FOperation
default foCopy;
property Options: TFileOperFlags read FOptions write FOptions
default [flAllowUndo, flNoConfirmMkDir];
property ProgressTitle: string read FProgressTitle write FProgressTitle;
property Source: string read FSource write FSource;
end;
{$IFNDEF RX_D3}
const
FOF_NOERRORUI = $0400;
{$ENDIF}
constructor TRxFileOperator.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FOptions := [flAllowUndo, flNoConfirmMkDir];
end;
function TRxFileOperator.TaskModalDialog(DialogFunc: Pointer; var DialogData): Boolean;
type
TDialogFunc = function(var DialogData): Integer stdcall;
var
ActiveWindow: HWnd;
WindowList: Pointer;
begin
ActiveWindow := GetActiveWindow;
WindowList := DisableTaskWindows(0);
try
Result := TDialogFunc(DialogFunc)(DialogData) = 0;
finally
EnableTaskWindows(WindowList);
SetActiveWindow(ActiveWindow);
end;
end;
function TRxFileOperator.Execute: Boolean;
const
OperTypes: array[TFileOperation] of UINT = (
FO_COPY, FO_DELETE, FO_MOVE, FO_RENAME);
OperOptions: array[TFileOperFlag] of FILEOP_FLAGS = (
FOF_ALLOWUNDO, FOF_CONFIRMMOUSE, FOF_FILESONLY, FOF_MULTIDESTFILES,
FOF_NOCONFIRMATION, FOF_NOCONFIRMMKDIR, FOF_RENAMEONCOLLISION,
FOF_SILENT, FOF_SIMPLEPROGRESS, FOF_NOERRORUI);
var
OpStruct: TSHFileOpStruct;
Flag: TFileOperFlag;
function AllocFileStr(const S: string): PChar;
var
P: PChar;
begin
Result := nil;
if S <> '' then begin
Result := StrCopy(StrAlloc(Length(S) + 2), PChar(S));
P := Result;
while P^ <> #0 do begin
if (P^ = ';') or (P^ = '|') then P^ := #0;
Inc(P);
end;
Inc(P);
P^ := #0;
end;
end;
begin
FAborted := False;
FillChar(OpStruct, SizeOf(OpStruct), 0);
with OpStruct do
try
if (Application.MainForm <> nil) and
Application.MainForm.HandleAllocated then
Wnd := Application.MainForm.Handle
else Wnd := Application.Handle;
wFunc := OperTypes[Operation];
pFrom := AllocFileStr(FSource);
pTo := AllocFileStr(FDestination);
fFlags := 0;
for Flag := Low(Flag) to High(Flag) do
if Flag in FOptions then fFlags := fFlags or OperOptions[Flag];
lpszProgressTitle := PChar(FProgressTitle);
Result := TaskModalDialog(@SHFileOperation, OpStruct);
FAborted := fAnyOperationsAborted;
finally
if pFrom <> nil then StrDispose(pFrom);
if pTo <> nil then StrDispose(pTo);
end;
end;
{$ELSE}
function BrowseDirectory(var AFolderName: string; const DlgText: string;
AHelpContext: THelpContext): Boolean;
begin
Result := SelectDirectory(AFolderName, [], AHelpContext);
end;
{$ENDIF WIN32}
function NormalDir(const DirName: string): string;
begin
Result := DirName;
if (Result <> '') and
{$IFDEF RX_D3}
not (AnsiLastChar(Result)^ in [':', '\']) then
{$ELSE}
not (Result[Length(Result)] in [':', '\']) then
{$ENDIF}
begin
if (Length(Result) = 1) and (UpCase(Result[1]) in ['A'..'Z']) then
Result := Result + ':\'
else Result := Result + '\';
end;
end;
function RemoveBackSlash(const DirName: string): string;
begin
Result := DirName;
if (Length(Result) > 1) and
{$IFDEF RX_D3}
(AnsiLastChar(Result)^ = '\') then
{$ELSE}
(Result[Length(Result)] = '\') then
{$ENDIF}
begin
if not ((Length(Result) = 3) and (UpCase(Result[1]) in ['A'..'Z']) and
(Result[2] = ':')) then
Delete(Result, Length(Result), 1);
end;
end;
function DirExists(Name: string): Boolean;
{$IFDEF WIN32}
var
Code: Integer;
begin
Code := GetFileAttributes(PChar(Name));
Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;
{$ELSE}
var
SR: TSearchRec;
begin
if Name[Length(Name)] = '\' then Dec(Name[0]);
if (Length(Name) = 2) and (Name[2] = ':') then
Name := Name + '\*.*';
Result := FindFirst(Name, faDirectory, SR) = 0;
Result := Result and (SR.Attr and faDirectory <> 0);
end;
{$ENDIF}
procedure ForceDirectories(Dir: string);
begin
if Length(Dir) = 0 then Exit;
{$IFDEF RX_D3}
if (AnsiLastChar(Dir) <> nil) and (AnsiLastChar(Dir)^ = '\') then
{$ELSE}
if Dir[Length(Dir)] = '\' then
{$ENDIF}
Delete(Dir, Length(Dir), 1);
if (Length(Dir) < 3) or DirectoryExists(Dir) or
(ExtractFilePath(Dir) = Dir) then Exit;
ForceDirectories(ExtractFilePath(Dir));
{$IFDEF WIN32}
CreateDir(Dir);
{$ELSE}
MkDir(Dir);
{$ENDIF}
end;
{$IFDEF WIN32}
procedure CopyMoveFileShell(const FileName, DestName: string; Confirmation,
AllowUndo, MoveFile: Boolean);
begin
with TRxFileOperator.Create(nil) do
try
Source := FileName;
Destination := DestName;
if MoveFile then begin
if AnsiCompareText(ExtractFilePath(FileName),
ExtractFilePath(DestName)) = 0 then
Operation := foRename
else Operation := foMove;
end
else Operation := foCopy;
if not AllowUndo then
Options := Options - [flAllowUndo];
if not Confirmation then
Options := Options + [flNoConfirmation];
if not Execute or Aborted then SysUtils.Abort;
finally
Free;
end;
end;
{$ENDIF}
procedure CopyFile(const FileName, DestName: string;
ProgressControl: TControl);
begin
CopyFileEx(FileName, DestName, False, False, ProgressControl);
end;
procedure CopyFileEx(const FileName, DestName: string;
OverwriteReadOnly, ShellDialog: Boolean; ProgressControl: TControl);
var
CopyBuffer: Pointer;
Source, Dest: Integer;
Destination: TFileName;
FSize, BytesCopied, TotalCopied: Longint;
Attr: Integer;
const
ChunkSize: Longint = 8192;
begin
{$IFDEF WIN32}
if NewStyleControls and ShellDialog then begin
CopyMoveFileShell(FileName, DestName, not OverwriteReadOnly,
False, False);
Exit;
end;
{$ENDIF}
Destination := DestName;
if HasAttr(Destination, faDirectory) then
Destination := NormalDir(Destination) + ExtractFileName(FileName);
GetMem(CopyBuffer, ChunkSize);
try
TotalCopied := 0;
FSize := GetFileSize(FileName);
Source := FileOpen(FileName, fmShareDenyWrite);
if Source < 0 then
raise EFOpenError.CreateFmt(ResStr(SFOpenError), [FileName]);
try
if ProgressControl <> nil then begin
SetProgressMax(ProgressControl, FSize);
SetProgressMin(ProgressControl, 0);
SetProgressValue(ProgressControl, 0);
end;
ForceDirectories(ExtractFilePath(Destination));
if OverwriteReadOnly then begin
Attr := FileGetAttr(Destination);
if (Attr >= 0) and ((Attr and faReadOnly) <> 0) then
FileSetAttr(Destination, Attr and not faReadOnly);
end;
Dest := FileCreate(Destination);
if Dest < 0 then
raise EFCreateError.CreateFmt(ResStr(SFCreateError), [Destination]);
try
repeat
BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize);
if BytesCopied = -1 then
raise EReadError.Create(ResStr(SReadError));
TotalCopied := TotalCopied + BytesCopied;
if BytesCopied > 0 then begin
if FileWrite(Dest, CopyBuffer^, BytesCopied) = -1 then
raise EWriteError.Create(ResStr(SWriteError));
end;
if ProgressControl <> nil then
SetProgressValue(ProgressControl, TotalCopied);
until BytesCopied < ChunkSize;
FileSetDate(Dest, FileGetDate(Source));
finally
FileClose(Dest);
end;
finally
FileClose(Source);
end;
finally
FreeMem(CopyBuffer, ChunkSize);
if ProgressControl <> nil then
SetProgressValue(ProgressControl, 0);
end;
end;
procedure MoveFile(const FileName, DestName: TFileName);
var
Destination: TFileName;
Attr: Integer;
begin
Destination := ExpandFileName(DestName);
if not RenameFile(FileName, Destination) then begin
Attr := FileGetAttr(FileName);
if Attr < 0 then Exit;
if (Attr and faReadOnly) <> 0 then
FileSetAttr(FileName, Attr and not faReadOnly);
CopyFile(FileName, Destination, nil);
DeleteFile(FileName);
end;
end;
procedure MoveFileEx(const FileName, DestName: TFileName;
ShellDialog: Boolean);
begin
{$IFDEF WIN32}
if NewStyleControls and ShellDialog then
CopyMoveFileShell(FileName, DestName, False, False, True)
else
{$ENDIF}
MoveFile(FileName, DestName);
end;
{$IFDEF RX_D4}
function GetFileSize(const FileName: string): Int64;
var
Handle: THandle;
FindData: TWin32FindData;
begin
Handle := FindFirstFile(PChar(FileName), FindData);
if Handle <> INVALID_HANDLE_VALUE then begin
Windows.FindClose(Handle);
if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
begin
Int64Rec(Result).Lo := FindData.nFileSizeLow;
Int64Rec(Result).Hi := FindData.nFileSizeHigh;
Exit;
end;
end;
Result := -1;
end;
{$ELSE}
function GetFileSize(const FileName: string): Longint;
var
SearchRec: TSearchRec;
begin
if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
Result := SearchRec.Size
else Result := -1;
FindClose(SearchRec);
end;
{$ENDIF RX_D4}
function FileDateTime(const FileName: string): System.TDateTime;
var
Age: Longint;
begin
Age := FileAge(FileName);
if Age = -1 then
Result := NullDate
else
Result := FileDateToDateTime(Age);
end;
function HasAttr(const FileName: string; Attr: Integer): Boolean;
var
FileAttr: Integer;
begin
FileAttr := FileGetAttr(FileName);
Result := (FileAttr >= 0) and (FileAttr and Attr = Attr);
end;
function DeleteFiles(const FileMask: string): Boolean;
var
SearchRec: TSearchRec;
begin
Result := FindFirst(ExpandFileName(FileMask), faAnyFile, SearchRec) = 0;
try
if Result then
repeat
// if (SearchRec.Name[1] <> '.') and
// !!! BUG !!!
if (SearchRec.Name <> '.') and
(SearchRec.Attr and faVolumeID <> faVolumeID) and
(SearchRec.Attr and faDirectory <> faDirectory) then
begin
Result := DeleteFile(ExtractFilePath(FileMask) + SearchRec.Name);
if not Result then Break;
end;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -