[Delphi]建立SUBST驱动器的单元代码

unit uSUBST;

interface

uses
  SysUtils, Windows;

function SUBST_Create(ADrv: Char; const APath: string): Boolean;
function SUBST_Remove(ADrv: Char): Boolean;
function SUBST_Query(ADrv: Char): string;

implementation

{$WARN SYMBOL_PLATFORM OFF} // 屏蔽"平台相关"的警告信息
procedure VxDCall; external Kernel32 index 1;
{$WARN SYMBOL_PLATFORM ON}  // 重新打开警告信息

function SUBST_Create(ADrv: Char; const APath: string): Boolean;
var
  byDrvNo: Byte;
  szBuff: array[0..256] of Char;
  sPath: string;
begin
  // 指定的目录必须已经存在, 否则失败退出
  if not DirectoryExists(APath) then
  begin
    Result := False;
    Exit;
  end;

  // 假如路径为x:\yyy\, 则将路径转换成x:\yyy
  if (Length(APath) > 3) and (APath[Length(APath)] = '\') then
    sPath := Copy(APath, 1, Length(APath) - 1)
  // 假如路径为x:, 则将路径转换成x:\
  else if(APath[Length(APath)] = ':') then
    sPath := sPath + '\'
  else  // 否则, 路径保持原样不变
    sPath := APath;

  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    szBuff[0] := ADrv;
    szBuff[1] := ':';
    szBuff[2] := #0;
    Result := DefineDosDevice(0, szBuff, PChar(sPath));
  end
  else begin
    sPath := ExtractShortPathName(sPath);
    if sPath <> '' then
    begin
      byDrvNo := Ord(UpperCase(ADrv)[1]) - Ord('A');
      StrPCopy(szBuff, sPath);
      asm
        pushad
        push es
        xor  ebx, ebx
        mov  bh, 0
        mov  bl, byDrvNo
        lea  edx, szBuff
        push 0  // ECX(unused)
        push 71AAh
        push 2A0010h
        call VxDCall
        pop  es
        popad
      end;
    end;
    Result := (AnsiUpperCase(SUBST_Query(ADrv)) = AnsiUpperCase(sPath));
  end;
end;

function SUBST_Remove(ADrv: Char): Boolean;
var
  byDrvNo: Byte;
  sDrive, sPath: string;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    SetLength(sDrive, 3);
    sDrive[1] := ADrv;
    sDrive[2] := ':';
    sDrive[3] := #0;
    sPath := SUBST_Query(ADrv);
    Result := DefineDosDevice(DDD_REMOVE_DEFINITION, PChar(sDrive),
      PChar(sPath));
  end
  else begin
    byDrvNo := Ord(UpperCase(ADrv)[1]) - Ord('A');
    asm
      pushad
      push es
      xor  ebx, ebx
      mov  bh, 1
      mov  bl, byDrvNo
      push 0  // ecx(unused)
      push 71AAh
      push 2A00A0h
      call VxDCall
      pop  es
      popad
    end;
    Result := SUBST_Query(ADrv) = '';
  end;
end;

function SUBST_Query(ADrv: Char): string;
var
  byDrvNo: Byte;  // 盘符ADrv所对应的驱动器序号
  szBuff: array[0..256] of Char;
  szPath: array[0..256] of Char;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    szBuff[0] := ADrv;
    szBuff[1] := ':';
    szBuff[2] := #0;
    szPath[0] := #0;
    QueryDosDevice(szBuff, szPath, 256);
    Result := StrPas(szPath);
    if Copy(Result, 1, 4) = '\??\' then
      Result := Copy(Result, 5, Length(Result))
    else
      Result := '';
  end
  else begin
    byDrvNo := Ord(UpperCase(ADrv)[1]) - Ord('A');
    szPath[0] := #0;
    asm //获得subst驱动器对应的文件夹的路径
      pushad
      push es
      xor  ebx, ebx
      mov  bh, 2
      mov  bl, byDrvNo
      lea  edx, szPath
      push 0  // ecx(unused)
      push 71AAh
      push 2A0010h
      call VxDCall
      pop  es
      popad
    end;
    Result := StrPas(szPath);
    if Result = '' then Exit;
    asm // 将获得的路径转换成长路径形式
      pushad
      push ds
      push es
      xor  ebx, ebx
      lea  esi, szPath
      lea  edi, szBuff
      mov  ecx, 0
      mov  cl, 2
      mov  ch, 0
      push ecx
      push 7160h
      push 2A0010H
      call VxDCall
      pop  es
      pop  ds
      popad
    end;
    Result := StrPas(szBuff);
  end;
end;

end.