Unicode対応ExtractFileDrive

interface

function ExtractFileDriveW(sFile: WideString): WideString;


implementation
uses
  SysUtils;

function ExtractFileDriveW(sFile: WideString): WideString;
{
Unicode対応ExtractFileDrive。
'\\?\'に対応。
}
  function lfns_DriveGet(sDrive: WideString; iIndex: Integer): WideString;
  begin
    if (WideUpperCase(sDrive[iIndex])[1] in [WideChar('A')..WideChar('Z')]) then begin
      Result := Copy(sFile, iIndex, 2)
    end else begin
      Result := '';
    end;
  end;
  function lfns_UncGet(sDrive: WideString; iIndex, iLen: Integer): WideString;
  //UNC名を返す。
  var
    i: Integer;
    iServer: Integer;
  begin
    Result := '';
    i := iIndex;
    iServer := -1;
    while (i < iLen) do begin
      if (sDrive[i] = PathDelim) then begin
        if (i = iIndex) then begin
          Exit;  //サーバー名が''
        end else begin
          if (iServer <> -1) then begin
            if ((iServer + 1) = i) then begin
              Exit;  //共有フォルダ名が''
            end else begin
              Break;
            end;
          end else begin
            iServer := i;
          end;
        end;
      end;
      Inc(i);
    end;
    if (iServer <> -1) and (iServer < iLen) then begin
      if (sDrive[i] = PathDelim) then Dec(i);
      Result := Copy(sDrive, iIndex, i - iIndex + 1);
      if (Result <> '') then Result := '\\' + Result;
    end;
  end;
var
  li_Len: Integer;
begin
  Result := '';
  li_Len := Length(sFile);
  if (li_Len >= 2) then begin
    if (sFile[2] = DriveDelim) then begin
      //C:〜
      Result := lfns_DriveGet(sFile, 1);
    end else if (sFile[1] = PathDelim) and (sFile[2] = PathDelim) then begin
      if (li_Len >= 8) and (WideUpperCase(Copy(sFile, 1, 8)) = '\\?\UNC\') then begin
        //\\?\UNC\〜
        Result := lfns_UncGet(sFile, 9, li_Len);
      end else if (li_Len >= 3) and (sFile[3] = '?') then begin
        //\\?\〜
        if (li_Len >= 6) and (sFile[6] = DriveDelim) then begin
          Result := lfns_DriveGet(sFile, 5);
        end;
      end else begin
        //\\〜 UNC
        Result := lfns_UncGet(sFile, 3, li_Len);
      end;
    end;
  end;
end;

ls_Drive := ExtractFileDrive('1:\Abc.txt');  //ls_Drive は '1:'
ls_Drive := ExtractFileDriveW('1:\Abc.txt'); //ls_Drive は ''