The program lists all available information about the current disc
Delphi & Pascal (česká wiki)
Category: KMP (Club of young programmers)
Author: Ľuboš Saloky
Program: Mtester.pas
File exe: Mtester.exe
Author: Ľuboš Saloky
Program: Mtester.pas
File exe: Mtester.exe
The program lists all available information about the current disc.
{ mtester.pas } { Program vypise vsetky dostupne informacie o aktualnom disku. } { } { Author: Ľuboš Saloky } { Datum: 01.01.1996 http://www.trsek.com } program MukoSoft_Testovaci_program; uses Dos,Crt; const cluster=8192; type Parametry=record CisloDisku,OvladacDisku :byte; ByteNaSektor :word; SektoruNaJednotku,ShiftFaktor :byte; RezervovaneSektoryProBoot :word; KopieFAT :byte; RootZaznamy,PrvniDatovySektor :word; NejvyssiAlokJednotka :word; SektoruProFAT :byte; PrvniSektorProRoot :word; AdresaOvladace :pointer; IDMedia2a3 :byte; IDMedia4a5 :byte; NasledujiciBlokParametru :pointer; end; InfoBlok=record DiskJednotka:byte; VolneAlokJednotky:word; CelkemAlokJednotek:word; ByteSektor:word; SektorAlok:word; end; parametryPTR=^parametry; var a:array[1..16000] of longint; r:registers; f:file; s,s2:string; pom,err,err2:word; d,suc,sc512b,sc1kb,sc2kb,sc4kb,sc8kb,sc16kb:longint; reg:registers; info:infoblok; data:parametry; Procedure InfoDisk(Disk:char); begin with r do begin DL:=Ord(Disk)-64; Info.DiskJednotka:=DL; AH:=$36; MsDos(r); if AX=$0FFF then begin Info.DiskJednotka :=0; Info.VolneAlokJednotky :=0; Info.CelkemAlokJednotek:=0; Info.ByteSektor :=0; Info.SektorAlok :=0; Exit; end; Info.VolneAlokJednotky:=BX; Info.CelkemAlokJednotek:=DX; Info.ByteSektor:=CX; Info.SektorAlok:=AX; end; end; Function TypDisku(Disk:char):string; var CisloDisku,MediaDeskriptor:byte; begin TypDisku:='NeznamyDisk'; CisloDisku:=Ord(Disk)-64; with R do begin AH:=$1C; DL:=CisloDisku; MsDos(r); MediaDeskriptor:=Mem[DS:BX]; AH:=$32; DL:=CisloDisku; MsDos(r); if AL=$FF then Exit; TypDisku:='NeznamyDisk'; move(ParametryPTR(PTR(DS,BX))^,data,sizeof(data)); with ParametryPTR(PTR(DS,BX))^ do begin if KopieFAT=1 then Typdisku:='RamDisk'; if MediaDeskriptor=$F8 then TypDisku:='HardDisk'; if (MediaDeskriptor=$F0) and (NejvyssiAlokJednotka=2848) then TypDisku:='FD1440KB'; if MediaDeskriptor>=$F9 then case NejvyssiAlokJednotka of 355:TypDisku:='FD360KB'; 714,1423:TypDisku:='FD720KB'; 2372:TypDisku:='FD1200KB'; end; end; end; end; procedure UmiestniCiarky(x,y:integer;a:longint); var pom:string; l:integer; begin Str(a,pom); l:=length(pom)-2; while l>1 do begin Insert('.',pom,l); l:=l-3; end; GotoXY(x,y); write(pom); end; function TypMonitora:string; begin r.AH:=$12; r.BL:=$10; Intr($10,r); case r.CL of $0B:TypMonitora:='Mono'; $08:TypMonitora:='Farebny'; $09:TypMonitora:='EGA'; end; end; function Adapter:string; begin Adapter:='Neznamy'; r.AX:=$1A00; Intr($10,r); if r.AL=$1A then case r.BL of $01:Adapter:='Hercules'; $02:Adapter:='CGA'; $04..$05:Adapter:='EGA'; $07..$08:Adapter:='VGA'; $0A..$0C:Adapter:='MCGA'; end; end; procedure Umiestni(x,y:integer;l:longint); var s:string; begin GotoXY(x,y); Str(l,s); write(s); end; {hlavny program} BEGIN suc:=0;sc512b:=0;sc1kb:=0;sc2kb:=0;sc4kb:=0;sc8kb:=0;sc16kb:=0; writeln('Cakaj chvilu, pracujem...'); clrscr; writeln('+=====================+=========================+============================+'); writeln('| Disk C:\ | Nazov disku ___________ | Verzia MS-DOSu |'); writeln('+=====================+=============+===========+============================+'); writeln('| Kapacita B = MB | Volne miesto B = MB |'); writeln('+===================================+==+=====================================+'); writeln('|Strata sposobena velkostou clusterov: |Charakteristika disku: |'); writeln('| Pri 512B clustroch B |Cislo disku: Ovladac disku: |'); writeln('| Pri 1KB clustroch B |Pocet bajtov na sektor: |'); writeln('| Pri 2KB clustroch B |Pocet sektorov na cluster: |'); writeln('| Pri 4KB clustroch B |Pocet clustrov: |'); writeln('| Pri 8KB clustroch B |Shift faktor: Pocet kopii FAT: |'); writeln('| Pri 16KB clustroch B |Rezervovane sektory pre BOOT: |'); writeln('+======================================+Zaznamy v hlavnom adresari: |'); writeln('|Typ monitora: |Prvy datovy sektor: |'); writeln('|Graficky adapt r: |Pocet sektorov pre FAT: |'); writeln('| |Prvy sektor hlavneho adresara: |'); writeln('| |Volne clustery: |'); InfoDisk('C'); s:=TypDisku('C'); GotoXY(12,2); writeln(s); Gotoxy(66,2); write(Lo(DosVersion),'.',Hi(DosVersion)); UmiestniCiarky(13,4,DiskSize(3)); Gotoxy(29,4); write(DiskSize(3) div 1048576); UmiestniCiarky(53,4,DiskFree(3)); Gotoxy(69,4); write(DiskFree(3) div 1048576); UmiestniCiarky(24,7,sc512b-suc); UmiestniCiarky(24,8,sc1kb-suc); UmiestniCiarky(24,9,sc2kb-suc); UmiestniCiarky(24,10,sc4kb-suc); UmiestniCiarky(24,11,sc8kb-suc); UmiestniCiarky(24,12,sc16kb-suc); Umiestni(54,7,data.cislodisku); Umiestni(73,7,data.ovladacdisku); Umiestni(65,8,Info.Bytesektor); Umiestni(68,9,Info.SektorAlok); Umiestni(57,10,data.nejvyssialokjednotka); Umiestni(55,11,data.shiftfaktor); Umiestni(76,11,data.kopiefat); Umiestni(71,12,data.rezervovanesektoryproboot); Umiestni(69,13,data.rootzaznamy); Umiestni(61,14,data.prvnidatovysektor); Umiestni(65,15,data.sektoruprofat); Umiestni(72,16,data.prvnisektorproroot); GotoXY(16,14); write(TypMonitora); GotoXY(20,15); write(Adapter); Umiestni(57,17,Info.VolneAlokJednotky); readln; END.