 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
ytwinky
Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch
|
 Verfasst am: 05.08.2006, 20:15 Titel: DiskSize und DiskFree (mit -lang deprecated kompilieren..) |
 |
|
Hi,
ob eine Diskette im Laufwerk ist, kann ich immer noch nicht herausfinden 
Ich habe es mit der Größe probiert, aber da kommt auch dieser 'blöde' Dialog,
wenn keine Disk im Laufwerk ist..
So habe ich aber nicht nur DiskSize.Bas endlich fertig, sondern auch die
Function GB(..)(die ja eigentlich TB(..) heißen müßte, aber seis drum). | Code: |
'Ä=Ž , Ö=™ , Ü=š ; ä=„ , ö=”, ü=? , ß=á ,§=õ , ©=¸
Option Escape
Option Explicit
Declare Function CheckDrive(byVal Lw As String)
Declare Function GB(FileSize As Single, Index=0) As String
Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA"_
(ByVal lpRootPathName As String,_
lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long,_
lpTotalNumberOfClusters As Long) As Long
Const Esc="\27"
Dim Lw As String, SpCl, bps, FreeCl, TotCl
Dim As Single Faktor, DiskFree, DiskTotal
Cls
?"DiskSize.Bas ©2006 by ytwinky, MD"
Do
?"Welches Laufwerk pr?fen(A..Z, Esc=Beenden):";
Do
Lw=UCase(Inkey$)
Sleep 1
Loop Until Instr("ABCDEFGHIJKLMNOPQRSTUVWXYZ" &Esc, Lw)
If Lw<>Esc Then
?Lw
Lw+=":"
?"Laufwerk " &Lw;
If GetDiskFreeSpace(Lw, SpCl, bps, FreeCl, TotCl)=0 Then
?" gibs nich.."
Else
?
?"Sektoren pro Cluster.." &SpCl
?"Bytes pro Sektor......" & bps
?"GesamtCluster........." &TotCl
?"Freie Cluster........." &FreeCl
Faktor=SpCl*bps
DiskTotal=TotCl*Faktor
?"DiskTotal............." &GB(DiskTotal)
DiskFree=FreeCl*Faktor
?"DiskFrei.............." &GB(DiskFree)
End If
End If
Loop Until Lw=Esc
End
Function GB(FileSize As Single, Index=0) As String ' ©2006 by ytwinky, MD
Dim StrDim(5) As ZString Ptr={@" byte", @" KB", @"MB", @" GB", @" TB"}
If FileSize>1023 And (Index+1)<UBound(StrDim) Then Return GB(FileSize/1024, Index+1)
Function=FileSize &*StrDim(Index)
End Function
Function CheckDrive(byVal Lw As String)
Dim i, cd$=CurDir$
i=ChDir(Lw &"\\")
Return i=0
End Function |
Ich denke, wenn die 'Beschränkung' auf TeraByte störend wird, gibt es andere
Probleme als dieses 
Vielleicht kanns ja einer gebrauchen..
Gruß
ytwinky
_________________
| v1ctor hat Folgendes geschrieben: | | Yeah, i like INPUT$(n) as much as PRINT USING.. |
..also ungefähr so, wie ich GOTO..
Zuletzt bearbeitet von ytwinky am 15.08.2007, 19:36, insgesamt einmal bearbeitet |
|
| Nach oben |
|
 |
stuner
Anmeldungsdatum: 29.06.2006
Beiträge: 45
|
| Verfasst am: 07.08.2006, 14:39 Titel: Re: DiskSize und DiskFree |
|
|
| ytwinky hat Folgendes geschrieben: | Ich denke, wenn die 'Beschränkung' auf TeraByte störend wird, gibt es andere
Probleme als dieses
|
Na dann kann ich nicht gebrauchen....  |
|
| Nach oben |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch
|
| Verfasst am: 07.08.2006, 17:02 Titel: |
|
|
Ist es so besser? | Code: | 'Ä=Ž , Ö=™ , Ü=š ; ä=„ , ö=”, ü=? , ß=á ,§=õ , ©=¸
Function GB(FileSize As Single, Index=0) As String ' ©2006 by ytwinky, MD
Dim StrDim(9) As ZString Ptr={@" byte", @" KB", @"MB", @" GB", @" TB", @" PetaB", @" ExaB", @" ZettaB", @" YottaB"}
If FileSize>1023 And (Index+1)<UBound(StrDim) Then Return GB(FileSize/1024, Index+1)
Function=FileSize &*StrDim(Index)
End Function |
Gruß
ytwinky
_________________
| v1ctor hat Folgendes geschrieben: | | Yeah, i like INPUT$(n) as much as PRINT USING.. |
..also ungefähr so, wie ich GOTO.. |
|
| Nach oben |
|
|
volta
Anmeldungsdatum: 04.05.2005
Beiträge: 1876
Wohnort: D59192
|
| Verfasst am: 07.08.2006, 22:09 Titel: |
|
|
Hi ytwinky,
bei mir will die Funktion GetDiskFreeSpace einfach nicht funktionieren (ME, FB0.16 stabil) , ist immer =0 und ich komm nicht dahinter warum?
ich bastel noch ... Volta
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater. |
|
| Nach oben |
|
|
Sebastian
Administrator
Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland
|
|
| Nach oben |
|
|
volta
Anmeldungsdatum: 04.05.2005
Beiträge: 1876
Wohnort: D59192
|
| Verfasst am: 07.08.2006, 23:16 Titel: |
|
|
Hi,
GetDiskFreeSpace läuft immer noch nicht, warum??
Aber mit GetDiskFreeSpaceEx geht es: | Code: | 'Ä=Ž , Ö=™ , Ü=š ; ä=„ , ö=”, ü=? , ß=á ,§=õ , ©=¸
Option Escape
Option Explicit
Declare Function CheckDrive(byVal Lw As String)
Declare Function GB(FileSize As Single, Index=0) As String
Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA"_
(ByVal lpRootPathName As String, lpFreeBytesAvailableToCaller As ulongint, _
lpTotalNumberOfBytes As ulongint, lpTotalNumberOfFreeBytes As ulongint)As integer
Const Esc="\27"
Dim Lw As String
dim as ulongint CBytes, TBytes, FBytes
Cls
?"DiskSize.Bas ©2006 by ytwinky, MD"
Do
?"Welches Laufwerk pr?fen(A..Z, Esc=Beenden):";
Do
Lw=UCase(Inkey$)
Sleep 1
Loop Until Instr("ABCDEFGHIJKLMNOPQRSTUVWXYZ" &Esc, Lw)
If Lw<>Esc Then
?Lw
Lw+=":"
?"Laufwerk " &Lw
If GetDiskFreeSpaceEX(Lw, CBytes, TBytes, FBytes)=0 Then
?" gibs nich.."
Else
CBytes = TBytes - FBytes 'CBytes sonst nicht richtig
?
?"DiskTotal............." & GB (csng(TBytes))
?"DiskBelegt............" & GB (csng(CBytes))
?"DiskFrei.............." & GB (csng(FBytes))
End If
End If
Loop Until Lw=Esc
End
Function GB(FileSize As Single, Index=0) As String ' ©2006 by ytwinky, MD
Dim StrDim(5) As ZString Ptr={@" byte", @" KB", @" MB", @" GB", @" TB"}
If FileSize>1023 And (Index+1)<UBound(StrDim) Then Return GB(FileSize/1024, Index+1)
Function=FileSize &*StrDim(Index)
End Function
Function CheckDrive(byVal Lw As String)
Dim i, cd$=CurDir$
i=ChDir(Lw &"\\")
Return i=0
End Function |
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater.
Zuletzt bearbeitet von volta am 07.08.2006, 23:39, insgesamt einmal bearbeitet |
|
| Nach oben |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch
|
| Verfasst am: 07.08.2006, 23:20 Titel: |
|
|
Hey, was macht ihr da?
K.A. warum das so ist, bei mir funktioniert das mit allen Laufwerken:
C:..J: NTFS
K: FAT32
Obs an den Dateisystemen liegt, glaub ich nicht, das ist ja eine Windows-Funktion..
Hm..
Ich XPSP2
volta ME
Sebastian NT4SP6
Ist das schon die Ursache?
Ich weiß es nicht..
..bleib aber dran, fehlt noch ein Ergebnis mit W98[[S]|[F]E] und W95 
Gruß
ytwinky
_________________
| v1ctor hat Folgendes geschrieben: | | Yeah, i like INPUT$(n) as much as PRINT USING.. |
..also ungefähr so, wie ich GOTO.. |
|
| Nach oben |
|
|
Sebastian
Administrator
Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland
|
| Verfasst am: 07.08.2006, 23:31 Titel: |
|
|
[Primary Master, Partition I von II] C: FAT (nicht erkannt)
[Primary Master, Partition II von II] D: FAT (erkannt)
[Primary Slave, CDROM Laufwerk] F:
[Secondary Master, Partition I von I] E: NTFS (erkannt)
(FAT hab ich auf den beiden ersten Laufwerken, weil ich parallel zu NT noch ein altes SuSE Linux 7 hier drauf hab (auf der 3. Festplatte, wird von Windows weder erkannt noch irgendwie bemängelt) und das nur auf FAT Partitionen zugreifen - sprich Daten von dort lesen - kann.)
_________________
Die gefährlichsten Familienclans | Opas Leistung muss sich wieder lohnen - für 6 bis 10 Generationen! |
|
| Nach oben |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch
|
| Verfasst am: 07.08.2006, 23:43 Titel: |
|
|
voltas Version läuft bei mir einwandfrei..
(Ich frage mich nur, warum meine Version kompiliert 83k belegt und voltas Version 25k)
Gruß
ytwinky
_________________
| v1ctor hat Folgendes geschrieben: | | Yeah, i like INPUT$(n) as much as PRINT USING.. |
..also ungefähr so, wie ich GOTO.. |
|
| Nach oben |
|
|
Sebastian
Administrator
Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland
|
|
| Nach oben |
|
|
volta
Anmeldungsdatum: 04.05.2005
Beiträge: 1876
Wohnort: D59192
|
| Verfasst am: 08.08.2006, 00:01 Titel: |
|
|
sogar bei CDRW - LW (mit cd) und USB - Stick 
aber bei mir wird statt DiskBelegt nochmal der Wert für DiskFrei übergeben, deshalb | Code: | | CBytes = TBytes - FBytes |
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater. |
|
| Nach oben |
|
|
stuner
Anmeldungsdatum: 29.06.2006
Beiträge: 45
|
| Verfasst am: 08.08.2006, 08:08 Titel: |
|
|
Jetzt tuts....  |
|
| Nach oben |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch
|
|
| Nach oben |
|
|
volta
Anmeldungsdatum: 04.05.2005
Beiträge: 1876
Wohnort: D59192
|
| Verfasst am: 08.08.2006, 13:07 Titel: |
|
|
Hi, hier
http://support.microsoft.com/default.aspx?scid=kb%3Bde%3B231497
wird das wohl näher erklärt.
obwohl Babelfish...? | Zitat: | | Wenn ihr Programm auf Verkauf Windows 95 ausgeführt werden kann, müssen Sie GetDiskFreeSpaceEx nicht direkt aufrufen, da diese Funktion in Verkauf Windows 95 nicht implementiert ist und direkt das Aufrufen von es ihrem Programm nicht Sie Laden hindern. Zu es sollten Sie dynamisch via GetProcAddress stattdessen verknüpfen. Ihre Anwendung kann sicher GetDiskFreeSpaceEx dann über den Zeiger aufrufen, wenn der zurückgegebene Zeiger nicht ist; Sie sollten GetDiskFreeSpace dann wiederherstellen, wenn NULL der zurückgegebene Zeiger ist. Der Beispielcode später in diesem Artikel demonstriert, wie das getan wird. |
| Englisches Original hat Folgendes geschrieben: | | If your program can run on retail Windows 95, you should not directly call GetDiskFreeSpaceEx because this function is not implemented in retail Windows 95, and calling it directly will prevent your program from loading. Instead, you should dynamically link to it via GetProcAddress. If the returned pointer is non-NULL, then your application can safely call GetDiskFreeSpaceEx through the pointer; if the returned pointer is NULL, then you should revert to GetDiskFreeSpace. The example code later in this article demonstrates how to do this. |
Editiert durch Moderator: Könnte mir vorstellen, dass für den ein oder anderen der englische Originaltext hilfreicher ist, als diese brilliante MS-Übersetzung... :D (Sebastian)
/EDIT Volta
erklärt aber leider nicht warum es bei mir (ME) und bei Sebastian (NT4.0SP6) nicht auf dem C: - LW funktionierte, oder übersehe ich da was?
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater. |
|
| Nach oben |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch
|
| Verfasst am: 08.08.2006, 19:55 Titel: |
|
|
So, für die Fehlersuche hatte ich noch SetLastError und GetLastError eingebastelt
(habe ich erstmal dringelassen) und (auch wg. vbarchiv) auf GetDiskFreeSpaceEx umgestellt.
| Code: | 'Ä=Ž , Ö=™ , Ü=š ; ä=„ , ö=”, ü=� , ß=á ,§=õ , ©=¸
'Thx 2 volta, der mich auf einen fundamentalen Fehler aufmerksam machte
'Die Erweiterung von GB bis zu YottaByte kam auf Anregung von stuner..
'(..kann aber auch sein, daß ich ihn nur mißverstanden habe..)
'lpFreeBytesAvailableToCaller=Freier Speicherplatz für den aufrufenden Benutzer
'(In denmeisten Fällen=lpTotalNumberOfFreeBytes)
Option Escape
Option Explicit
Declare Function GetLastError Lib "kernel32" Alias "GetLastError" () As Long
Declare Sub SetLastError Lib "kernel32" Alias "SetLastError" (ByVal dwErrCode As Long)
Declare Function GB(FileSize As Single, Index=0) As String
Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA"_
(ByVal lpRootPathName As String, lpFreeBytesAvailableToCaller As ULongInt, _
lpTotalNumberOfBytes As ULongInt, lpTotalNumberOfFreeBytes As ULongInt) As integer
Const Esc="\27"
Dim As String Lw
Dim As ULongInt CBytes, TBytes, FBytes
Dim As Long i
'Screen 0
Cls
?"DiskSize.Bas ©2006 by ytwinky, MD"
Do
?"Welches Laufwerk pr�fen(A..Z, Esc=Beenden):";
Do
Lw=UCase(Inkey$)
Sleep 1
Loop Until Instr("ABCDEFGHIJKLMNOPQRSTUVWXYZ" &Esc, Lw)
If Lw<>Esc Then
?Lw
Lw+=":"
?"Laufwerk " &Lw;
SetLastError 0
If GetDiskFreeSpaceEx(Lw, CBytes, TBytes, FBytes)=0 Then
?" gibs nich.."
?"GetLastError=" &GetLastError()
Else
?
?"DiskTotal.............." &GB(Cast(Single, TBytes)) 'ne andre Möglichkeit..
?"DiskFrei..............." &GB(Cast(Single, FBytes)) '..für Typumwandlung..
?"Frei(aufruferabh„ngig)." &GB(Cast(Single, CBytes)) 'ist glaub ich 'recommended' :D
i=GetLastError()
If i<>0 Then ?"GetLastError=" &i
End If
End If
Loop Until Lw=Esc
?"Eniki.."
Sleep
End
Function GB(FileSize As Single, Index=0) As String ' ©2006 by ytwinky, MD
Dim StrDim(9) As ZString Ptr={@" byte", @" KB", @" MB", @" GB", @" TB", @" PetaB", @" ExaB", @" ZettaB", @" YottaB"}
If FileSize>1023 And (Index+1)<UBound(StrDim) Then Return GB(FileSize/1024, Index+1)
Function=FileSize &*StrDim(Index)
End Function |
Liefert bei mir folgende Ausgabe: | Code: | DiskSize.Bas ®2006 by ytwinky, MD
Welches Laufwerk prüfen(A..Z, Esc=Beenden):A <- Kein NTFS :rofl:
Laufwerk A:
DiskTotal..............1.390137MB
DiskFrei...............45.5 KB
Frei(aufruferabhängig).45.5 KB
Welches Laufwerk prüfen(A..Z, Esc=Beenden):C
Laufwerk C:
DiskTotal..............9.008587 GB
DiskFrei...............3.309639 GB
Frei(aufruferabhängig).3.309639 GB
Welches Laufwerk prüfen(A..Z, Esc=Beenden):D
Laufwerk D:
DiskTotal..............5.990391 GB
DiskFrei...............3.792999 GB
Frei(aufruferabhängig).3.792999 GB
Welches Laufwerk prüfen(A..Z, Esc=Beenden):E
Laufwerk E:
DiskTotal..............14.99135 GB
DiskFrei...............3.17112 GB
Frei(aufruferabhängig).3.17112 GB
Welches Laufwerk prüfen(A..Z, Esc=Beenden):F
Laufwerk F:
DiskTotal..............9.996777 GB
DiskFrei...............4.213562 GB
Frei(aufruferabhängig).4.213562 GB
Welches Laufwerk prüfen(A..Z, Esc=Beenden):G
Laufwerk G:
DiskTotal..............14.28659 GB
DiskFrei...............7.201519 GB
Frei(aufruferabhängig).7.201519 GB
Welches Laufwerk prüfen(A..Z, Esc=Beenden):H
Laufwerk H:
DiskTotal..............2.995178 GB
DiskFrei...............1.456753 GB
Frei(aufruferabhängig).1.456753 GB
Welches Laufwerk prüfen(A..Z, Esc=Beenden):I
Laufwerk I:
DiskTotal..............1.003479 GB
DiskFrei...............976.3184MB
Frei(aufruferabhängig).976.3184MB
Welches Laufwerk prüfen(A..Z, Esc=Beenden):J
Laufwerk J:
DiskTotal..............1.991671 GB
DiskFrei...............1.185447 GB
Frei(aufruferabhängig).1.185447 GB
Welches Laufwerk prüfen(A..Z, Esc=Beenden):K <- FAT32, aus was für Gründen auch immer.. ;)
Laufwerk K:
DiskTotal..............6.001663 GB
DiskFrei...............5.840454 GB
Frei(aufruferabhängig).5.840454 GB
Welches Laufwerk prüfen(A..Z, Esc=Beenden):X <- USB-Stick(aber abgezogen..)
Laufwerk X: gibs nich..
GetLastError=3
Welches Laufwerk prüfen(A..Z, Esc=Beenden):W <- CD-Brenner(Writer)
Laufwerk W: gibs nich..
GetLastError=21
Welches Laufwerk prüfen(A..Z, Esc=Beenden):Z <- DVD-Laufwerk(da wär sonst keiner drauf gekommen :D)
Laufwerk Z:
DiskTotal..............3.963579 GB
DiskFrei...............0 byte
Frei(aufruferabhängig).0 byte
Welches Laufwerk prüfen(A..Z, Esc=Beenden): |
[Edit]
Leerzeichen bei MB eingefügt
Gruß
ytwinky
_________________
| v1ctor hat Folgendes geschrieben: | | Yeah, i like INPUT$(n) as much as PRINT USING.. |
..also ungefähr so, wie ich GOTO..
Zuletzt bearbeitet von ytwinky am 11.08.2006, 19:47, insgesamt einmal bearbeitet |
|
| Nach oben |
|
|
volta
Anmeldungsdatum: 04.05.2005
Beiträge: 1876
Wohnort: D59192
|
| Verfasst am: 10.08.2006, 23:29 Titel: |
|
|
Auch wenn ich das nie im Orginalprogramm zu sehen bekomme
einmal wollte ich das wenigstens simuliert sehen | Code: | Function GB(FileSize As Single, Index=0) As String ' ©2006 by ytwinky, MD
Dim StrDim(9) As ZString Ptr={@" byte", @" KB", @"MB", @" GB", @" TB", @" PetaB", @" ExaB", @" ZettaB", @" YottaB"}
If FileSize>1023 And (Index+1)<UBound(StrDim) Then Return GB(FileSize/1024, Index+1)
Function=FileSize &*StrDim(Index)
End Function
dim as ulongint i=&Hffffffffffffff
?gb(csng(i))
i shl=8
?gb(csng(i))
'und dafür reicht selbst ulongint nicht
?gb (1e22)
?gb (1e25)
sleep
|
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater. |
|
| Nach oben |
|
|
Eastler_dart
Anmeldungsdatum: 25.09.2005
Beiträge: 177
Wohnort: Baden-Würtemberg + Sachsen
|
| Verfasst am: 13.08.2006, 12:26 Titel: |
|
|
Hi Leute,
da Ihr hier alle schon der Meinung seid, man sollte Terras anzeigen können will ich mal tiefstapeln und meinen Senf auch dazugeben.
Terra klingt nach Erde und ist nix für mich 
Giga klingt sehr groß, ist auch nix für mich 
also bleibt doch nur Megabytes über, oder? 
Jedenfalls eiere ich immer noch mit FreeBasic für pures Dos rum,
und dort läuft eure Terra-Routine ja nicht, da keine Win.bi oder kernel32 greifbar ist.
Sollte in der Welt der Terraner noch ein paar Dosianer rumrennen, hier die Version fürs reine DOS:
| Code: | 'ZEIGT FREIEN SPEICHER AN
'
'Für Festplattenplatz auf zwei verschiedene Arten
'Erst mit der Funktion _dos_getdrive die Anzahl der Laufwerke ermitteln
'Einmal mit der Funktion getdfree Freien Platz ermitteln
'und auch mit der Funktion _dos_getdiskfree Freien Platz ermitteln
'Gleich vorneweg, geht nur bis 2GB, mehr wird als 2GB ermittelt.
'==============================================================================
'DECLARATIONS
'==============================================================================
#IFDEF __FB_DOS__
'...instructions only FOR DOS...
#include "dos/go32.bi"
#include "dos/pc.bi"
#include "dos/dos.bi"
#include "dos/sys/movedata.bi"
#ENDIF
option explicit
DECLARE SUB TxtTasteWarten(WarteText$)
'==============================================================================
'DIMs and TYPEs
'==============================================================================
DIM SHARED CursorLine%
DIM SHARED CursorPos%
DIM Zaehler%
DIM AS UINTEGER DosVersion
DIM AS dfree DiskFree
DIM DiskFreePointer AS dfree PTR
DIM AS Ubyte Laufwerk
DIM AS UINTEGER ULaufwerk
DIM AS UINTEGER LWZahl
DIM AS UINTEGER PTR ULaufwerkPointer
DIM AS _diskfree_t DosDiskFree
DIM AS _diskfree_t PTR DosDiskFreePointer
DIM AS DOUBLE Kapa
DIM AS SINGLE Kapas
DIM AS STRING dummy
DIM AS UINTEGER DosDiskFunction
DIM AS INTEGER Bytes_Sec, Sec_Cluster, Avail_Cluster, Total_CLuster
'==============================================================================
'SUBs AND FUNCTIONS
'==============================================================================
SUB TxtTasteWarten(WarteText$)
CursorLine%=CSRLIN
CursorPos%=POS
LOCATE 25,1
PRINT SPACE$(79);
LOCATE 25,1
PRINT LEFT$(WarteText$,79);
DO : LOOP WHILE INKEY$=""
LOCATE CursorLine%, CursorPos%
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'==============================================================================
'HAUPTPROGRAMM / MAIN
'==============================================================================
'(aus dos.bi): declare function _get_dos_version cdecl alias "_get_dos_version" ( byval a as integer ) as uinteger
DosVersion = _get_dos_version(2)
'(aus dos.bi): declare sub _dos_getdrive cdecl alias "_dos_getdrive" ( byval _p_drive as uinteger ptr )
ULaufwerkPointer = @ULaufwerk
CALL _dos_getdrive(ULaufwerkPointer)
LWZahl=ULaufwerk :' Ulaufwerk scheint die Anzahl Festplatten zu liefern
PRINT
PRINT "Dos-Version=";STR$(DosVersion)
PRINT "Ulauferk (aus _dos_getdrive) = "; STR$(ULaufwerk)
PRINT "FESTPLATTEN:"
PRINT "Nr: MB FREI: MB Gesamt ClusterFrei ClusterGesamt Byte/Sect Sect/Clust"
PRINT "MIT SUB getdfree aus Dos.bi"
FOR Laufwerk = 3 TO LWZahl+2 'Anzahl Festplatten ab C: - Laufwerke 1+2 sind Disketten A: und B:, deshalb ab Nr 3
PRINT SPACE$(3-LEN(STR$(Laufwerk)));STR$(Laufwerk);
DiskFreePointer = @DiskFree
'(aus dos.bi): declare sub getdfree cdecl alias "getdfree" ( byval drive as ubyte, byval pt as dfree ptr )
CALL getdfree(Laufwerk, DiskFreePointer)
'type dfree | df_avail as uinteger | df_total as uinteger | df_bsec as uinteger | df_sclus as uinteger | end type
Kapa = (DiskFree.df_sclus * DiskFree.df_bsec * DiskFree.df_avail) /1024/1024
dummy = LEFT$(STR$(Kapa),8)
PRINT SPACE$(9-LEN(dummy));dummy;
Kapa = (DiskFree.df_sclus * DiskFree.df_bsec * DiskFree.df_total) /1024/1024
dummy = LEFT$(STR$(Kapa),8)
PRINT SPACE$(11-LEN(dummy));dummy;
PRINT SPACE$(11-LEN(STR$(DiskFree.df_avail)));STR$(DiskFree.df_avail);
PRINT SPACE$(11-LEN(STR$(DiskFree.df_total)));STR$(DiskFree.df_total);
PRINT SPACE$(11-LEN(STR$(DiskFree.df_bsec)));STR$(DiskFree.df_bsec);
PRINT SPACE$(11-LEN(STR$(DiskFree.df_sclus)));STR$(DiskFree.df_sclus)
NEXT Laufwerk
'type _diskfree_t|total_clusters as ushort|avail_clusters as ushort|sectors_per_cluster as ushort|bytes_per_sector as ushort|end type
'declare function _dos_getdiskfree cdecl alias "_dos_getdiskfree" ( byval _drive as uinteger, byval _diskspace as _diskfree_t ptr ) as uinteger
PRINT "MIT FUNCTION _dos_getdiskfree() aus Dos.bi"
FOR ULaufwerk = 3 TO LWZahl+2
PRINT SPACE$(3-LEN(STR$(ULaufwerk)));STR$(ULaufwerk);
DosDiskFreePointer = @DosDiskFree
DosDiskFunction = _dos_getdiskfree(ULaufwerk, DosDiskFreePointer)
IF DosDiskFunction = 0 THEN
'Direkt-Zugriff bringt nur Null, nur Str$(DosDiskFree.Bytes_per_sector) zeigt den Inhalt, rechnen geht nicht
'direct-Acces gets zero, only Str$(DosDiskFree.Bytes_per_sector) gives the value
'deshalb per CINT in Integerwerte umsetzen / thats why change it in integer-Vars
Bytes_Sec = CINT(DosDiskFree.bytes_per_sector)
Sec_Cluster = CINT(DosDiskFree.sectors_per_cluster)
Avail_Cluster = CINT(DosDiskFree.avail_clusters)
Total_CLuster = CINT(DosDiskFree.total_clusters)
Kapas = (Avail_Cluster * Bytes_Sec * Sec_Cluster) / 1024 / 1024
dummy = LEFT$(STR$(Kapas),8)
PRINT SPACE$(9-LEN(dummy));dummy;
Kapas = (Total_Cluster * Bytes_Sec * Sec_Cluster) / 1024 / 1024
dummy = LEFT$(STR$(Kapas),8)
PRINT SPACE$(11-LEN(dummy));dummy;
PRINT SPACE$(11-LEN(STR$(Avail_Cluster)));STR$(Avail_Cluster);
PRINT SPACE$(11-LEN(STR$(Total_Cluster)));STR$(Total_Cluster);
PRINT SPACE$(11-LEN(STR$(Bytes_Sec)));STR$(Bytes_Sec);
PRINT SPACE$(11-LEN(STR$(Sec_Cluster)));STR$(Sec_Cluster)
ELSE
PRINT "DosDiskFunction=";STR$(DosDiskFunction)
END IF
NEXT ULaufwerk
PRINT
PRINT "Freier Ram-Speicher="; STR$(FRE);"Bytes / ";STR$( INT(FRE/1024) );"KiloBytes / ";STR$( INT(FRE/1024/1024) );"MegaBytes"
CALL TxtTasteWarten("Jegliche Taste = Programmende") |
zwar nur halbfertig, aber auf meinen Maschinen läufts, sowohl in der Dos-Box von W98SE als auch auf einem 486-rein-MsDos7-Lap.
Gleich vorneweg, mit dieser Version ist bei 2.047,688 MBs schluß, alles was größer ist, wird einfach mit diesen 2.047,688 MB angezeigt
Die Dos-Version wird auch abgerfragt, bin jedoch noch nicht dazu gekommen, das Ergebnis aufzuschlüsseln  .
Mit dieser Routine hab ich die Dos-Version 1802
Hinweis:Bei Fehler bin ich natürlich NICHT zuständig.
Das Programm sollte mit FreeBasic FÜR DOS compieliert werden,
bei mir mit FB-Dos 0.16 stable mit Patch Grafikfehler von Drv
Hoffe es hilft jemandem
Eastler
_________________
Kaum macht mans richtig, schon geht's |
|
| Nach oben |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch
|
| Verfasst am: 15.08.2007, 16:49 Titel: |
|
|
Hi,
geht es mir alleine so? Ich habe obigen DiskSize-Code auf FB0.17 umstellen wollen, denn da sind ja Änderungen nötig, wg. Option Escape u.ä.
Toll, die Version läßt sich gar nicht kompilieren | FBIde0.46 hat Folgendes geschrieben: | Compiler output:
d:\Sprachen\FreeBASIC\bas\DiskSize.o:fake:(.text+0x2c9): undefined reference to `GetDiskFreeSpaceExA@28' |
..da frag ich mich natürlich:Wasn nu?
..und euch natürlich auch..
Doch damit nicht genug, denn ich hab ja auch noch die 'falsche' Version.
Aber da brauch ich kein Fehlerlog einzufügen, denn es läßt sich nach den Änderungen 'fehlerfrei' kompilieren..
Wenigstens kompilieren, allerdings meldet es bei allen Laufwerken 0
..aber da bin ich relativ sicher, daß es falsch ist..
Gruß
ytwinky
_________________
| v1ctor hat Folgendes geschrieben: | | Yeah, i like INPUT$(n) as much as PRINT USING.. |
..also ungefähr so, wie ich GOTO.. |
|
| Nach oben |
|
|
PMedia
Anmeldungsdatum: 14.08.2006
Beiträge: 2847
|
| Verfasst am: 15.08.2007, 17:44 Titel: Re: DiskSize und DiskFree |
|
|
| ytwinky hat Folgendes geschrieben: | Hi,
ob eine Diskette im Laufwerk ist, kann ich immer noch nicht herausfinden
Ich habe es mit der Größe probiert, aber da kommt auch dieser 'blöde' Dialog,
wenn keine Disk im Laufwerk ist.. |
da ich diesen Beitrag jetzt erst sehe...
Es gibt da eine API-Funktion, die fragt ab, ob das Laufwerk bereit ist.
Ich glaub sie hieß IsDriveReady, musst mal inne Headerdatein gucken... ne Google-Suche hat da bissl was zutage gefördert... vlt. hilfts dir, iwo hab ich auch noch ein XProfan-Codeschnipsel zu liegen...
ah gefunden
http://xprofan.com/thread.core?t=5359// |
|
| Nach oben |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch
|
| Verfasst am: 15.08.2007, 18:01 Titel: Re: DiskSize und DiskFree |
|
|
| PMedia hat Folgendes geschrieben: | | ytwinky hat Folgendes geschrieben: | Hi,
ob eine Diskette im Laufwerk ist, kann ich immer noch nicht herausfinden
Ich habe es mit der Größe probiert, aber da kommt auch dieser 'blöde' Dialog,
wenn keine Disk im Laufwerk ist.. |
|
| ytwinky hat Folgendes geschrieben: | | Verfasst am: 05.08.2006, 20:15 Titel: DiskSize und DiskFree |
..netter Versuch, aber ich habe gemerkt, daß du dich nicht auf meinen aktuellen Post bezogen hast, der steht übrigens direkt vor deinem letzten, weil du ja diese komischen Dinger auf der Brille hast, kannst du das natürlich nicht sehen, deshalb beschreib ich das
[Edit]
Aber jetzt mal ernsthaft, es ist kein so großes Problem mehr, denn, wenn ich in der FBIde '-lang deprecated' einstelle dann klappts..
Witzig ist dabei wiederum, daß !"\27" auch funktioniert, obwohl ich 'Option Escape' entfernt habe..
Muß das jetzt bei diesem WorkAround bleiben oder wie?
[Edit2]
Das, was ich eigentlich vorhatte, ist nun zu bewundern^^
VolZ.Bas
Vol hat dabei aber nix mit Volta zu tun und Z nix mit Warez
_________________
| v1ctor hat Folgendes geschrieben: | | Yeah, i like INPUT$(n) as much as PRINT USING.. |
..also ungefähr so, wie ich GOTO.. |
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
