Subversion Repositories autosfx

Rev

Blame | Last modification | View Log | RSS feed

  1. unit ZMWUtils19;
  2.  
  3. (*
  4.   ZMWUtils19.pas - Windows file functions supporting Unicode names
  5.     Copyright (C) 2009, 2010  by Russell J. Peters, Roger Aelbrecht,
  6.       Eric W. Engler and Chris Vleghert.
  7.  
  8.         This file is part of TZipMaster Version 1.9.
  9.  
  10.     TZipMaster is free software: you can redistribute it and/or modify
  11.     it under the terms of the GNU Lesser General Public License as published by
  12.     the Free Software Foundation, either version 3 of the License, or
  13.     (at your option) any later version.
  14.  
  15.     TZipMaster is distributed in the hope that it will be useful,
  16.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  17.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18.     GNU Lesser General Public License for more details.
  19.  
  20.     You should have received a copy of the GNU Lesser General Public License
  21.     along with TZipMaster.  If not, see <http://www.gnu.org/licenses/>.
  22.  
  23.     contact: problems@delphizip.org (include ZipMaster in the subject).
  24.     updates: http://www.delphizip.org
  25.     DelphiZip maillist subscribe at http://www.freelists.org/list/delphizip
  26.  
  27.   modified 2008-08-28
  28. ---------------------------------------------------------------------------*)
  29. interface
  30. uses
  31.   Windows, SysUtils;
  32.            
  33. function FindLastW(const ws: widestring; const wc: widechar): integer;  
  34. function FindFirstW(const ws: widestring; const wc: widechar): integer;
  35. function ExtractFilePathW(const path: widestring): widestring;    
  36. function DelimitPathW(const Path: widestring; Sep: Boolean): widestring;
  37. function DirExistsW(const Fname: WideString): boolean;  
  38. function ForceDirectoryW(const Dir: widestring): boolean;  
  39. function FileCreateW(const fname: widestring): cardinal;
  40.  
  41. implementation
  42. uses
  43.   ZMStructs19;
  44.  
  45. function FindLastW(const ws: widestring; const wc: widechar): integer;
  46. var
  47.   i: integer;
  48. begin
  49.   Result := -1;
  50.   for i := 1 to Length(ws) - 1 do
  51.     if ws[i] = wc then
  52.     begin
  53.       Result := i;
  54.     end;
  55. end;
  56.  
  57. function FindFirstW(const ws: widestring; const wc: widechar): integer;
  58. begin
  59.   for Result := 1 to Length(ws) - 1 do
  60.     if ws[Result] = wc then
  61.       Exit;
  62.   Result := -1;
  63. end;
  64.  
  65. function ExtractFilePathW(const path: widestring): widestring;
  66. var
  67.   d, c: integer;
  68. begin
  69.   Result := '';
  70.   c := FindFirstW(path, ':');
  71.   d := FindLastW(path, PathDelim);
  72.   if (d > c) and (d >= 1) then
  73.     Result := Copy(path, 1, pred(d));
  74. end;
  75.  
  76. function DelimitPathW(const Path: widestring; Sep: Boolean): widestring;
  77. begin
  78.   Result := Path;
  79.   if Length(Path) = 0 then
  80.   begin
  81.     if Sep then
  82.       Result := PathDelim{'\'};
  83.     exit;
  84.   end;
  85. //  if (AnsiLastChar(Path)^ = PathDelim) <> Sep then
  86.   if (Path[Length(Path)] = PathDelim) <> Sep then
  87.   begin
  88.     if Sep then
  89.       Result := Path + PathDelim
  90.     else
  91.       Result := Copy(Path, 1, pred(Length(Path)));
  92.   end;
  93. end;
  94.  
  95. function DirExistsW(const Fname: WideString): boolean;
  96. var
  97.   Code: DWORD;
  98. begin
  99.   Result := True;                           // current directory exists
  100.  
  101.   if Fname <> '' then
  102.   begin
  103.     Code   := GetFileAttributesW(PWideChar(Fname));
  104.     Result := (Code <> MAX_UNSIGNED) and
  105.       ((FILE_ATTRIBUTE_DIRECTORY and Code) <> 0);
  106.   end;
  107. end;
  108.  
  109. function ForceDirectoryW(const Dir: widestring): boolean;
  110. var
  111.   sDir: widestring;
  112. begin
  113.   Result := True;
  114.   if Dir <> '' then
  115.   begin
  116.     sDir := DelimitPathW(Dir, False);
  117.     if DirExistsW(sDir) or (ExtractFilePathW(sDir) = sDir) then
  118.       exit;                                 // avoid 'c:\xyz:\' problem.
  119.  
  120.     if ForceDirectoryW(ExtractFilePathW(sDir)) then
  121.       Result := CreateDirectoryW(PWideChar(sDir), nil)
  122.     else
  123.       Result := False;
  124.   end;
  125. end;
  126.  
  127. function FileCreateW(const fname: widestring): cardinal;
  128. begin
  129.   Result := CreateFileW(pWideChar(fname), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
  130.     FILE_ATTRIBUTE_NORMAL, 0);
  131. end;
  132.  
  133. end.
  134.