home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / pstoolbx / kaldos.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-07-28  |  2.8 KB  |  122 lines
  1. UNIT KalDos;
  2. {$X+,F+,O+,D-,L-,R-,B-}
  3. INTERFACE
  4.  
  5. USES Dos, MsgBox;
  6.  
  7. CONST
  8.   KalExt = '.GK3'; { Standarderweiterungen der Kalender-Definitionsdateien }
  9.  
  10. FUNCTION IOResult: INTEGER;
  11. PROCEDURE MakeKalenderFileName(VAR Name: PathStr);
  12. FUNCTION FileExists(Name: PathStr): BOOLEAN;
  13. PROCEDURE Dateifehler(Code: INTEGER);
  14.  
  15. { Wandelt c in Großbuchstaben um }
  16. FUNCTION UCase(c: CHAR): CHAR;
  17.  
  18. { Wandelt s in Großbuchstaben um }
  19. FUNCTION Gross(s: STRING): STRING;
  20.  
  21. { Gibt Datum als String in der Form tt.mm.jjjjj zurück                     }
  22. { Nullen werden durch Leerzeichen ersetzt                                  }
  23. FUNCTION MakeDateString(t,m,j: INTEGER): STRING;
  24.  
  25.  
  26. IMPLEMENTATION
  27.  
  28. FUNCTION IOResult: INTEGER;
  29. BEGIN
  30.   IOResult := System.IOResult
  31. END;
  32.  
  33. FUNCTION FileExists(Name: PathStr): BOOLEAN;
  34. BEGIN
  35.   FileExists := FSearch(Name,'') <> ''
  36. END;
  37.  
  38. PROCEDURE Dateifehler(Code: INTEGER);
  39. VAR s: STRING;
  40.     p: POINTER;
  41. BEGIN
  42.   CASE Code OF
  43.     0: EXIT;
  44.     2: s := 'Datei nicht gefunden';
  45.     3: s := 'Pfad nicht gefunden';
  46.     4: s := 'Zu viele geöffnete Dateien';
  47.     5: s := 'Dateizugriff verweigert';
  48.     15, 151: s := 'Ungültiges Laufwerk';
  49.     100, 160: s := 'Lesefehler';
  50.     101, 161: s := 'Schreibfehler';
  51.     150: s := 'Schreibschutzfehler';
  52.     152: s := 'Laufwerk nicht bereit';
  53.     154: s := 'Prüfsummenfehler';
  54.     156: s := 'Kopf-Positionierungsfehler';
  55.     157: s := 'Unbekanntes Sektorformat';
  56.     158: s := 'Sektor nicht gefunden';
  57.     ELSE s := 'Unbekannter Fehler'
  58.   END;
  59.   p := @s;
  60.   MessageBox(^c'%s!',@p,mfError+mfOkButton)
  61. END;
  62.  
  63. FUNCTION ExePath: PathStr;
  64. VAR DirS : DirStr;
  65.     NameS: NameStr;
  66.     ExtS : ExtStr;
  67. BEGIN
  68.   FSplit(ParamStr(0),DirS,NameS,ExtS);
  69.   ExePath := DirS+NameS
  70. END;
  71.  
  72. PROCEDURE MakeKalenderFileName(VAR Name: PathStr);
  73. VAR DirS : DirStr;
  74.     NameS: NameStr;
  75.     ExtS : ExtStr;
  76. BEGIN
  77.   FSplit(Name,DirS,NameS,ExtS);
  78.   IF ExtS = '' THEN Name := Name+KalExt;
  79.   Name := FSearch(Name,ExePath+';'+GetEnv('PATH'));
  80.   IF Name <> '' THEN BEGIN
  81.     FSplit(Name,DirS,NameS,ExtS);
  82.     IF DirS = '' THEN Name := FExpand(Name)
  83.   END
  84. END;
  85.  
  86. FUNCTION UCase(c: CHAR): CHAR;
  87. BEGIN
  88.   CASE c OF
  89.     'a'..'z': Dec(c,$20);
  90.     'ö': c := 'Ö';
  91.     'ä': c := 'Ä';
  92.     'ü': c := 'Ü';
  93.     'ß': c := 'S';
  94.     'ê','ë','è','é': c := 'É';
  95.     'á','à','â': c := 'A';
  96.     'î','í','ì': c := 'I';
  97.     'æ': c := 'Æ';
  98.     'å': c := 'Å';
  99.     'û','ú','ù': c := 'U';
  100.     'ñ': c := 'Ñ';
  101.   END;
  102.   UCase := c
  103. END;
  104.  
  105. FUNCTION Gross(s: STRING): STRING;
  106. VAR i: BYTE;
  107. BEGIN
  108.   FOR i := 1 TO Length(s) DO s[i] := UCase(s[i]);
  109.   Gross := s
  110. END;
  111.  
  112. FUNCTION MakeDateString(t,m,j: INTEGER): STRING;
  113. VAR s: STRING[20]; s1: STRING[5];
  114. BEGIN
  115.   Str(t:2,s);
  116.   Str(m:2,s1);
  117.   s := s+'.'+s1+'.';
  118.   Str(j:5,s1);
  119.   MakeDateString := s+s1
  120. END;
  121.  
  122. END.