Program vypiše šicke ľabdy o totym disku co je akualny

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategorija: KMP (Programy mladňakoch

Zrobil: Ľuboš Saloky
Program: Mtester.pas
Subor exe: Mtester.exe

Program vypiše šicke ľabdy o totym disku co je akualny.
{ 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.