www.pudn.com > virdisk_source.rar > main.pas
//破天惊工作室免费源代码:
// 虚拟分区
// V:1.0
//用到Flat系列控件
//作者:破天惊
//E-Mail:Tresss@sohu.com
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,StdCtrls, ExtCtrls, TFlatButtonUnit,shellapi,filectrl,
TFlatSpeedButtonUnit, TFlatEditUnit,registry;
type
Tmainform = class(TForm)
Label1: TLabel;
Label3: TLabel;
Label4: TLabel;
filebtn: TFlatButton;
drivebtn: TFlatButton;
startbtn: TFlatButton;
aboutbtn: TFlatButton;
aboutpanel: TPanel;
titlepanel: TPanel;
FlatButton1: TFlatButton;
Label2: TLabel;
Image1: TImage;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
maillab: TLabel;
Label10: TLabel;
startpanel: TPanel;
drivepanel: TPanel;
filepanel: TPanel;
Label9: TLabel;
fileedit: TFlatEdit;
selectfilebtn: TFlatSpeedButton;
Label11: TLabel;
drivecombox: TComboBox;
okstartbtn: TFlatButton;
okdelbtn: TFlatButton;
allstartbtn: TFlatButton;
alldelbtn: TFlatButton;
Label12: TLabel;
Label13: TLabel;
procedure FlatButton1Click(Sender: TObject);
procedure maillabClick(Sender: TObject);
procedure startbtnClick(Sender: TObject);
procedure selectfilebtnClick(Sender: TObject);
procedure filebtnClick(Sender: TObject);
procedure showyn;
procedure drivebtnClick(Sender: TObject);
procedure aboutbtnClick(Sender: TObject);
procedure okstartbtnClick(Sender: TObject);
procedure okdelbtnClick(Sender: TObject);
procedure allstartbtnClick(Sender: TObject);
procedure alldelbtnClick(Sender: TObject);
procedure titlepanelMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure titlepanelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure titlepanelMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
originalpos:tpoint;
currentpos:tpoint;
downpos:tpoint;
MouseLButtonDown:boolean; //用于无题窗口的拖放;
public
{ Public declarations }
end;
var
mainform: Tmainform;
implementation
{$R *.dfm}
//恢复各个panel的隐藏函数;
procedure tmainform.showyn;
begin
aboutpanel.visible:=false;
filepanel.visible:=false;
drivepanel.visible:=false;
startpanel.visible:=false;
end;
//关闭按钮
procedure Tmainform.FlatButton1Click(Sender: TObject);
begin
close;
end;
//在uses中加入shellapi,调用默认程序写E-Mail;
procedure Tmainform.maillabClick(Sender: TObject);
begin
shellexecute(handle,nil,pchar('mailto:tresss@sohu.com'),nil,nil,sw_shownormal);
end;
//生成虚拟盘选项.
procedure Tmainform.startbtnClick(Sender: TObject);
begin
showyn; //设置panel所有为隐藏;
startpanel.Visible:=true; //显示第三个panel;
drivebtn.Top:=49; //排列另外三个panel的位置;
startbtn.Top:=73;
aboutbtn.top:=318;
end;
procedure Tmainform.selectfilebtnClick(Sender: TObject);
var
dir:string;
begin
if selectdirectory('选择目录','',dir) then //在uses中加入filectrl.打开选择目录对话框;
fileedit.Text:=dir;
end;
//选择目录选项
procedure Tmainform.filebtnClick(Sender: TObject);
begin
showyn; //隐藏其它 panel;
filepanel.Visible:=true; //显示第一个panel;
drivebtn.Top:=270; //排列其它panel;
startbtn.Top:=294;
aboutbtn.top:=318;
end;
//选择生成盘选项;
procedure Tmainform.drivebtnClick(Sender: TObject);
begin
showyn; //隐藏其它panel;
drivepanel.Visible:=true; //显示第二个panel;
drivebtn.Top:=49; //排列其它panel;
startbtn.Top:=294;
aboutbtn.top:=318;
end;
//显示关于选项;
procedure Tmainform.aboutbtnClick(Sender: TObject);
begin
showyn; //隐藏其它panel;
aboutpanel.Visible:=true; //显示第四个panel;
drivebtn.Top:=49; //排列其它panel;
startbtn.Top:=73;
aboutbtn.top:=97;
end;
//按要求生成虚拟分区操作;
procedure Tmainform.okstartbtnClick(Sender: TObject);
var
st:string; //用于存放dos命令;
begin
if fileedit.text='' then //如果没有选择目录,则提示后退出;
begin
showmessage('请确定你选择了要虚拟的文件夹');
exit
end;
st:='/c subst '+drivecombox.text+' '+fileedit.text; //预置按要求生成虚拟盘所须的命令;
shellexecute(handle,'open',pchar('command.com'),pchar(st),nil,sw_hide); //uses中加入shellapi.调用dos命令;
end;
//按要求删除虚拟分区;
procedure Tmainform.okdelbtnClick(Sender: TObject);
var
st:string; //存放dos命令;
begin
st:='/c subst '+drivecombox.Text+' /d'; //预置要删除分区的dos命令;
shellexecute(handle,'open',pchar('command.com'),pchar(st),nil,sw_hide); //执行此dos命令;
end;
//建立一个永久存在的虚拟分区;实际是在注册表中写入dos命令;
procedure Tmainform.allstartbtnClick(Sender: TObject);
var
st:string; // 存放dos命令;
reg:tregistry; //用于操作注册表;
begin
if fileedit.text='' then // 检查是否设置目录;
begin
showmessage('请确定你选择了要虚拟的文件夹');
exit
end;
st:='subst '+drivecombox.text+' '+fileedit.text; // 按要求预置dos命令;
reg:=tregistry.Create; //初始化注册表项;
reg.RootKey:=hkey_local_machine; //主键;
reg.OpenKey('software\microsoft\windows\currentversion\run',true); //分键;
reg.WriteString('vir'+drivecombox.Text,st); //建立一个键,名为:'vir'加上要建立的分区的盘符.值为此dos命令;
reg.Free; //释放;
end;
//按要求删除建立的永久虚拟分区;
procedure Tmainform.alldelbtnClick(Sender: TObject);
var
reg:tregistry; //操作注册表;
st:string; //用于存放,注册表中的键名;
begin
st:='vir'+drivecombox.Text; //按照建立时的规则,存入注册表中应有的键名;
reg:=tregistry.create; //初始化注册表;
reg.RootKey:=hkey_local_machine; //设置主键
reg.OpenKey('software\microsoft\windows\currentversion\run',true); //分键;
reg.deletevalue(st); // 删除此键;
reg.Free; //释放注册表;
end;
//以下段代码用于拖放无标题窗口;
procedure Tmainform.titlepanelMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
if MouseLButtonDown = true then //如果左键已按下;
begin
CurrentPos.x := X; // 鼠标当前坐标;
CurrentPos.y := Y;
CurrentPos := ClientToScreen(CurrentPos); //窗口与桌面坐标的转换;
mainform.Left := OriginalPos.x + (CurrentPos.x - DownPos.x); //设置窗口当前应在的坐标;
mainform.Top := OriginalPos.y + (CurrentPos.y - DownPos.y);
end;
end;
procedure Tmainform.titlepanelMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
OriginalPos.x := mainform.Left; //此两句记住最初窗口坐标;
OriginalPos.y := mainform.Top;
DownPos.x := X; //记住当前鼠标坐标;
DownPos.y := Y;
DownPos := ClientToScreen(DownPos); //从窗口到桌面的坐标转换;
if Button = mbLeft then
MouseLButtonDown := true; //设置鼠标左键按下的标识;
end;
procedure Tmainform.titlepanelMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
MouseLButtonDown:=false; //取消鼠标左键按下的标识;
end;
end.