Code-Beispiel
Fragmentierung überprüfen
Lizenz: | Erster Autor: | Letzte Bearbeitung: |
k. A. | ![]() | ![]() |
Zum Überprüfen der Fragmentierung bietet Windows einen relativ einfachen Befehl:
(Wenn der Benutzer über Admin-Rechte verfügt, aber solange das UAC-Problem nicht gelöst ist, bleiben vista- und win7-Benutzer außen vor..)
Defrag /a Lw:
wobei Lw: für das zu überprüfende Laufwerk steht(z. B. Defrag /a C:).
Nun ist die Ausgabe(in bester m$-Manier) aber alles andere als übersichtlich.
Wer also mehrere Partitonen, mehrere externe Laufwerke und auch USB-Sticks in Betrieb
hat, vermißt möglicherweise eine geordnete Auflistung seiner Datenträger. Dies bietet
das Programm ChkFrag, was für Check Fragmentation steht:
#ifndef False
Const False=0, True=Not False
#endif
#include "crt.bi"
#include once "windows.bi"
#include "vbcompat.bi"
#define ArgC ((*__p___argc())-1)
#undef GoTo 'Jojo hat Recht, danke ;-))
#define auf ,
'+-----------------------------------------------------------------------------------+
'| Header: Bestimmen der Übergabeparameter |
'| AnzeigeCheck:|Il1 sind Alt-0124, Großes i, kleines L, Eins „ä”öüáߎę֚Üñ±ø°¸©|
Const Autor="ChkFrag.Bas v0.21.1 ¸2011 by ytwinky, MD"' |
'| (Tastenkombination: keine) |
'| |
'| Zweck : Schablone für neue Dateien |
'+-----------------------------------------------------------------------------------+
'(Anmerkung zu den Sonderzeichen: zuerst steht das DOS-Zeichen, danach das Windowszeichen)
#include "ChkFrag.bi"
Var i=0, AlleLw=GetAllDrives(), a=0.0, e=0.0, FragLimit=VerfLimit, m=Autor, t=True
Dim LwArray(1 To 26) As LwRec
Print Autor
For i=1 To ArgC
If Command(i)<>"" Then
Select Case Left(lcase(Command(1)), 2)
Case "/f"
FragLimit=Val(Mid(Command(1), 3))
If FragLimit=0 Then FragLimit=12
Case "/w"
Case "/z"
t=False
Case Else
Hilfe()
End 27
End Select
EndIf
Next
If Not IsAdmin() Then
m=!"Zur Ausfhrung diese Programmes werden Admin-Rechte ben”tigt\n"
m &= "Diese sind aber fr " &ENVIRON("username") &!" nicht vorhanden..\n"
m &= !"Wenden Sie sich an Ihren SystemAdministrator oder Bill Gates, aber\n"
Print m &"keinesfalls an den Autor ;-))"
Hilfe()
End If
Print "Fragmentierungsbericht der Partion" & *IIf(Len(AlleLw)>2, @"en", @"") &_
!"\nLw Gesamt Verfgbar Verf.% Fragm.% Dateifragm.% Defrag" &*IIf(t, @" Zeit[s]", @"")
For i=1 To Len(AlleLw) Step 2
Print "w8, plz..";
a=Timer
LwArray(i)=Check(Mid(AlleLw, i, 2))
e=Timer
With LwArray(i)
Print !"\r" & .LwChar &Align(.Gesamt, 12) &Align(Replace(.Verf, ".", ""), 12);
If Val(.VerfP)<=VerfLimit Then Color hell+rot auf schwarz
Print Align(.VerfP, 7);
Color weiss auf schwarz
If Val(.Fragm)>FragLimit Then Color hell+rot auf schwarz
Print Align(.Fragm, 8);
Color weiss auf schwarz
m=Align(Format(e-a, " ##0.0"), 5)
Print Align(.DatFrag, 14) &Align(.Empfehlung, 7, "l"); *IIf(t, SAdd(m), @"")
End With
Next
If InStr(lCase(Command), "/w") Then
Print "Eniki..";
GetKey
End If
Anmerkung:
In der Spalte unter Defrag bedeutet:
kann | eine Defragmentierung ist nicht unbedingt erforderlich |
sollte | eine Defragmentierung sollte in absehbarer Zeit erfolgen (mit welchem Defragmentierungsprogramm auch immer..) |
Beim ersten Programmstart ist der Aufruf ChkFrag -? oder ChkFrag /? empfohlen, falls aus dem Quelltext nicht hervorgeht, was das Programm macht, bzw. welche Parameter es verarbeitet.
Voraussetzung hierfür ist aber, daß wir uns auf der Befehlszeile im Verzeichnis befinden, das auch ChkDefrag enthält.
Wenig Freude werden linux-benutzer an diesem Programm haben, doch einen Grund zur Freude
haben sie: Es wird unter linux auch gar nicht benötigt..
Die Anweisungen, die nicht in der Befehlsreferenz erläutert werden,
stammen aus folgender .bi-Datei:
Const VerfLimit=12, hell=8, rot=hell+4, weiss=7, schwarz=0, Lf=!"\n"
Type LwRec
As String LwChar, Empfehlung, Gesamt, Verf, VerfP, Fragm, DatFrag
End Type
Function IsAdmin() As Integer 'Schönen Dank an yetifoot und oldirty für die Vorarbeit ;-))
Dim HKey_ As HKEY
Dim As String RegKey="Software\Microsoft\WBEM" 'nur Admins können hier schreiben
Dim As String KeyName="IsAdmin" 'dieser String 'IsAdmin' ist absolut unschädlich..
'(der Inhalt ist völlig belanglos, 'No' falls ein Schlaumeier den Wert ausliest ^^)
RegCreateKeyEx(HKEY_LOCAL_MACHINE, RegKey, 0, 0, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, NULL, @HKey_, 0)
Function=RegSetValueEx(HKey_, KeyName, 0, REG_SZ, @"No", 3)=0 'True=Schreiben hat geklappt, also Admin..
'..da das Schreiben funktioniert
'..und die paar Byte schaden der Registry nicht, gemessen an dem Schrott, der sonst noch drinsteht!
RegCloseKey(HKey_)
End Function
Function LaufwerksTyp(Drive As String) As String
Var i=GetDriveType(Drive)
Dim As String LwTyp(1 To 6)={"Medium unbekannt", "WechselMedium", "Festplatte", "Netzlaufwerk", "CD/DVD", "RamDisk"}
LaufwerksTyp=LwTyp(IIF(i<2 Or i>6, 0, i))
End Function
Function GetAllDrives() As String
Var s="", Drives="", Drive="", i=0, LwCh=""
Dim Buffer As String*255
i=GetLogicalDriveStrings(Len(Buffer), Buffer)
Drives=Left(Buffer, i)
For i=1 To Len(Drives) Step 4
Drive=Mid(Drives, i, Instr(Drives, "\"))
LwCh=Chr(Drive[0])
If LwCh>"B" And InStr(LaufwerksTyp(LwCh &":"), "/")=0 Then s+=LwCh &":"
Next
Return s
End Function
Function ChkFrag(Lw As String) As String
Dim As String s, z
Dim As Integer DNr=FreeFile, i
If Instr(Lw, ":")=0 Then Lw+=":"
Open Pipe "Defrag.Exe -a " &Lw For Input As #DNr
Do
Line Input #DNr, z
If Instr(z, "ragmentiert")=0 Then Continue Do
s+=z &Lf
Loop Until Eof(DNr)
Close DNr
Return s
End Function
Sub Hilfe()
Var s=!"Korrekter Aufruf: ChkFrag [/Fx]|[/?] [/W] [/Z]\n"
s &= !"wobei:\n\t/Fx\teine Fragmentierungsgrenze von x setzt..\n"
s &= !"\t/?\tdiese Seite anzeigt(auch -?, /h, -h usw.)"
s &= !"\n\t/W\tbewirkt ein Anhalten des Programmes, bis eine Taste gedrckt wird"
s &= !"\n\t/Z\tunterdrckt die Zeitanzeige am Zeilenende"
s &= !"\n(Gross-/Kleinschreibung ist egal..)"
s &= !"\nDie Fragmentierungsgrenze bewirkt aber nur eine (rote) Farbe der angezeigten Zahl.."
s &= !"\nDie Verfgbarkeitsgrenze von 12% ist eine Windoze-Konstante,"
s &= !"\ndas BS braucht den Platz, um eine Defragmentierung durchzufhren.."
Print s
End 194
End Sub
Function StringSplit( _
Liste As String, _
Trenner As String, _
SplitArray() As String, _
LeerZeilen As Integer=True _
) As Integer
Var Vorige=1, Gefunden=0, LenTren=Len(Trenner), Index=0, s="" ' der Var-Befehl funktioniert^^
If Len(Liste)+LenTren=0 Then Return -1 'beide Längen=0? nix zu tun, fertig..
Erase SplitArray 'alte Ergebnisse löschen
Do While Instr(Vorige, Liste, Trenner) 'hier prüfen, kann ja sein, daß es Trenner nicht gibt
Gefunden=Instr(Vorige, Liste, Trenner)
ReDim Preserve SplitArray(Index) 'Preserve funktioniert mit 1-dimensionalen Arrays
s=Mid(Liste, Vorige, Gefunden-Vorige) 'Teilstring von Vorige bis Gefunden..
If s<>"" Then 'Keine Leerzeile?
SplitArray(Index)=s 'Alles klar, übernehmen..
Index+=1
Else 'Ooops, Leerstring, weiterprüfen..
If LeerZeilen Then 'Wenn False, werden leere Zeilen ausgefiltert
SplitArray(Index)=s 'Also gut, Leerzeile übernehmen..
Index+=1
End If
End If
Vorige=Gefunden+LenTren 'Vorige auf nächste Position
Loop
ReDim Preserve SplitArray(Index) 'Wenigstens Platz für EIN Element machen
If Index Then 'Stringrest in SplitArray speichern..
SplitArray(Index)=Mid(Liste, Vorige, Gefunden-Vorige)
Else 'nein, Trenner ist nicht in Liste..
SplitArray(Index)=Liste ' Liste in SplitArray speichern(Vorsicht:Speicherplatz!!)
EndIf
Return Index 'UBound wäre hier ein unnötiger Funktionsaufruf..
End Function
Function Replace(byVal Text As String, byVal Suche As String, byVal ErsetzeMit As String) As String
Var i=0, s=Text
While Instr(s, Suche)
i=Instr(s, Suche)
s=Left(s, i-1) &ErsetzeMit &Mid(s, i+Len(Suche))
Wend
Return s
End Function
Function Check(Lw As String) As LwRec
Dim h As LwRec, i As Integer, j As Integer, k As Integer, s() As String, st As String
With h
.LwChar=Lw
StringSplit(ChkFrag(.LwChar), !"\n", s(), False)
.Empfehlung="sollte"
If InStr(s(1), .Empfehlung)=0 Then .Empfehlung="kann"
st=s(0)
i=StringSplit(st, ", ", s(), False)
.Gesamt=LTrim(Left(s(0), InStr(s(0), "Gesamt")-2))
j=InStr(s(1), "(")
.Verf=LTrim(Left(s(1), j-2))
.VerfP=Mid(s(1), j+1, InStr(s(1), ")")-j-1)
.Fragm=LTrim(Left(s(2), InStr(s(2), "F")-2))
j=InStr(s(2), "(")
.DatFrag=Mid(s(2), j+1, InStr(s(2), "Dat")-1-j)
End With
Return h
End Function
Function Align(What As String, FieldWidth As Integer=11, How As String="r") As String
Var Aligned=Space(FieldWidth), le=Len(What), Wie=IIf(How="", @"c", SAdd(How))
Select Case LCase(Left(*Wie, 1)) 'ignore lowercase
Case "r" 'it is ok to submit 'r' for 'Right', which is the default
RSet Aligned, What
Case "l" 'same with 'l' which aligns to the 'Left'
LSet Aligned, What
Case Else 'now there's only 'c' left
LSet Aligned, What
If le<FieldWidth Then
Aligned=Left(Space((FieldWidth-le)\2) &Aligned, FieldWidth)
End If
End Select
Return Aligned
End Function
(Ohne diese .bi-Datei läuft das Programm nicht..)
Beide Dateien zusammen alsDownload
Gruß
ytwinky
Zusätzliche Informationen und Funktionen | |||||||
---|---|---|---|---|---|---|---|
|