F i l e Ti m e To D o s D a t e Ti m e ( l f t , L o n g R e c ( d f t ) . H i , L o n g R e c ( d f t ) . L o ) ;
/ /最后,转换D O S t i m e格式成为D e l p h i ' s应用的T d a t e Ti m e格式
R e s u l t : = F i l e D a t e To D a t e Ti m e ( d f t ) ;
e n d
e l s e
r e s u l t : = 0 ;
5) 添加三个按钮的O n C l i c k事件的处理过程如下:
procedure TForm1.Button1Click(Sender: TO b j e c t ) ;
b e g i n
// 获取文件创建时间
E d i t 2 . Te x t : = D a t e To S t r ( F G e t F i l e Ti m e ( E d i t 1 . Te x t , 0 ) ) ;
e n d ;
procedure TForm1.Button2Click(Sender: TO b j e c t ) ;
b e g i n
// 获取文件更改时间
E d i t 3 . Te x t : = D a t e To S t r ( F G e t F i l e Ti m e ( E d i t 1 . Te x t , 1 ) ) ;
e n d ;
procedure TForm1.Button3Click(Sender: TO b j e c t ) ;
b e g i n
// 获取最后访问时间
E d i t 4 . Te x t : = D a t e To S t r ( F G e t F i l e Ti m e ( E d i t 1 . Te x t , 2 ) ) ;
e n d ;
6) 编译、链接和运行程序,测试效果。
6.5.5 检测软盘或光盘是否有变化
一般情况下,不同的软盘具有不同的卷号( Vo l u m e ),可以通过测试软盘驱动器中软盘的卷
号是否变化来确定软盘是否切换过,同样对光盘也适用。
可以使用Windows API函数G e t Vo l u m e I n f o r m a t i o n来获取软盘、硬盘和光盘的卷号。
例程S6_8 该例程(运行结果如图6 - 8所示)对获取软盘、硬盘和光盘的卷号进行了说明。
1) 通过菜单File | New Application创建一个新的工程。
2) 参考图6 - 8在窗体F o r m 1中添加两个L a b e l组件、一个C o m b o B o x组件和一个E d i t组件。将
C o m b o B o x组件的I t e m s属性设置为“A : <回车>C: <回车>D: <回车> E :”。
3) 在T F o r m 1的定义中增加一个新的函数声明,该函数用来获取某一个驱动器中盘片的卷
号信息,具体如下:
t y p e
TForm1 = class(TForm)
. . .
p r i v a t e
{ Private declarations }
Function GetDiskVo l S e r i a l I D ( D r i v e N a m e : s t r i n g ) : D Wo r d ;
p u b l i c
. . .
4) 函数G e t D i s k Vo l S e r i a l I D的定义体如下:
function TForm1.GetDiskVolSerialID(DriveName: string): DWo r d ;
v a r
d w Te m p 1 , d w Te m p 2 : D Wo r d ;
N R e s u l t : P D Wo r d ;
b e g i n
n e w ( N R e s u l t ) ;
G e t Vo l u m e I n f o r m a t i o n ( p C h a r ( D r i v e N a m e + ' \ ' ) ,
N i l ,
0 ,
N R e s u l t ,
d w Te m p 1 ,
d w Te m p 2 ,
N i l , 0 ) ;
R e s u l t : = N R e s u l t ^ ;
D i s p o s e ( N R e s u l t ) ;
e n d ;
5) 在ComboBox组件的OnChange事件的处理过程中调用GetDiskVolSerialID函数。具体如下:
procedure TForm1.ComboBox1Change(Sender: TO b j e c t ) ;
b e g i n
// 获取卷号信息
E d i t 1 . Te x t : = I n t To S t r ( G e t D i s k Vo l S e r i a l I D ( C o m b o B o x 1 . I t e m s [ C o m b o B o x 1 . I t e m I n d e x ] ) ) ;
e n d ;
6) 编译、链接和运行程序,测试效果。可以在软盘驱动器中更换软盘,然后在C o m b o B o x
组件中重新选择“ A :”测试效果。
6.5.6 检测驱动器容量
通过Windows API函数G e t D i s k F r e e S p a c e可以获得驱动器中盘片的容量大小和剩余容量大
小的信息。
下面在例程S 6 _ 8的基础上,进一步获取驱动器中盘片的容量大小和剩余容量的大小。具体
如下:
1) 在例程S 6 _ 8的窗体中添加两个E d i t组件和两个L a b e l组
件,如图6 - 9所示。
2) 改写C o m b o B o x的O n C h a n g e事件的处理过程如下:
procedure TForm1.ComboBox1Change(Sender: TO b j e c t ) ;
v a r
sec1, byt1, cl1, cl2:longword;
b e g i n
// 获取卷号信息
E d i t 1 . Te x t : = I n t To S t r ( G e t D i s k Vo l S e r i a l I D ( C o m b o B o x 1 . I t e m s [ C o m b o B o x 1 . I t e m I n d e x ] ) ) ;
// 获取容量信息
GetDiskFreeSpace(PChar(ComboBox1.Items[ComboBox1.ItemIndex]), sec1, byt1, cl1, cl2);
cl1 := cl1 * sec1 * byt1;
cl2 := cl2 * sec1 * byt1;
E d i t 2 . Text:= FormatFloat('###,##0',cl2);
E d i t 3 . Text:= FormatFloat('###,##0',cl1);
e n d ;
第6章章文件、目录和驱动器章名151
图6-9 例程S6_8修改过后的
运行结果界面
/ /最后,转换D O S t i m e格式成为D e l p h i ' s应用的T d a t e Ti m e格式
R e s u l t : = F i l e D a t e To D a t e Ti m e ( d f t ) ;
e n d
e l s e
r e s u l t : = 0 ;
5) 添加三个按钮的O n C l i c k事件的处理过程如下:
procedure TForm1.Button1Click(Sender: TO b j e c t ) ;
b e g i n
// 获取文件创建时间
E d i t 2 . Te x t : = D a t e To S t r ( F G e t F i l e Ti m e ( E d i t 1 . Te x t , 0 ) ) ;
e n d ;
procedure TForm1.Button2Click(Sender: TO b j e c t ) ;
b e g i n
// 获取文件更改时间
E d i t 3 . Te x t : = D a t e To S t r ( F G e t F i l e Ti m e ( E d i t 1 . Te x t , 1 ) ) ;
e n d ;
procedure TForm1.Button3Click(Sender: TO b j e c t ) ;
b e g i n
// 获取最后访问时间
E d i t 4 . Te x t : = D a t e To S t r ( F G e t F i l e Ti m e ( E d i t 1 . Te x t , 2 ) ) ;
e n d ;
6) 编译、链接和运行程序,测试效果。
6.5.5 检测软盘或光盘是否有变化
一般情况下,不同的软盘具有不同的卷号( Vo l u m e ),可以通过测试软盘驱动器中软盘的卷
号是否变化来确定软盘是否切换过,同样对光盘也适用。
可以使用Windows API函数G e t Vo l u m e I n f o r m a t i o n来获取软盘、硬盘和光盘的卷号。
例程S6_8 该例程(运行结果如图6 - 8所示)对获取软盘、硬盘和光盘的卷号进行了说明。
1) 通过菜单File | New Application创建一个新的工程。
2) 参考图6 - 8在窗体F o r m 1中添加两个L a b e l组件、一个C o m b o B o x组件和一个E d i t组件。将
C o m b o B o x组件的I t e m s属性设置为“A : <回车>C: <回车>D: <回车> E :”。
3) 在T F o r m 1的定义中增加一个新的函数声明,该函数用来获取某一个驱动器中盘片的卷
号信息,具体如下:
t y p e
TForm1 = class(TForm)
. . .
p r i v a t e
{ Private declarations }
Function GetDiskVo l S e r i a l I D ( D r i v e N a m e : s t r i n g ) : D Wo r d ;
p u b l i c
. . .
4) 函数G e t D i s k Vo l S e r i a l I D的定义体如下:
function TForm1.GetDiskVolSerialID(DriveName: string): DWo r d ;
v a r
d w Te m p 1 , d w Te m p 2 : D Wo r d ;
N R e s u l t : P D Wo r d ;
b e g i n
n e w ( N R e s u l t ) ;
G e t Vo l u m e I n f o r m a t i o n ( p C h a r ( D r i v e N a m e + ' \ ' ) ,
N i l ,
0 ,
N R e s u l t ,
d w Te m p 1 ,
d w Te m p 2 ,
N i l , 0 ) ;
R e s u l t : = N R e s u l t ^ ;
D i s p o s e ( N R e s u l t ) ;
e n d ;
5) 在ComboBox组件的OnChange事件的处理过程中调用GetDiskVolSerialID函数。具体如下:
procedure TForm1.ComboBox1Change(Sender: TO b j e c t ) ;
b e g i n
// 获取卷号信息
E d i t 1 . Te x t : = I n t To S t r ( G e t D i s k Vo l S e r i a l I D ( C o m b o B o x 1 . I t e m s [ C o m b o B o x 1 . I t e m I n d e x ] ) ) ;
e n d ;
6) 编译、链接和运行程序,测试效果。可以在软盘驱动器中更换软盘,然后在C o m b o B o x
组件中重新选择“ A :”测试效果。
6.5.6 检测驱动器容量
通过Windows API函数G e t D i s k F r e e S p a c e可以获得驱动器中盘片的容量大小和剩余容量大
小的信息。
下面在例程S 6 _ 8的基础上,进一步获取驱动器中盘片的容量大小和剩余容量的大小。具体
如下:
1) 在例程S 6 _ 8的窗体中添加两个E d i t组件和两个L a b e l组
件,如图6 - 9所示。
2) 改写C o m b o B o x的O n C h a n g e事件的处理过程如下:
procedure TForm1.ComboBox1Change(Sender: TO b j e c t ) ;
v a r
sec1, byt1, cl1, cl2:longword;
b e g i n
// 获取卷号信息
E d i t 1 . Te x t : = I n t To S t r ( G e t D i s k Vo l S e r i a l I D ( C o m b o B o x 1 . I t e m s [ C o m b o B o x 1 . I t e m I n d e x ] ) ) ;
// 获取容量信息
GetDiskFreeSpace(PChar(ComboBox1.Items[ComboBox1.ItemIndex]), sec1, byt1, cl1, cl2);
cl1 := cl1 * sec1 * byt1;
cl2 := cl2 * sec1 * byt1;
E d i t 2 . Text:= FormatFloat('###,##0',cl2);
E d i t 3 . Text:= FormatFloat('###,##0',cl1);
e n d ;
第6章章文件、目录和驱动器章名151
图6-9 例程S6_8修改过后的
运行结果界面
//////////////CDRom Utils//////////////////////
//获得CDRom 序列号
function GetdiskserilNum(ADrive: string): string;
//获得CDRom卷标,返回''表示驱动器中没有光盘
function GetCDRomLabel(ADrive: string): string;
//获得第一个CDRom,返回''表示驱动器中没有光盘
function GetFirstCDROM: ShortString;
//获得系统驱动器列表
procedure Getdisks(Strings: TStringList);
//打开光驱
procedure OpenCDRom;
//关闭光驱
procedure CloseCDRom;
//切换光驱自动运行功能,设置在Windows重新启动后将生效
procedure SetCDRomAutoRun(AutoRun:Boolean);implementationuses Windows, MMSystem;
//////////////CDRom Utils////////////////////////////function GetdiskserilNum(ADrive: string): string;
var
VolumeName : array[0..255] of char;
FileSystemType : array[0..255] of char;
SerialNum : DWORD;
MaxFilenameLength : DWORD;
Flags : DWORD;
begin
if (GetVolumeInformation(PChar(ADrive),
VolumeName,
256,
@SerialNum,
MaxFilenameLength,
Flags,
FileSystemType,
256)) then
Result := (IntToHex(SerialNum shr 16, 3) +
IntToHex((SerialNum shl 16) shr 16, 4));
end;function GetCDRomLabel(ADrive: string): string;
var
VolumeName : array[0..255] of char;
FileSystemType : array[0..255] of char;
SerialNum : DWORD;
MaxFilenameLength : DWORD;
Flags : DWORD;
begin
//Result := '驱动器中没有CDRom';
if (GetVolumeInformation(PChar(ADrive),
VolumeName,
256,
@SerialNum,
MaxFilenameLength,
Flags,
FileSystemType,
256)) then
Result := VolumeName;
end;function GetFirstCDROM: Shortstring;
var
AList : TStringList;
Counter : integer;
begin
//Result := '驱动器里无CDRom';
AList := TStringList.Create;
Getdisks(AList);
for Counter := 0 to AList.Count-1 do
if GetDriveType(PChar(Alist.Strings[Counter])) = DRIVE_CDROM then
Result := Alist.Strings[Counter]
end;procedure Getdisks(Strings: TStringList);
const BufSize = 256;
var
Buffer : PChar;
P : PChar;
begin
GetMem(Buffer, BufSize);
try
Strings.BeginUpdate;
try
Strings.Clear;
if GetLogicalDriveStrings(BufSize, Buffer) <> 0 then begin
P := Buffer;
while P^ <> #0 do begin
Strings.Add(P);
Inc(P, StrLen(P) + 1);
end;
end;
finally
Strings.EndUpdate;
end;
finally
FreeMem(Buffer, BufSize);
end;
end;procedure OpenCDRom;
begin
mciSendString('Set cdaudio door open wait', nil, 0, 0);//handle);
end;procedure CloseCDRom;
begin
mciSendString('Set cdaudio door closed wait', nil, 0, 0);//handle);
end;procedure SetCDRomAutoRun(AutoRun:Boolean);
const
DoAutoRun : array[Boolean] of Integer = (0,1);
var
Reg:TRegistry;
begin
try
Reg := TRegistry.Create;
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.KeyExists('System\CurrentControlSet\Services\Class\CDROM') then
if Reg.OpenKey('System\CurrentControlSet\Services\Class\CDROM',FALSE) then
Reg.WriteBinaryData('AutoRun',DoAutoRun[AAutoRun],1);
finally
Reg.Free;
end;
//设置在Windows重新启动后将生效
end;end.