cncommon.pas

delphi常用过程

  end;
begin
  AName := MakeDir(FileName);
  if (Length(AName) > 3) and (AName[2] = ':') then
  begin
    Result := '';
    while Length(AName) > 3 do
    begin
      FindName := DoFindFile(AName);

      if FindName = '' then
      begin
        Result := AName;
        Exit;
      end;

      if Result = '' then
        Result := FindName
      else
        Result := FindName + '\' + Result;

      AName := ExtractFileDir(AName);
    end;

    Result := UpperCase(AName) + Result;
  end
  else
    Result := AName;
end;

// 查找可执行文件的完整路径
function FindExecFile(const AName: string; var AFullName: string): Boolean;
var
  fn: array[0..MAX_PATH] of Char;
  pc: PChar;
begin
  if (0 = SearchPath(nil, PChar(AName), '.exe', SizeOf(fn), fn, pc)) and
     (0 = SearchPath(nil, PChar(AName), '.com', SizeOf(fn), fn, pc)) and
     (0 = SearchPath(nil, PChar(AName), '.bat', SizeOf(fn), fn, pc)) then
  begin
    Result := False;
  end
  else
  begin
    Result := True;
    AFullName := fn;
  end;
end;

function PidlFree(var IdList: PItemIdList): Boolean;
var
  Malloc: IMalloc;
begin
  Result := False;
  if IdList = nil then
    Result := True
  else
  begin
    if Succeeded(SHGetMalloc(Malloc)) and (Malloc.DidAlloc(IdList) > 0) then
    begin
      Malloc.Free(IdList);
      IdList := nil;
      Result := True;
    end;
  end;
end;

function PidlToPath(IdList: PItemIdList): string;
begin
  SetLength(Result, MAX_PATH);
  if SHGetPathFromIdList(IdList, PChar(Result)) then
    StrResetLength(Result)
  else
    Result := '';
end;

// 取得系统特殊文件夹位置，Folder 使用在 ShlObj 中定义的标识，如 CSIDL_DESKTOP
function GetSpecialFolderLocation(const Folder: Integer): string;
var
  FolderPidl: PItemIdList;
begin
  if Succeeded(SHGetSpecialFolderLocation(0, Folder, FolderPidl)) then
  begin
    Result := PidlToPath(FolderPidl);
    PidlFree(FolderPidl);
  end
  else
    Result := '';
end;

// 目录尾加'\'修正
function AddDirSuffix(const Dir: string): string;
begin
  Result := Trim(Dir);
  if Result = '' then Exit;
  if not IsPathDelimiter(Result, Length(Result)) then
    Result := Result + {$IFDEF MSWINDOWS} '\'; {$ELSE} '/'; {$ENDIF};
end;

// 目录尾加'\'修正
function MakePath(const Dir: string): string;
begin
  Result := AddDirSuffix(Dir);
end;

// 路径尾去掉 '\'
function MakeDir(const Path: string): string;
begin
  Result := Trim(Path);
  if Result = '' then Exit;
  if Result[Length(Result)] in ['/', '\'] then Delete(Result, Length(Result), 1);
end;

// 路径中的 '\' 转成 '/'
function GetUnixPath(const Path: string): string;
begin
  Result := StringReplace(Path, '\', '/', [rfReplaceAll]);
end;

// 路径中的 '/' 转成 '\'
function GetWinPath(const Path: string): string;
begin
  Result := StringReplace(Path, '/', '\', [rfReplaceAll]);
end;

function PointerXX(var X: PChar): PChar;
{$IFDEF PUREPASCAL}
begin
  Result := X;
  Inc(X);
end;
{$ELSE}
asm
  {
  EAX = X
  }
  MOV EDX, [EAX]
  INC dword ptr [EAX]
  MOV EAX, EDX
end;
{$ENDIF}

function Evaluate(var X: Char; const Value: Char): Char;
{$IFDEF PUREPASCAL}
begin
  X := Value;
  Result := X;
end;
{$ELSE}
asm
  {
  EAX = X
  EDX = Value (DL)
  }
  MOV [EAX], DL
  MOV AL, [EAX]
end;
{$ENDIF}

// 文件名是否与通配符匹配，返回值为0表示匹配
function FileNameMatch(Pattern, FileName: PChar): Integer;
var
  p, n: PChar;
  c: Char;
begin
  p := Pattern;
  n := FileName;

  while Evaluate(c, PointerXX(p)^) <> #0 do
  begin
	  case c of
		  '?': begin
          if n^ = '.' then
          begin
            while (p^ <> '.') and (p^ <> #0) do
            begin
              if (p^ <> '?') and (p^ <> '*') then
              begin
                Result := -1;
                Exit;
              end;
              Inc(p);
            end;
          end
          else
          begin
            if n^ <> #0 then
              Inc(n);
          end;
        end;

      '>': begin
          if n^ = '.' then
          begin
            if ((n + 1)^ = #0) and (FileNameMatch(p, n+1) = 0) then
            begin
              Result := 0;
              Exit;
            end;
            if FileNameMatch(p, n) = 0 then
            begin
              Result := 0;
              Exit;
            end;
            Result := -1;
            Exit;
          end;
          if n^ = #0 then
          begin
            Result := FileNameMatch(p, n);
            Exit;
          end;
          Inc(n);
        end;

      '*': begin
          while n^ <> #0 do
          begin
            if FileNameMatch(p, n) = 0 then
            begin
              Result := 0;
              Exit;
            end;
            Inc(n);
          end;
        end;

      '<': begin
          while n^ <> #0 do
          begin
				    if FileNameMatch(p, n) = 0 then
            begin
              Result := 0;
              Exit;
            end;
            if (n^ = '.') and (StrScan(n + 1, '.') = nil) then
            begin
              Inc(n);
              Break;
            end;
            Inc(n);
          end;
        end;

      '"': begin
          if (n^ = #0) and (FileNameMatch(p, n) = 0) then
          begin
            Result := 0;
            Exit;
          end;
          if n^ <> '.' then
          begin
            Result := -1;
            Exit;
          end;
          Inc(n);
        end;
    else
      if (c = '.') and (n^ = #0) then
      begin
        while p^ <> #0 do
        begin
          if (p^ = '*') and ((p + 1)^ = #0) then
          begin
            Result := 0;
            Exit;
          end;
          if p^ <> '?' then
          begin
            Result := -1;
            Exit;
          end;
          Inc(p);
        end;
        Result := 0;
        Exit;
			end;
      if c <> n^ then
      begin
        Result := -1;
        Exit;
      end;
      Inc(n);
    end;
  end;

  if n^ = #0 then
  begin
    Result := 0;
    Exit;
  end;

  Result := -1;
end;

// 文件名是否与扩展名通配符匹配
function MatchExt(const S, Ext: string): Boolean;
begin
  if S = '.*' then
  begin
    Result := True;
    Exit;
  end;

  Result := FileNameMatch(PChar(S), PChar(Ext)) = 0;
end;

// 文件名是否与通配符匹配
function MatchFileName(const S, FN: string): Boolean;
begin
  if S = '*.*' then
  begin
    Result := True;
    Exit;
  end;

  Result := FileNameMatch(PChar(S), PChar(FN)) = 0;
end;

// 得到大小写是否敏感的字符串
function _CaseSensitive(const CaseSensitive: Boolean; const S: string): string;
begin
  if CaseSensitive then
    Result := S
  else
    Result := AnsiUpperCase(S);
end;

// 转换扩展名通配符字符串为通配符列表
procedure FileExtsToStrings(const FileExts: string; ExtList: TStrings; CaseSensitive: Boolean);
var
  Exts: string;
  i: Integer;
begin
  Exts := StringReplace(FileExts, ';', ',', [rfReplaceAll]);
  ExtList.CommaText := Exts;

  for i := 0 to ExtList.Count - 1 do
  begin
    if StrScan(PChar(ExtList[i]), '.') <> nil then
    begin
      ExtList[i] := _CaseSensitive(CaseSensitive, ExtractFileExt(ExtList[i]));
    end
    else
    begin
      ExtList[i] := '.' + _CaseSensitive(CaseSensitive, ExtList[i]);
    end;
    if ExtList[i] = '.*' then
    begin
      if i > 0 then
        ExtList.Exchange(0, i);
      Exit;
    end;
  end;
end;

// 文件名是否匹配扩展名通配符
function FileMatchesExts(const FileName, FileExts: string; CaseSensitive: Boolean): Boolean;
var
  ExtList: TStrings;
  FExt: string;
  i: Integer;
begin
  ExtList := TStringList.Create;
  try
    FileExtsToStrings(FileExts, ExtList, CaseSensitive);

    FExt := _CaseSensitive(CaseSensitive, ExtractFileExt(FileName));
    Result := False;
    for i := 0 to ExtList.Count - 1 do
    begin
      if MatchExt(ExtList[i], FExt) then
      begin
        Result := True;
        Exit;
      end;
    end;
  finally
    ExtList.Free;
  end;
end;

// 文件名是否匹配扩展名通配符
function FileMatchesExts(const FileName: string; ExtList: TStrings): Boolean;
var
  FExt: string;
  i: Integer;
begin
  FExt := _CaseSensitive(False, ExtractFileExt(FileName));

  Result := False;
  for i := 0 to ExtList.Count - 1 do
  begin
    if MatchExt(ExtList[i], FExt) then
    begin
      Result := True;
      Exit;
    end;
  end;
end;

// 转换文件通配符字符串为通配符列表
procedure FileMasksToStrings(const FileMasks: string; MaskList: TStrings; CaseSensitive: Boolean);
var
  Exts: string;
  i: Integer;
begin
  Exts := StringReplace(FileMasks, ';', ',', [rfReplaceAll]);
  MaskList.CommaText := Exts;

  for i := 0 to MaskList.Count - 1 do
  begin
    if StrScan(PChar(MaskList[i]), '.') <> nil then
    begin
      if MaskList[i][1] = '.' then
        MaskList[i] := '*' + _CaseSensitive(CaseSensitive, MaskList[i])
      else
        MaskList[i] := _CaseSensitive(CaseSensitive, MaskList[i]);
    end
    else
    begin
      MaskList[i] := '*.' + _CaseSensitive(CaseSensitive, MaskList[i]);
    end;
    if MaskList[i] = '*.*' then
    begin
      if i > 0 then
        MaskList.Exchange(0, i);
      Exit;
    end;
  end;
end;

// 文件名是否匹配通配符
function FileMatchesMasks(const FileName, FileMasks: string; CaseSensitive: Boolean): Boolean;
var
  MaskList: TStrings;
  FFileName: string;
  i: Integer;
begin
  MaskList := TStringList.Create;
  try
    FileMasksToStrings(FileMasks, MaskList, CaseSensitive);

    FFileName := _CaseSensitive(CaseSensitive, ExtractFileName(FileName));
    Result := False;
    for i := 0 to MaskList.Count - 1 do
    begin
      if