?? fileutil.pas
字號:
until FindNext(SearchRec) <> 0;
finally
FindClose(SearchRec);
end;
end;
function DeleteFilesEx(const FileMasks: array of string): Boolean;
var
I: Integer;
begin
Result := True;
for I := Low(FileMasks) to High(FileMasks) do
Result := Result and DeleteFiles(FileMasks[I]);
end;
function ClearDir(const Path: string; Delete: Boolean): Boolean;
const
{$IFDEF WIN32}
FileNotFound = 18;
{$ELSE}
FileNotFound = -18;
{$ENDIF}
var
FileInfo: TSearchRec;
DosCode: Integer;
begin
Result := DirExists(Path);
if not Result then Exit;
DosCode := FindFirst(NormalDir(Path) + '*.*', faAnyFile, FileInfo);
try
while DosCode = 0 do begin
// if (FileInfo.Name[1] <> '.') and (FileInfo.Attr <> faVolumeID) then
// !!! BUG !!!
if (FileInfo.Name <> '.') and (FileInfo.Name <> '..') and (FileInfo.Attr <> faVolumeID) then
begin
if (FileInfo.Attr and faDirectory = faDirectory) then
Result := ClearDir(NormalDir(Path) + FileInfo.Name, Delete) and Result
else if (FileInfo.Attr and faVolumeID <> faVolumeID) then begin
if (FileInfo.Attr and faReadOnly = faReadOnly) then
FileSetAttr(NormalDir(Path) + FileInfo.Name, faArchive);
Result := DeleteFile(NormalDir(Path) + FileInfo.Name) and Result;
end;
end;
DosCode := FindNext(FileInfo);
end;
finally
FindClose(FileInfo);
end;
if Delete and Result and (DosCode = FileNotFound) and
not ((Length(Path) = 2) and (Path[2] = ':')) then
begin
RmDir(Path);
Result := (IOResult = 0) and Result;
end;
end;
function GetTempDir: string;
{$IFDEF WIN32}
var
Buffer: array[0..1023] of Char;
begin
SetString(Result, Buffer, GetTempPath(SizeOf(Buffer), Buffer));
{$ELSE}
var
Buffer: array[0..255] of Char;
begin
GetTempFileName(GetTempDrive(#0), '$', 1, Buffer);
Result := ExtractFilePath(StrPas(Buffer));
{$ENDIF}
end;
function GetWindowsDir: string;
{$IFDEF WIN32}
var
Buffer: array[0..1023] of Char;
begin
SetString(Result, Buffer, GetWindowsDirectory(Buffer, SizeOf(Buffer)));
{$ELSE}
begin
Result[0] := Char(GetWindowsDirectory(@Result[1], 254));
{$ENDIF}
end;
function GetSystemDir: string;
{$IFDEF WIN32}
var
Buffer: array[0..1023] of Char;
begin
SetString(Result, Buffer, GetSystemDirectory(Buffer, SizeOf(Buffer)));
{$ELSE}
begin
Result[0] := Char(GetSystemDirectory(@Result[1], 254));
{$ENDIF}
end;
{$IFDEF WIN32}
function ValidFileName(const FileName: string): Boolean;
function HasAny(const Str, Substr: string): Boolean;
var
I: Integer;
begin
Result := False;
for I := 1 to Length(Substr) do begin
if Pos(Substr[I], Str) > 0 then begin
Result := True;
Break;
end;
end;
end;
begin
Result := (FileName <> '') and (not HasAny(FileName, '<>"[]|'));
if Result then Result := Pos('\', ExtractFileName(FileName)) = 0;
end;
function FileLock(Handle: Integer; Offset, LockSize: Longint): Integer;
begin
if LockFile(Handle, Offset, 0, LockSize, 0) then
Result := 0
else
Result := GetLastError;
end;
function FileUnlock(Handle: Integer; Offset, LockSize: Longint): Integer;
begin
if UnlockFile(Handle, Offset, 0, LockSize, 0) then
Result := 0
else
Result := GetLastError;
end;
{$IFDEF RX_D4}
function FileLock(Handle: Integer; Offset, LockSize: Int64): Integer;
begin
if LockFile(Handle, Int64Rec(Offset).Lo, Int64Rec(Offset).Hi,
Int64Rec(LockSize).Lo, Int64Rec(LockSize).Hi) then Result := 0
else
Result := GetLastError;
end;
function FileUnlock(Handle: Integer; Offset, LockSize: Int64): Integer;
begin
if UnlockFile(Handle, Int64Rec(Offset).Lo, Int64Rec(Offset).Hi,
Int64Rec(LockSize).Lo, Int64Rec(LockSize).Hi) then Result := 0
else
Result := GetLastError;
end;
{$ENDIF RX_D4}
{$ELSE}
function ValidFileName(const FileName: string): Boolean;
const
MaxNameLen = 12; { file name and extension }
MaxExtLen = 4; { extension with point }
MaxPathLen = 79; { full file path in DOS }
var
Dir, Name, Ext: TFileName;
function HasAny(Str, SubStr: string): Boolean; near; assembler;
asm
PUSH DS
CLD
LDS SI,Str
LES DI,SubStr
INC DI
MOV DX,DI
XOR AH,AH
LODSB
MOV BX,AX
OR BX,BX
JZ @@2
MOV AL,ES:[DI-1]
XCHG AX,CX
@@1: PUSH CX
MOV DI,DX
LODSB
REPNE SCASB
POP CX
JE @@3
DEC BX
JNZ @@1
@@2: XOR AL,AL
JMP @@4
@@3: MOV AL,1
@@4: POP DS
end;
begin
Result := True;
Dir := Copy(ExtractFilePath(FileName), 1, MaxPathLen);
Name := Copy(ExtractFileName(FileName), 1, MaxNameLen);
Ext := Copy(ExtractFileExt(FileName), 1, MaxExtLen);
if (Dir + Name <> FileName) or HasAny(Name, ';,=+<>|"[] \') or
HasAny(Copy(Ext, 2, 255), ';,=+<>|"[] \.') then Result := False;
end;
function LockFile(Handle: Integer; StartPos, Length: Longint;
Unlock: Boolean): Integer; assembler;
asm
PUSH DS
MOV AH,5CH
MOV AL,Unlock
MOV BX,Handle
MOV DX,StartPos.Word[0]
MOV CX,StartPos.Word[2]
MOV DI,Length.Word[0]
MOV SI,Length.Word[2]
INT 21H
JNC @@1
NEG AX
JMP @@2
@@1: MOV AX,0
@@2: POP DS
end;
function FileLock(Handle: Integer; Offset, LockSize: Longint): Integer;
begin
Result := LockFile(Handle, Offset, LockSize, False);
end;
function FileUnlock(Handle: Integer; Offset, LockSize: Longint): Integer;
begin
Result := LockFile(Handle, Offset, LockSize, True);
end;
{$ENDIF WIN32}
{$IFDEF WIN32}
function ShortToLongFileName(const ShortName: string): string;
var
Temp: TWin32FindData;
SearchHandle: THandle;
begin
SearchHandle := FindFirstFile(PChar(ShortName), Temp);
if SearchHandle <> INVALID_HANDLE_VALUE then begin
Result := string(Temp.cFileName);
if Result = '' then Result := string(Temp.cAlternateFileName);
end
else Result := '';
Windows.FindClose(SearchHandle);
end;
function LongToShortFileName(const LongName: string): string;
var
Temp: TWin32FindData;
SearchHandle: THandle;
begin
SearchHandle := FindFirstFile(PChar(LongName), Temp);
if SearchHandle <> INVALID_HANDLE_VALUE then begin
Result := string(Temp.cAlternateFileName);
if Result = '' then Result := string(Temp.cFileName);
end
else Result := '';
Windows.FindClose(SearchHandle);
end;
function ShortToLongPath(const ShortName: string): string;
var
LastSlash: PChar;
TempPathPtr: PChar;
begin
Result := '';
TempPathPtr := PChar(ShortName);
LastSlash := StrRScan(TempPathPtr, '\');
while LastSlash <> nil do begin
Result := '\' + ShortToLongFileName(TempPathPtr) + Result;
if LastSlash <> nil then begin
LastSlash^ := char(0);
LastSlash := StrRScan(TempPathPtr, '\');
end;
end;
Result := TempPathPtr + Result;
end;
function LongToShortPath(const LongName: string): string;
var
LastSlash: PChar;
TempPathPtr: PChar;
begin
Result := '';
TempPathPtr := PChar(LongName);
LastSlash := StrRScan(TempPathPtr, '\');
while LastSlash <> nil do begin
Result := '\' + LongToShortFileName(TempPathPtr) + Result;
if LastSlash <> nil then begin
LastSlash^ := char(0);
LastSlash := StrRScan(TempPathPtr, '\');
end;
end;
Result := TempPathPtr + Result;
end;
const
IID_IPersistFile: TGUID = (
D1:$0000010B;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
{$IFNDEF RX_D3}
const
IID_IShellLinkA: TGUID = (
D1:$000214EE; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));
CLSID_ShellLink: TGUID = (
D1:$00021401; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));
type
IShellLink = class(IUnknown) { sl }
function GetPath(pszFile: LPSTR; cchMaxPath: Integer;
var pfd: TWin32FindData; fFlags: DWORD): HResult; virtual; stdcall; abstract;
function GetIDList(var ppidl: PItemIDList): HResult; virtual; stdcall; abstract;
function SetIDList(pidl: PItemIDList): HResult; virtual; stdcall; abstract;
function GetDescription(pszName: LPSTR; cchMaxName: Integer): HResult; virtual; stdcall; abstract;
function SetDescription(pszName: LPSTR): HResult; virtual; stdcall; abstract;
function GetWorkingDirectory(pszDir: LPSTR; cchMaxPath: Integer): HResult; virtual; stdcall; abstract;
function SetWorkingDirectory(pszDir: LPSTR): HResult; virtual; stdcall; abstract;
function GetArguments(pszArgs: LPSTR; cchMaxPath: Integer): HResult; virtual; stdcall; abstract;
function SetArguments(pszArgs: LPSTR): HResult; virtual; stdcall; abstract;
function GetHotkey(var pwHotkey: Word): HResult; virtual; stdcall; abstract;
function SetHotkey(wHotkey: Word): HResult; virtual; stdcall; abstract;
function GetShowCmd(var piShowCmd: Integer): HResult; virtual; stdcall; abstract;
function SetShowCmd(iShowCmd: Integer): HResult; virtual; stdcall; abstract;
function GetIconLocation(pszIconPath: LPSTR; cchIconPath: Integer;
var piIcon: Integer): HResult; virtual; stdcall; abstract;
function SetIconLocation(pszIconPath: LPSTR; iIcon: Integer): HResult; virtual; stdcall; abstract;
function SetRelativePath(pszPathRel: LPSTR; dwReserved: DWORD): HResult; virtual; stdcall; abstract;
function Resolve(Wnd: HWND; fFlags: DWORD): HResult; virtual; stdcall; abstract;
function SetPath(pszFile: LPSTR): HResult; virtual; stdcall; abstract;
end;
{$ENDIF}
const
LinkExt = '.lnk';
procedure CreateFileLink(const FileName, DisplayName: string; Folder: Integer);
var
ShellLink: IShellLink;
PersistFile: IPersistFile;
ItemIDList: PItemIDList;
FileDestPath: array[0..MAX_PATH] of Char;
FileNameW: array[0..MAX_PATH] of WideChar;
begin
CoInitialize(nil);
try
OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_SERVER,
IID_IShellLinkA, ShellLink));
try
OleCheck(ShellLink.QueryInterface(IID_IPersistFile, PersistFile));
try
OleCheck(SHGetSpecialFolderLocation(0, Folder, ItemIDList));
SHGetPathFromIDList(ItemIDList, FileDestPath);
StrCat(FileDestPath, PChar('\' + DisplayName + LinkExt));
ShellLink.SetPath(PChar(FileName));
ShellLink.SetIconLocation(PChar(FileName), 0);
MultiByteToWideChar(CP_ACP, 0, FileDestPath, -1, FileNameW, MAX_PATH);
OleCheck(PersistFile.Save(FileNameW, True));
finally
{$IFDEF RX_D3}
PersistFile := nil;
{$ELSE}
PersistFile.Release;
{$ENDIF}
end;
finally
{$IFDEF RX_D3}
ShellLink := nil;
{$ELSE}
ShellLink.Release;
{$ENDIF}
end;
finally
CoUninitialize;
end;
end;
procedure DeleteFileLink(const DisplayName: string; Folder: Integer);
var
ShellLink: IShellLink;
ItemIDList: PItemIDList;
FileDestPath: array[0..MAX_PATH] of Char;
begin
CoInitialize(nil);
try
OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_SERVER,
IID_IShellLinkA, ShellLink));
try
OleCheck(SHGetSpecialFolderLocation(0, Folder, ItemIDList));
SHGetPathFromIDList(ItemIDList, FileDestPath);
StrCat(FileDestPath, PChar('\' + DisplayName + LinkExt));
DeleteFile(FileDestPath);
finally
{$IFDEF RX_D3}
ShellLink := nil;
{$ELSE}
ShellLink.Release;
{$ENDIF}
end;
finally
CoUninitialize;
end;
end;
{$ENDIF WIN32}
{$IFNDEF RX_D3}
function IsPathDelimiter(const S: string; Index: Integer): Boolean;
begin
Result := (Index > 0) and (Index <= Length(S)) and (S[Index] = '\');
end;
{$ENDIF}
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -