تقریبا کلیه فانکشن هایی که برای کار با فلاپی نیاز میشه ...
سلام خدمت همه دوستان
این مطلب رو توی یکی از انجمن ها پیدا کردم گفتم اینجا هم بذاریم شاید بچه ها استفاده کنن.
ضمن تشکر از delphi_baz عزیز که این مطلب را نوشته بود.
کد:
unit lDrives;
interface
uses Forms, Messages, Classes, WinProcs, WinTypes, SysUtils,
Dialogs, Controls;
const
MsgAskDefault = 'Please insert a disk on drive %s:';
MsgWProtected = 'Error: The disk %s is write-protected.';
type
TDriveType = (dtAll,dtFixed,dtRemovable,dtRemote{$IFDEF WIN32},dtCDRom,dtRamDisk{$ENDIF});
function ComposeFileName (Dir,Name:string):string;
function HasDiskSpace({$IFDEF WIN32}Drive: string{$ELSE}Drive: char{$ENDIF}; MinRequired: LongInt): boolean;
function GetDirectorySize(const Path: string): LongInt;
function GetFileSizeByName(const Filename: string): longInt;
function IsDiskRemovable(Drive: char): boolean;
function IsDiskInDrive(Drive: char): boolean;
function IsDiskWriteProtected(Drive: char): boolean;
function AskForDisk(Drive: char; Msg: string; CheckWriteProtected: boolean): boolean;
procedure GetAvailableDrives(DriveType: TDriveType; Items: TStrings);
implementation function ComposeFileName (Dir,Name:string):string;
var
Separator: string[1];
begin
if (length(Dir) > 0) and (Dir[length(Dir)]='\') then
delete(Dir, length(Dir), 1);
if (length(Name) > 0) and (Name[1]='\') then
delete(Name, 1, 1);
if Name='' then Separator:='' else Separator:='\';
result:=format('%s%s%s',[Dir,Separator,Name]);
end;
function HasDiskSpace(Drive: {$IFDEF WIN32}string{$ELSE}char{$ENDIF}; MinRequired: LongInt): boolean;
begin
if Drive='' then Drive:='C';
{$IFDEF WIN32}
result:=((GetDriveType(PChar(Drive))<>0) and
(SysUtils.DiskFree(Ord(UpCase(Drive[1]))-$40)=-1) or
(SysUtils.DiskFree(Ord(UpCase(Drive[1]))-$40)>=MinRequired));
{$ELSE}
result:=((GetDriveType(Ord(UpCase(Drive))-$40)<>0) and
(DiskFree(Ord(UpCase(Drive))-$40)=-1) or
(DiskFree(Ord(UpCase(Drive))-$40)>=MinRequired));
{$ENDIF}
end;
function GetDirectorySize(const Path: string): LongInt;
var
S: TSearchRec;
TotalSize: LongInt;
begin
TotalSize:=0;
if FindFirst(ComposeFileName(Path,'*.*'), faAnyFile, S)=0 then
repeat
Inc(TotalSize, S.Size);
until FindNext(S)<>0;
result:=TotalSize;
end;
function GetFileSizeByName(const Filename: string): longInt;
var
F: File;
begin
AssignFile(F, Filename);
Reset(F,1);
result:=FileSize(F);
CloseFile(F);
end;
function IsDiskRemovable(Drive: char): boolean;
begin
{$IFDEF WIN32}
result:=GetDriveType(PChar(Drive+':\'))=DRIVE_REMOVABLE;
{$ELSE}
result:=GetDriveType(ord(UpCase(Drive))-65)=DRIVE_REMOVABLE;
{$ENDIF}
end;
function IsDiskInDrive(Drive: char): Boolean;
var
ErrorMode: word;
begin
Drive:=Upcase(Drive);
if not (Drive in ['A'..'Z']) then
begin
Result:=False;
Exit;
end;
ErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
try
if DiskSize(Ord(Drive) - 64) = -1 then
Result := False
else
Result := True;
finally
SetErrorMode(ErrorMode);
end;
end;
function IsDiskWriteProtected(Drive: char): Boolean;
var
F: File;
ErrorMode: Word;
begin
ErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
AssignFile(F,Drive+':\_$.$ );
try
try
Rewrite(F);
CloseFile(F);
Erase(F);
Result:=False;
except
Result:=True;
end;
finally
SetErrorMode(ErrorMode);
end;
end;
{$IFDEF WIN32}
procedure GetAvailableDrives(DriveType: TDriveType; Items: TStrings);
var
Drive: Integer;
DriveLetter: string;
begin
Items.Clear;
for Drive := 0 to 25 do
begin
DriveLetter := Chr(Drive + ord('A'))+':\';
case DriveType of
dtAll : if GetDriveType(PChar(DriveLetter)) in [DRIVE_REMOVABLE,DRIVE_FIXED,DRIVE_REMOTE,
DRIVE_CDROM,DRIVE_RAMDISK] then
Items.Add(DriveLetter);
dtRemovable: if GetDriveType(PChar(DriveLetter))=DRIVE_REMOVABLE then
Items.Add(DriveLetter);
dtFixed : if GetDriveType(PChar(DriveLetter))=DRIVE_FIXED then
Items.Add(DriveLetter);
dtRemote : if GetDriveType(PChar(DriveLetter))=DRIVE_REMOTE then
Items.Add(DriveLetter);
dtCDRom : if GetDriveType(PChar(DriveLetter))=DRIVE_CDROM then
Items.Add(DriveLetter);
dtRamDisk : if GetDriveType(PChar(DriveLetter))=DRIVE_RAMDISK then
Items.Add(DriveLetter);
end;
end;
end;
{$ELSE}
procedure GetAvailableDrives(DriveType: TDriveType; Items: TStrings);
var
Drive: Integer;
DriveLetter: char;
begin
Items.Clear;
for Drive := 0 to 25 do
begin
DriveLetter := Chr(Drive + ord('A'));
case DriveType of
dtAll : if GetDriveType(Drive) in [DRIVE_REMOVABLE,DRIVE_FIXED,DRIVE_REMOTE] then
Items.Add(DriveLetter+':\');
dtRemovable: if GetDriveType(Drive)=DRIVE_REMOVABLE then
Items.Add(DriveLetter+':\');
dtFixed : if GetDriveType(Drive)=DRIVE_FIXED then
Items.Add(DriveLetter+':\');
dtRemote : if GetDriveType(Drive)=DRIVE_REMOTE then
Items.Add(DriveLetter+':\');
end;
end;
end;
{$ENDIF}
function AskForDisk(Drive: char; Msg: string; CheckWriteProtected: boolean): boolean;
var
Ready : boolean;
begin
Ready:=false; Result:=false;
if Msg='' then Msg:=Format(MsgAskDefault,[Drive]);
while not(Ready) do
try
if IsDiskRemovable(Drive) then
case MessageDlg(Msg, mtConfirmation, [mbOk,mbCancel],0) of
mrOk : ready:=IsDiskInDrive(Drive);
mrCancel: exit;
end
else
Ready:=true;
except
result:=false;
exit;
end;
ready:=false;
while not(Ready) do
try
if CheckWriteProtected and IsDiskWriteProtected(Drive) then
begin
ready:=false;
if MessageDlg(Format(MsgWProtected,[Upcase(Drive)+':']),mtError,[mbRetry,mbCancel],0)=mrCancel then
exit;
end
else
ready:=true;
except
result:=false;
exit;
end;
result:=Ready;
end;
end.