Kendi Çapında Programlar
-
Çarpım Tablosu Programı
-----------------------
Uses crt;
VAR
I,J,K,SAT : BYTE;
TUS : CHAR;
BEGIN
CLRSCR;
K:=5; SAT:=2;
GOTOXY (30,1); WRITE( "C A R P I M T A B L O S U");
FOR I:=1 TO 10 DO
BEGIN
FOR J:=1 TO 10 DO
BEGIN
GOTOXY (K,SAT+J); WRITE(I:2," X", J:2," = ",I*J:3);
END;
K:=K+14;
IF I=5 THEN BEGIN K:=5; SAT:=13;
END;
TUS:=READKEY;
END.
-
Dos Ortamında Dizin Değiştirme
-------------------------------
uses crt,dos;
var
s:string;
begin
clrscr;
write('Geçilecek Dizin : ');
readln(s);
{$i-} chdir(s);
if ioresult<>0 then writeln(s, ' dizinine gecilemedi...');
end.
-
DOS Ortamında dizin(klasör) oluşturma.
---------------------------------------
uses crt,dos;
var
s:string;
begin
clrscr;
write('Yaratılacak Dizin İsmi : ');
readln(s);
{$i-} mkdir(s);
if ioresult<>0 then writeln(s, 'dizin olusmadi...');
end.
-
DOS ortamında Dosya Silmek
-------------------------------
uses crt,dos;
var
F: file;
Ch: Char;
begin
Assign(F, ParamStr(1));
{$I-}
Reset(F);
{$I+}
if IOResult <> 0 then
Writeln('Bulunamadi ', ParamStr(1))
else
begin
Close(F);
Write('Silindi ', ParamStr(1), '? ');
Readln(Ch);
if UpCase(CH) = 'Y' then
Erase(F);
end;
end.
-
Girilen Mesajı Tersten Yazdıran Program
----------------------------------------
USES CRT;
Var
Mesaj:String;
i:Byte;
Begin
Clrscr;
Write('Mesajı girin :');Readln(mesaj);
Clrscr;
For i :=Length(Mesaj) Downto 1 do
Write(Copy(Mesaj,i,1));
Readln;
End.
-
BIOS Tarihini Gosteren Program
-------------------------------
Program BIOS_Tarihi;
var
n : byte;
m : array[1..10] of char absolute $F000:$FFF5;
begin
writeln (' ');
write (' BIOS Tarihi : ');
for n:=1 to 10 do if (m[n] > #46) and (m[n] < #59) then Write(m[n]);
writeln (' ');
end.
Not:Bunu Ben Dogru Durust Çalıştıramadım..Sonra Sövmeyin Bu bozuk diye.
Toplam Hit: 2272 Toplam Mesaj: 6
