很难很难的问题－虚似盘

Question

把一个文件夹模似成一个逻辑盘在我的电脑上显示，也是原来DOS下的SUBST.EXE程序的功能。用DELPHI如何实现？用DELPHI代码实现。  

Answer 1

以前帮同学做的:program MyDriver;{$APPTYPE CONSOLE}uses
  SysUtils,Windows;
type
  TAction=(aAdd,aResign,aRemove,aQuery);
var Action:TAction;
    Root:String;
    Driver:string;
    
  procedure ShowHelp;
  const
    HelpStrs:array[1..9] of String=
    (
    'drive [option] [root] [driver]',
    ' [Option] could be:',
    '   --add       add a driver',
    '   --reassign  modify a existing driver',
    '   --remove    remove a existing driver',
    ' [root] must be two character like C: D:',
    ' [driver] is a valid driver',
    '',
    ' Made by SoMaNyTiMeS(lex chou)'
    );
  var i:Integer;
  begin
    for i:=Low(HelpStrs) to High(HelpStrs) do
      Writeln(HelpStrs[i]);
    halt;
  end;
  procedure ShowError(const s:string);
  begin
    writeln('ERROR:'+s);
    halt;
  end;
  procedure AnalysisParameters;
  var Options:string;
  begin
    if not (ParamCount in [2,3]) then ShowHelp;
    Options:=ParamStr(1);
    if CompareText(Options,'--add')=0 then
      Action:=aAdd
    else
      if CompareText(Options,'--resign')=0 then
        Action:=aResign
      else
        if CompareText(Options,'--remove')=0 then
          Action:=aRemove
        else
          if CompareTExt(Options,'--query')=0 then
            Action:=aQuery
          else
            ShowError('Unrecognizable parameters!');
    Root:=ParamStr(2);
    if ParamCount=3 then
      Driver:=ParamStr(3)
    else
      Driver:='';
    if Length(Root)<>2 then ShowError('root must be two character');
    if (not (Root[1] in ['A'..'Z','a'..'z'])) or
       (root[2]<>':')  then
       ShowError('Invalid root format!');
    if Action in [aQuery,aRemove] then
    begin
      if ParamCount<>2 then
        ShowError('This operation require two parameters!')
    end
    else
      if (ParamCount<>3) or (length(ParamStr(3))=0) then
        ShowError('This operation require three parameters!');
    
  end;
  function QueryDriver(c:Char):string;
  var Buffer:array[1..200] of char;
  begin
    FillChar(Buffer,200,0);
    QueryDosDevice(PChar(String(c)+':'),PChar(@Buffer),200);
    Result:=StrPas(@Buffer);
  end;
  procedure AddDrive;
  begin
    DefineDosDevice(DDD_RAW_TARGET_PATH,PChar(Root),PChar(Driver));
  end;
  procedure Remove;
  begin
    if Length(QueryDriver(Root[1]))=0 then
      ShowError('Driver is not existing!');
    DefineDosDevice(DDD_RAW_TARGET_PATH,PChar(Root),'');
  end;
  procedure Resign;
  begin
    if Length(QueryDriver(Root[1]))=0 then
      ShowError('Driver is not existing!');
    AddDrive;    
  end;
  procedure DoAction;
  begin
    case Action of
      aAdd:AddDrive;
      aResign:Resign;
      aRemove:Remove;
      aQuery:writeln(QueryDriver(Root[1]));
    end;
  end;
begin
  { TODO -oUser -cConsole Main : Insert code here }
    AnalysisParameters;
    DoAction;end.

Answer 2

lexchow:在2000下不能用，只显示一下就不见了。

Answer 3

这是个控制台程序,你直接运行当然显示一下就不见了
后面要加参数,例如
mydriver /add z: c:\Windows

Answer 4

错了,是
mydriver --add z: c:\windows

Answer 5

制作一个封装的程序，内部执行SUBST命令就可以了

Answer 6

呵呵，代码要比调用DOS的好我觉的要能做一个大文件虚拟一个盘才是难的，要DDK才能做到

Answer 7

我QQ上一个叫WOWOCOCK的人就做了这么个东西,从文件虚拟成一个盘,写的驱动实现的

Answer 8

奇怪，我试过，加是加了，但无法访问！
我是 win2003

Answer 9

用楼上的，如不行，参考这个http://borland.mblogger.cn/aiirii/posts/4403.aspx

Answer 10

我试了，盘图标显示一下就没有了。无法访问。
我的是win2000

Answer 11

Linux下
mount -o loop 文件 /mnt/file
访问/mnt/file就可以修改此文件

Answer 12

8好意思~~用这种方法:mydriver --add z: \Device\HarddiskVolume1\Downloads\Device\HarddiskVolume1 <--设备驱动
相应得还有
\Device\Cdrom1
等.可以通过 --query 参数查询

Answer 13

>>我试了，盘图标显示一下就没有了。无法访问。
為什麼不看看我的鏈接??
其實用的函數是一樣的, 只不過處理有點不同而已

Answer 14

aiirii(ari-爱的眼睛):
你的连接？我没有找到这方面内容啊。

Answer 15

你那个连接里用到了 VxDCall,会不会只能运行于9x下?

Answer 16

http://borland.mblogger.cn/aiirii/posts/4403.aspx
我找不到相关的内容啊。请指点。谢谢！

Answer 17

呵呵，是我的网络速度太慢，等一下才出来。
这个我早就用了，运行WIN9X，2000，XP
能控制读写