Autor: Kub@z | 13.4.2004 |
uses dos;
const disky: string = 'ABCDEFGHIJKLMN'; (* to snad stačí :) *)
var size: longint;
disk: byte;
begin
disk := 3; (* začneme u trojky, abychom přeskočili disketové mechaniky *)
repeat
size := DiskSize(disk);
if size = -1 then break;
writeln('Disk '+disky[disk]+ ' ma ', size div (1024*1024), ' MB');
disk := disk + 1;
until false;
end.
uses Dos;
var i: Integer;
begin
for i := 1 to EnvCount do (* vypíšeme všechny systémové proměnné *)
writeln(EnvStr(i));
end.
uses dos;
begin
writeln('Pouzita command lajna: '+GetEnv('COMSPEC'));
writeln('Path: '+GetEnv('PATH'));
end.
procedure FindFirst(Path: String; Attr: Word; var F: SearchRec);
"Path" určuje cestu k souborům, "Attr" určuje atributy souboru, které se dají zapsat buď číselně, nebo pomocí konstant:Konstanta | Hodnota | Význam | ReadOnly | $01 | Jen pro čtení | Hidden | $02 | Skrytý | SysFile | $04 | Systémový soubor | VolumeID | $08 | Disk | Directory | $10 | Složka | Archive | $20 | Archivovat | Anyfile | $3F | Jakýkoliv soubor |
type SearchRec = record
Fill: array[1..21] of Byte;
Attr: Byte;
Time: Longint;
Size: Longint;
Name: string [12];
end;
procedure FindNext(var F: SearchRec);
Tato hledá další výskyt souboru odpovídajícího podmínkám při hledání "FindFirst". Pokud není možné další soubor najít, vrátí funkce "DosError" jinou hodnotu než 0. Takže program který vypíše obsah C:\ je:
uses dos;
var soub: searchrec;
begin
FindFirst('c:\*.*',anyfile,soub); (* najdeme první soubor odpovídající zadání *)
while DosError = 0 do begin (* dokud se soubor podaří najít *)
writeln(soub.name, ' - ',soub.size, ' bytů'); (* vypíšeme jméno + velikost *)
findnext(soub); (* najdeme další soubor *)
end;
end.
procedure PackTime(var T: DateTime; var Time: Longint);
procedure UnpackTime(Time: Longint; var DT: DateTime);
DateTime = record
Year,Month,Day,Hour,Min,Sec: Word;
end;
uses dos;
var soub: searchrec;
d: datetime;
begin
FindFirst('c:\*.*',anyfile,soub);
while DosError = 0 do begin
unpacktime(soub.time,d);
writeln(soub.name,' - ',d.day,'.', d.month,'.', d.year,' ', d.hour,':', d.min,':', d.sec);
findnext(soub);
end;
end.
procedure GetDate(var Year, Month, Day, DayOfWeek: Word);
procedure GetTime(var Hour, Minute, Second, Sec100: Word);
procedure SetDate(Year, Month, Day: Word);
procedure SetTime(Hour, Minute, Second, Sec100: Word);
uses dos;
procedure mydelay(stn: integer);
var n,vt,st: word;
min,souc: longint;
begin
gettime(n,n,vt,st);
min := vt*100+st; (* zjistíme čas, kdy procedura začala *)
repeat
gettime(n,n,vt,st);
souc := vt*100+st; (* vypočítáme aktuální čas *)
until (souc >= min + stn) or (souc < min);
(* dokud nedosáhneme požadovaného času *)
end;
begin
write('Text');
mydelay(50);
write('Text vypsany po polovine vteriny');
end.
procedure GetFTime(var F; var Time: Longint);
procedure GetFAttr(var F; var Attr: Word);
procedure SetFTime(var F; Time: Longint);
procedure SetFAttr(var F; Attr: Word);
uses dos;
var f: file; (* file může být i beztypový *)
pom: longint;
d: datetime;
begin
assign(f,'pok.hmm'); (* na příponě nezáleží *)
rewrite(f); (* vytvoříme soubor *)
getFTime(f, pom);
unpacktime(pom, d); (* tím jsme vlastně zjistili aktuální datum, *)
(* protože jsme ten soubor právě vytvořili *)
writeln(d.day,'.', d.month,'.', d.year); (* vypíšeme základní údaje *)
end.