Lekcja 8 - Obsługa DOS-a część 1
Źródła programów zamieszczonych w tej lekcji

Na tej lekcji dowiesz się jak utworzyć własną funkcję, jak sprawdzić długość zmiennej string, ale przede wszystkim zajmiemy się tym, co najczęściej robi się w DOS-ie i co można również wykonać za pomocą Pascal'owych procedur tzn. tworzenie/usuwanie katalogów, zmiana aktualnego dysku/katalogu, sprawdzanie w jakim katalogu akurat się znajdujemy i wyświetlanie aktualnej godziny/daty. Ta lekcja i następne będzie prowadzić do zrobienia czegoś w stylu "własnego Nortona" (BTW: mam źródła do Dos Navigatora 1.51 i jakby ktoś chciał to mogę podesłać).


Tworzenie Funkcji

Funkcje są podobne w tworzeniu do procedur z tym, że funkcja zazwyczaj zwraca pewną wartość. Przykładowymi funkcjami są np. pierwiastkowanie, sinus, cosinus ( funkcja nie musi koniecznie zwracać liczby, może to być każdy z typów zmiennych, np. char z ReadKey ).
Zrobimy sobie teraz prostą funkcję, która będzie nam zwracała kod wciśniętego klawisza z tym, że jeżeli to będzie klawisz rozszerzony to kod ten zostanie pomnożony przez 256. Dzięki temu klawisze zwykłe będą miały zawsze kody poniżej 255 a rozszerzone powyżej.

Uses CRT;
Var
  kl:word;

FUNCTION GetKey:word;                                            {1}
Var
 a1,a2:Char;
Begin
  Repeat Until Keypressed;                                       {2}
  a1:=ReadKey;                                                   {3}
  If a1=Chr(0) Then a2:=ReadKey;                                  {4}
  If a1<>Chr(0) Then GetKey:=Ord(a1) Else GetKey:=256*Ord(a2);    {5}
End;

Begin
  Repeat
    kl:=GetKey;                                                  {6}
    WriteLn(kl);                                                 {7}
  Until kl=27;                                                   {8}
End.
{1} zdefiniuj funkcję GetKey
{2} czekaj na wciśnięcie klawisza
{3} podstaw pod zmienną a1 wciśnięty klawisz
{4} jeżeli to był klawisz rozszerzony to podstaw go pod zmienną a2
{5} jeżeli to nie był klawisz rozszerzony to zwróć w funkcji kod ASCII znaku, w przeciwnym wypadku zwróć w funkcji kod klawisza rozszerzonego pomnożonego przez 256.

{6} pobierz kod klawisza
{7} wyświetl go
{8} powtórz aż zostanie wciśnięty klawisz ESCAPE

Zobacz teraz, na jakiej zasadzie jest zwracana wartość funkcji, a dzieje się to w linii {5}. Do nazwy funkcji jest podstawiana liczba, która mieści się w zakresie typu word. A musi się w nim mieścić gdyż zadeklarowaliśmy w linii {1}, że właśnie taki typ zwróci nam funkcja. Ot i cała filozofia :)

DORZUĆ TERAZ TĄ FUNKCJĘ DO NASZEJ BIBLIOTEKI

Funkcja Length

Składnia: Length(S:string):integer;

Funkcja zwraca długość zmiennej S np.

Var
  s:string;
Begin
  s:='Turbo Pascal';
  WriteLn('tekst: "',s,'" zawiera ',Length(s),' znakow');
End.

Procedura MkDir

Składnia: MkDir(nazwa:string); biblioteka: DOS

Procedura tworzy w bieżącym katalogu podkatalog "nazwa". Jeżeli już istnieje plik lub katalog "nazwa" to funkcja IOResult zwraca błąd 5 ( zabroniony dostęp do pliku ). Jeżeli katalog został utworzony bez problemu IOResult=0.

Oto przykładowy program bez sprawdzania poprawności utworzenia katalogu:

Uses DOS;

Begin
  MkDir('pascal');
End.
W tym wypadku, kiedy spróbujemy ponownie uruchomić program wyrzuci nam błąd "runtime error 5" ponieważ taki katalog już istnieje, a my nie obsługujemy błędów, które mogą powstać w czasie operacji dyskowych. Aby temu zaradzić należy wyłączyć kontrolę błędów przeprowadzaną przez system za pomocą dyrektywy {$i}:
Uses DOS;

Begin
  {$i-}                                           {1}
  MkDir('pascal');                                {2}
  If IOResult<>0 Then WriteLn('Wystapil blad');   {3}
  {$i+}                                           {4}
End.
{1} Wyłączam obsługę błędów operacji dyskowych za pomocą dyrektywy kompilatora.
{2} Utwórz katalog 'pascal'
{3} Jeżeli wystąpił jakiś błąd (np. katalog już istniał to wyświetl komunikat)
{4} Włącz spowrotem obsługę błędów

Oczywiście linię {3} można pominąć albo przerobić ją tak, aby np. zapisywała wszystkie błędy, które wystąpią do pliku errors.log

Procedura GetDir

Składnia: GetDir(D:byte; var S:string); biblioteka: DOS

Procedura pobiera do zmiennej S, nazwę bieżącego katalogu na dysku określonym zmienną D. Zmienna D przyjmuje wartości:

0 - dysk bieżący
1 - dysk A:
2 - dysk B:
3 - dysk C:
4 - dysk D:
itd.

Uwaga ! Jeżeli nie istnieje dysk określony zmienną D to procedura zwraca wartość jakby to był katalog główny tego dysku.

np.

Uses DOS;
Var
  katalog:string;

Begin
  GetDir(0,katalog);
  WriteLn('Aktualny dysk i katalog : ',katalog);
  GetDir(1,katalog);
  WriteLn('Aktualny katalog na dysku A : ',katalog);
  GetDir(3,katalog);
  WriteLn('Aktualny katalog na dysku C : ',katalog);
  GetDir(4,katalog);
  WriteLn('Aktualny katalog na dysku D : ',katalog);
  GetDir(15,katalog);
  WriteLn('Aktualny katalog na dysku O : ',katalog);
End.

Procedura ChDir

Składnia: ChDir(S:string); biblioteka: DOS

Procedura zmienia aktualny katalog i/lub dysk na ten, który był podany w parametrze S.
Uwaga ! Jeżeli procedura nie zostanie wykonana prawidłowo (np. brak podanego dysku lub katalogu ) to program zakończy się wyświetlając błąd "runtime error". Aby temu zaradzić ( podobnie jak w przypadku MkDir ) należy wyłączyć obsługę błędów dyskowych. Jeżeli jednak to zrobimy to nie będziemy pewni, że procedura wykonała się prawidłowo póki nie sprawdzimy zawartości funkcji IOResult np.

Uses DOS;

Begin
  {$i-}
  ChDir('pascal');             {1}
  If IOResult<>0 Then WriteLn('Wystapil blad przy przejsciu do katalogu pascal');
  ChDir('c:\dos');             {2}
  If IOResult<>0 Then WriteLn('Wystapil blad przy przejsciu do katalogu c:\dos');
  ChDir('c:\windows\pulpit');  {3}
  If IOResult<>0 Then WriteLn('Wystapil blad przy przejsciu do katalogu c:\windows\pulpit');
  ChDir('a:\');                {4}
  If IOResult<>0 Then WriteLn('Wystapil blad przy przejsciu do katalogu a:\');
  ChDir('d:');                 {5}
  If IOResult<>0 Then WriteLn('Wystapil blad przy przejsciu na dysk d:');

  {$i+}
End.
{1} przechodzi do katalogu 'pascal' znajdującego się w bieżącym katalogu
{2} zmienia dysk na C ( jeżeli byliśmy na innym dysku ) i przechodzi do katalogu '\dos'
{3} zmienia dysk na C ( jeżeli byliśmy na innym dysku ) i przechodzi do katalogu '\windows\pulpit '
{4} zmienia dysk na A ( jeżeli byliśmy na innym dysku ) i przechodzi do katalogu głównego
{5} zmienia dysk na D ( ale nie zmienia w nim katalogu ! tzn. jeżeli przeniosłeś się najpierw na 'd:\dos' potem na 'c:\windows' a potem spowrotem na 'd:' to wracasz do katalogu, który był bieżącym w momencie opuszczania tego dysku, czyli 'd:\dos')

Dzięki tej procedurze możemy sprawdzić np. jakie dyski mamy aktualnie dostępne w systemie np.
Uses DOS;
Var
 t:byte;
 s,stary:string;

Begin
  GetDir(0,stary);                                                   {1}
  {$i-}                                                              {2}
  For t:=Ord('C') To Ord('Z') Do                                     {3}
    Begin
     s:=Chr(t);                                                      {4}
     ChDir(s+':');                                                   {5}
     If IOResult=0 Then Write(s,' +     ') Else Write(s,' -     ');  {6}
    End;
  {$i+}                                                              {7}
  Chdir(stary);                                                      {8}
End.
{1} zapisz w zmiennej "stary" aktualny katalog, aby wrócić do niego po skończeniu sprawdzania dysków
{2} wyłącz sprawdzanie błędów
{3} sprawdzaj wszystkie dyski od C do Z
{4} zamień liczbę na tekst, który będzie nazwą dysku
{5} dodaj do litery dysku znaczek ":" czyli np. 'C'+':'='C:' i przejdź na ten dysk
{6} jeżeli nie wystąpił błąd to wypisz nazwę dysku ze znaczkiem "+" a jeżeli wystąpił wyświetl nazwę dysku ze znaczkiem "-"
{7} włącz obsługę błędów
{8} powróć do katalogu, który był bieżącym w momencie uruchamiania programu

Procedura RmDir

Składnia: RmDir(S:string); biblioteka: DOS

Procedura usuwa katalog o nazwie "S". UWAGA !!! KATALOG KONIECZNIE MUSI BYĆ PUSTY ! Jeżeli procedura nie zostanie wykonana prawidłowo (np. brak podanego katalogu lub nie był on pusty ) to program zakończy się wyświetlając błąd "runtime error". Aby temu zaradzić ( podobnie jak w przypadku MkDir i ChDir) należy wyłączyć obsługę błędów dyskowych. Jeżeli jednak to zrobimy to nie będziemy pewni, że procedura wykonała się prawidłowo póki nie sprawdzimy zawartości funkcji IOResult np.

Uses DOS;
Var
 blad:integer;

Begin
  {$i-}                                                         {1}
    RmDir('pascal');                                            {2}
    blad:=IOResult;                                             {3}
    If blad=0 Then WriteLn('Katalog usunięty') Else             {4}
      If blad=3 Then WriteLn('Brak katalogu') Else              {5}
        If blad=5 Then WriteLn('Katalog nie jest pusty') Else   {6}
          WriteLn('Nieznany blad');                             {7}
  {$i+}                                                         {8}
End.
Zwróć teraz uwagę, że nie pobierałem tutaj za każdym razem informacji z funkcji IOResult tylko wstawiłem ją w zmienną "blad". Zrobiłem to dlatego gdyż po odczytaniu kodu błędu z funkcji IOResult jest on kasowany i przy powtórnym odczycie uzyskalibyśmy wartość 0.

{1} wyłącz sprawdzanie błędów
{2} skasuj katalog 'pascal'
{3} wstaw do zmiennej "blad" kod błędu
{4} jeżeli nie było błędu to wyświetl tekst 'Katalog usunięty', w przeciwnym wypadku...
 {5} jeżeli wystąpił błąd 3 to wyświetl tekst 'Brak katalogu', w przeciwnym wypadku...
  {6} jeżeli wystąpił błąd 5 to wyświetl tekst 'Katalog nie jest pusty', w przeciwnym wypadku...
   {7} jeżeli wystąpił inny kod błędu ( czyli różny od 0,3 i 5 ) to wyświetl tekst 'Nieznany blad'
{8} włącz sprawdzanie błędów

Procedura GetDate

Składnia: GetDate(var Rok, Miesiac, Dzien, DzienTygodnia:word); biblioteka: DOS

Procedura pobierająca aktualną datę systemową. Poszczególne zmienne mogą zawierać wartości:

Rok : 1980 - 2099
Miesiac : 1 - 12
Dzien : 1 - 31
DzienTygodnia - 0 - 6 ( 0 = niedziela, 1 = poniedziałek, ... , 6 = sobota )

Tak więc z tego widać, że Pascal jest odporny na problem roku 2000 :)

Przykładowy program:

Uses DOS;
Const
  dni:array[0..6] of string=('Niedz','Pon','Wto','Sro','Czw','Pia','Sob');  {1}
Var
 rok,mies,dzien,dztyg:word;

Begin
 GetDate(rok,mies,dzien,dztyg);
 WriteLn('Dzisiejsza Data : ',dni[dztyg],'  ',dzien,'-',mies,'-',rok);
End.
Wynik tego programu to np.
Dzisiejsza Data : Sob  9-10-1999
{1} Zastosowałem tu jeszcze jedną rzecz, której nie było do tej pory mianowicie tablicę ale STAŁYCH ! Zadeklarowałem po prostu 7 elementów typu string, którym nadałem z góry wiadome niezmienialne wartości.

Reszty chyba tłumaczyć nie trzeba :)

Procedura GetTime

Składnia: GetTime(var Godzina, Minuta, Sekunda, SetnaSekundy:word); biblioteka: DOS

Procedura pobierająca aktualny czas systemowy. np.

Uses DOS;
Var
 godz,min,sek,sek100:word;

Begin
 GetTime(godz,min,sek,sek100);
 WriteLn('Aktualna Godzina : ',godz,':',min,':',sek,':',sek100);
End.
przykładowy wynik tego programu:
Aktualna Godzina : 14:6:1:81
Według mnie to trochę głupio wyglądają te minuty i sekundy takie pojedyncze cyferki, no i te setne możemy sobie podarować. Poprawiony programik wyglądałby mniej więcej tak:
Uses DOS;
Var
 godz,min,sek,sek100:word;
 sgodz,smin,ssek:string;

Begin
 GetTime(godz,min,sek,sek100);
 Str(godz,sgodz);                                         {1}
 If length(sgodz)=1 Then sgodz:='0'+sgodz;                {2}
 Str(min,smin);                                           {1}
 If length(smin)=1 Then smin:='0'+smin;                   {2}
 Str(sek,ssek);                                           {1}
 If length(ssek)=1 Then ssek:='0'+ssek;                   {2}
 WriteLn('Aktualna Godzina : ',sgodz,':',smin,':',ssek);
End.
Teraz wynik programu wygląda tak:
Aktualna Godzina : 14:06:01
Zasada działania jest prosta najpierw zamieniamy zmienną na tekst {1} i jeżeli długość tekstu jest jeden znak to dopisujemy do niego na początek '0' {2}. Na sam koniec wyświetlamy godzinę i gotowe. Ja bym w tym momencie pokusił się jeszcze o stworzenie własnej funkcji, która będzie zwracać godzinę już uformowaną w tekst.
Uses DOS;

FUNCTION AktualnyCzas:string;                   {1}
Var
 godz,min,sek,sek100:word;                      {2}
 sgodz,smin,ssek,tmps:string;                   {3}
Begin
 GetTime(godz,min,sek,sek100);
 Str(godz,sgodz);
 If length(sgodz)=1 Then sgodz:='0'+sgodz;
 Str(min,smin);
 If length(smin)=1 Then smin:='0'+smin;
 Str(sek,ssek);
 If length(ssek)=1 Then ssek:='0'+ssek;
 tmps:=sgodz+':'+smin+':'+ssek;                 {4}
 AktualnyCzas:=tmps;                            {5}
End;

Begin
  WriteLn(AktualnyCzas);                        {6}
End.
{1} utwórz funkcję AktualnyCzas
{2}{3} zmienne zamiast globalnie można zadeklarować lokalnie wewnątrz funkcji
{4} podstaw pod zmienną tmps aktualny czas
{5} zwróć wynik funkcji
{6} wyświetl zawartość funkcji

A jak jeszcze wrzucisz tą funkcję do naszej biblioteki GIGIKURS to program będzie wyglądać tak:
Uses DOS,GIGIKURS;

Begin
  WriteLn(AktualnyCzas);
End.
Prawda, że przejrzyście ? No to doszła nam kolejna funkcja :)

Na tym zakończymy tą lekcję. Na następnej będę kontynuował obsługę DOS'a już niewiele zostało ;-)

Powrot na Strone Glowna