fileutil.pas

灰鸽子1.23源码,,,,,,,

      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.