Diskfree prevent message for cardreader

[alfware17]

Hallo I am using a loop for all my actual drives of the computer to simply find out whether they exist and have free space. (loop till 30 is enough).

Unfortunately this PC has a cardreader reserved but normally there is nothing in. Both Disksize(i) and Diskfree(i) crash on this drives and I get an not so nice message. The program runs on but I wanted to prevent the message. Has anybody an idea?   {$I-} and check IOResult doesn't help as far as I can see. It has result 0.

Here is my test-code:

Code: Pascal  [Select][+][-]

1. function GetAnzLW: integer;
2. var i, anz, df, ds: integer;
3.     iodisk: integer;
4.     home: string;
5. begin
6.    {$IFDEF LINUX}
7.    GetAnzLw:=1;
8.    {$ELSE}
9.    anz:=0;
10.    PROTO_HOME:=-1;
11.    for i:=0 to 30 do if (i<>1) and (i<>2) then begin
12.       Write('i=#',i,'#');
13.       GetDir(i, home);
14.       Write(' home=#',home,'#');       
15.  
16.       {$I-} ds:=Disksize(i); {$I+}
17.       iodisk:=IOResult;
18.       Write(' io=#',iodisk,'#');
19.       if iodisk<>0 then df:=-1;
20.       Write(' disksize=#', ds,'#');
21.  
22.       {$I-} df:=Diskfree(i); {$I+}
23.       iodisk:=IOResult;
24.       Write(' io=#',iodisk,'#');
25.       if iodisk<>0 then df:=-1;
26.       Write(' diskfree=#', df,'#');
27.  
28.       if df > 0 then begin
29.          if UpCase(home[1]) = UpCase(PROTO_VERZEICHNIS[1]) then
30.             if PROTO_HOME < 0 then PROTO_HOME:=i;
31.          if i > 0 then INC(anz);
32.       end;
33.       Writeln; 
34.    end;
35.    GetAnzLW:=anz;
36.    {$ENDIF}
37.  
38. end;

[engkin]

Can you post a screenshot for the message?

Diskfree uses GetDiskFreeSpaceExA or GetDiskFreeSpaceA

I wonder if you get any message if you use GetDiskFreeSpaceExA directly?

[Josh]

not sure, but could the error be due to diskfree returning an int64 value, and you vars are defined as integer (longint);

Function  DiskFree(drive: byte) : int64;
Function  DiskSize(drive: byte) : int64; 

maybe also for completeness change your i declaration to byte; so the types match exactly for the functions your using.


should getdir, also be inside {$I-}{$I+}; could this not fail?

[alfware17]

Hallo Josh,

here is my changed code

Code: Pascal  [Select][+][-]

1. function GetAnzLW: integer;
2. var i: byte;
3.     anz: integer;
4.     df, ds, dex, dexa: int64;
5.     iod, iof, ios, ioex, ioexa: integer;
6.     home: string;
7. begin
8.    {$IFDEF LINUX}
9.    GetAnzLw:=1;
10.    {$ELSE}
11.    anz:=0;
12.    PROTO_HOME:=-1;
13.    for i:=0 to 30 do if (i<>1) and (i<>2) then begin
14.       Write('i=#',i,'#');
15.       {$I-} GetDir(i, home); {$I+}
16.       iod:=IOResult;
17.       Write(' io=#',iod,'#');
18.       if iod<>0 then home:='';
19.       Write(' home=#',home,'#');       
20.      
21.       if iod=0 then begin
22.          {$I-} ds:=Disksize(i); {$I+}
23.          ios:=IOResult;
24.          Write(' io=#',ios,'#');
25.          if ios<>0 then df:=-1;
26.          Write(' disksize=#', ds,'#');
27.  
28.          {$I-} df:=Diskfree(i); {$I+}
29.          iof:=IOResult;
30.          Write(' io=#',iof,'#');
31.          if iof<>0 then df:=-1;
32.          Write(' diskfree=#', df,'#');
33.  
34.          if df > 0 then begin
35.             if UpCase(home[1]) = UpCase(PROTO_VERZEICHNIS[1]) then
36.               if PROTO_HOME < 0 then PROTO_HOME:=i;
37.             if i > 0 then INC(anz);
38.          end;
39.          Writeln;      
40.  
41.       end;
42.    end;
43.    Writeln('GetAnzLW=',anz);
44.    GetAnzLW:=anz;
45.    {$ENDIF}
46.  
47. end;
48.  

The IOResult is never not zero     Even not if the drive G and H doesn't really exist (see Screenshot my next post).
Shouldnt be there a function saying if a drive is valid...

[alfware17]

Hallo Engkin,

here is my error popup message...

it "crashes" at drive I  (and then again at J, K, L what is my builtin cardreader).  Unfortunately I also mentioned a wrong drive G and H that should not should not exist with getdir

The message (in German) is saying "no disc in drive".

This program is 32bit Free Pascal Windows - I just checked an older 16bit version virtual (Turbo Pascal), it simply ignores the I drive.


By the way. Can you please give an example of your functions?

"Diskfree uses GetDiskFreeSpaceExA or GetDiskFreeSpaceA"

I could not find in the Sysutils. Here is some from Stackoverflow...  Okay I could use my "home" String then but Free Pascal Compiler already missing the

GetDiskFreeSpaceA in any typo tries....

Code: Pascal  [Select][+][-]

1. program FreeDiskSpace;
2. {$APPTYPE CONSOLE}
3. uses
4.   SysUtils;
5.  
6. const
7.   Folder = 'C:\';
8.  
9. var
10.   FreeAvailable, TotalSpace: Int64;
11. begin
12.   (*GetDiskFreeSpaceA*)
13.   if SysUtils.GetDiskFreeSpaceA(PChar(Folder), FreeAvailable, TotalSpace, nil) then begin
14.     Writeln(TotalSpace div (1024*1024*1024), 'GB total');
15.     Writeln(FreeAvailable div (1024*1024*1024), 'GB free');
16.   end;
17. end.
18.  

[AlexTP]

SysUtils does not have GetDiskFreeSpace* !
The CudaText editor uses this code

Code: Pascal  [Select][+][-]

1. function AppDiskGetFreeSpace(const fn: string): Int64;
2. begin
3.   {$ifdef linux}
4.   //this crashes on FreeBSD 12 x64
5.   exit(SysUtils.DiskFree(SysUtils.AddDisk(ExtractFileDir(fn))));
6.   {$endif}
7.  
8.   {$ifdef windows}
9.   exit(SysUtils.DiskFree(SysUtils.GetDriveIDFromLetter(ExtractFileDrive(fn))));
10.   {$endif}
11.  
12.   //cannot detect
13.   exit(-1);
14. end;
15.  

[engkin]

1-This message is from the driver.
2-GetDiskFreeSpaceExA or GetDiskFreeSpaceA are in unit Windows. They both will give the same message due to 1
3-SysUtils.DiskFree will not help because it uses 2 as well

You should check the type of the drive first, and ignore it if it's removable.

GetDriveTypeA

[jamie]

This works in windows to get the drive letter names .

Code: Pascal  [Select][+][-]

1. procedure TForm1.Button1Click(Sender: TObject);
2. Var
3.   P:String;
4.   S,I:Integer;
5.   L:TStringList;
6. begin
7.   Memo1.Clear;
8.   S := GetLogicalDriveStrings(0,nil); //Get required character count;
9.   If S <> 0 then
10.    Begin
11.      SetLength(P,S+1);
12.      GetLogicalDriveStrings(S,PChar(P));
13.      L := TStringList.Create;
14.      L.Delimiter :=#0;
15.      L.DelimitedText := P;
16.      Memo1.Lines.Assign(L);
17.      L.Free;
18.    end;
19. end;                              
20.  
21.