home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / dos / upper.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-29  |  8.3 KB  |  226 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X-,Y-}
  2. (*===================================================================*)
  3. (*                            UPPER.PAS                              *)
  4. (*            Copyright (C) 1993 te-wi Verlag, München               *)
  5. (*-------------------------------------------------------------------*)
  6. (* Diese Unit demonstriert die Möglichkeiten, wie Upcase/Upstring    *)
  7. (* mehr oder minder erfolgreich und sinnvoll implementiert werden    *)
  8. (* können. Nach außen tritt nur die letzte Möglichkeit (Kombination) *)
  9. (* in Erscheinung. Zwischenlösungen sind nur intern realisiert.      *)
  10. (*===================================================================*)
  11.  
  12. UNIT UPPER;
  13.  
  14. INTERFACE
  15.  
  16. FUNCTION GetCodePage: WORD;           (* liefert die aktive Codepage *)
  17. FUNCTION SetCodePage(CP: WORD): INTEGER;(* setzt die aktive Codepage *)
  18.     (* Die Funktion meldet bei erfolgreicher Ausführung 0, sonst den *)
  19.     (* DOS-Errorcode zurück. Das Funktionsergebnis sollte also aus-  *)
  20.     (* gewertet werden, da nicht sicher ist, daß die Codepage-Um-    *)
  21.     (* schaltung auch installiert ist.                               *)
  22. FUNCTION UpCase(ch: CHAR): CHAR;       (* erweiterte Upcase-Funktion *)
  23. FUNCTION UpString(s: STRING): STRING;  (* erweiterte UpString-Funkt. *)
  24. FUNCTION StrUpper(s: pChar):  pChar;   (* UpString für               *)
  25.                                        (* nullterminierte Strings    *)
  26. IMPLEMENTATION
  27.  
  28. USES
  29.   Dos, DosUtil, Strings;
  30.  
  31. CONST
  32.   Dos330 = $31E; (* Codepages gibt es erst ab der DOS-Version 3.30,  *)
  33.                  (* dies ist der Code von DosVersion  = 3.30         *)
  34.                  (* bezogen auf die neuimplemetierte Version         *)
  35.  
  36.   Dos331 = $31F;(* DOS 3.31, diese Nummer liefern alle DR-DOS-       *)
  37.                 (* Versionen, dann muß man weiter im Environment     *)
  38.                 (* nach der DR-DOS-Version suchen (siehe DOSUTIL.PAS *)
  39.  
  40. FUNCTION DosVersion: WORD; ASSEMBLER;
  41. (* Die Funktion ist - bis auf die umgekehrte also eigentlich sinn-   *)
  42. (* volle Ausgabe der Versionsnummer identisch mit der Funktion der   *)
  43. (* Unit DOS. Identisch wäre: DosVersion := Swap(Dos.DosVersion);     *)
  44. ASM
  45.   MOV  AX, 3000h
  46.   INT  21h
  47.   XCHG AH, AL
  48. END;
  49.  
  50. FUNCTION StdUpCase(ch: CHAR): CHAR;
  51. (* Nachbildung der Standardfunktion UpCase wie sie auch in Borland   *)
  52. (* Pascal funktioniert                                               *)
  53. BEGIN
  54.   IF ch IN ['a'..'z'] THEN StdUpCase := Chr(Ord(ch) - 32)
  55.                       ELSE StdUpCase := ch;
  56. END;
  57.  
  58. FUNCTION UpCase437(ch: CHAR): CHAR;
  59. (* ein komplettes Upcase, das aber nur mit Codepage 437 funktioniert.*)
  60. BEGIN
  61.   CASE ch OF
  62.     'a'..'z': UpCase437 := Chr(Ord(ch) - 32);
  63.     'A'..'Z': UpCase437 := ch;
  64.     'ä'     : UpCase437 := 'Ä';
  65.     'ö'     : UpCase437 := 'Ö';
  66.     'ü'     : UpCase437 := 'Ü';
  67.     'å'     : UpCase437 := 'Å';
  68.     'é'     : UpCase437 := 'É';
  69.     'ñ'     : UpCase437 := 'Ñ';
  70.     'ç'     : UpCase437 := 'Ç';
  71.     'æ'     : UpCase437 := 'Æ'
  72.    ELSE       UpCase437 := ch;
  73.   END;
  74. END;
  75.  
  76. FUNCTION UpCaseCP(ch: CHAR): CHAR;
  77. (* Ausnutzung der landesspezifischen Informationen COUNTRY= für die  *)
  78. (* Umwandlung von Zeichen in Großbuchstaben. Die Zeichen werden an-  *)
  79. (* hand der DOS-Zeichensatztabelle konvertiert.                      *)
  80. VAR
  81.   Regs: Registers;
  82. BEGIN
  83.   IF DosVersion < Dos330 THEN UpCaseCP := UpCase(ch) ELSE
  84.   BEGIN
  85.     Regs.AX := $6520;
  86.     Regs.DL := Ord(ch);
  87.     MsDos(Regs);
  88.     IF Regs.Flags AND FCarry <> 0 THEN
  89.       UpCaseCP := UpCase(ch)
  90.     ELSE UpCaseCP := Chr(Regs.DL);
  91.   END;
  92. END;
  93.  
  94. FUNCTION StdUpString(s: STRING): STRING;
  95. VAR
  96.   i: BYTE;
  97. BEGIN
  98.   IF Length(s) > 0 THEN
  99.     FOR i := 1 TO Length(s) DO s[i] := StdUpCase(s[i]);
  100.   StdUpString := s;
  101. END;
  102.  
  103. FUNCTION UpString437 (s: STRING): STRING;
  104. (* Umwandlung von Strings in Großbuchstaben, nationale Sonderzeichen *)
  105. (* sind nach der konsequenten Umwandlung in UpCase437 berücksichtigt.*)
  106. (* Die Funktion arbeitet nur mit der Standard-Codepage 437 korrekt   *)
  107. VAR
  108.   i: BYTE;
  109. BEGIN
  110.   IF Length(s) > 0 THEN
  111.     FOR i := 1 TO Length(s) DO s[i] := UpCase437(s[i]);
  112.   UpString437 := s;
  113. END;
  114.  
  115. FUNCTION UpStringCP(s: STRING): STRING;
  116. (* Ausnutzung der landesspezifischen Informationen COUNTRY= für die  *)
  117. (* Umwandlung von Zeichenketten in Großbuchstaben. Die Zeichen wer-  *)
  118. (* den anhand der DOS-Zeichensatztabelle konvertiert. Diese Funktion *)
  119. (* arbeitet mit allen Codepages, aber nur für die jeweils länder-    *)
  120. (* spezifi-schen Sonderzeichen. Bei COUNTRY=049 (Deutschland) werden *)
  121. (* deshalb nur die Umlaute umgewandelt, nicht aber fränzösische,     *)
  122. (* skandinavische, spanische und sonstige Sonderzeichen              *)
  123. VAR
  124.   Regs: Registers;
  125. BEGIN
  126.   IF DosVersion < Dos330 THEN UpStringCP := UpString(s) ELSE
  127.   WITH Regs DO
  128.   BEGIN
  129.     AX := $6521;
  130.     CX := Ord(s[0]);
  131.     DS := Seg(s);
  132.     DX := Succ(Ofs(s));
  133.     MsDos(Regs);
  134.     IF Odd(Flags) THEN UpStringCP := s
  135.                   ELSE UpStringCP := UpString(s);
  136.   END;                 
  137. END;
  138.  
  139. FUNCTION StrUpper(s: pChar): pChar;
  140. (* Ausnutzung der landesspezifischen Informationen COUNTRY= für die  *)
  141. (* Umwandlung von pChars in Großbuchstaben. Die Zeichen werden an-   *)
  142. (* hand der DOS-Zeichensatztabelle konvertiert.                      *)
  143. VAR
  144.   Regs: Registers;
  145.   i   : BYTE;
  146.   c   : STRING;
  147. BEGIN
  148.   IF DosVersion < Dos330 THEN StrUpper := Strings.StrUpper(s)
  149.   ELSE
  150.   WITH Regs DO
  151.   BEGIN
  152.     AX := $6522;
  153.     DS := Seg(s^);
  154.     DX := Ord(s^);
  155.     MsDos(Regs);
  156.     IF Odd(Flags) THEN StrUpper := s
  157.                   ELSE StrUpper := Strings.StrUpper(s);
  158.   END;
  159. END;
  160.  
  161. FUNCTION SetCodePage(CP: WORD): INTEGER;
  162. (* Setzt die aktive Codeseite. Diese muß allerdings zuvor im DOS mit *)
  163. (* DISPLAY.SYS, MODE CON CP PREP= .... und NLSFUNC definiert sein.   *)
  164. (* Der Befehl entspricht dem DOS Befehl CHCP Codenummer. In Europa   *)
  165. (* werden normalerweise die Hardware-Codepage 437 (Standard) und     *)
  166. (* teilweise die internationale Codepage 850 eingesetzt und bei-     *)
  167. (* spielsweise von OS/2 auch so default eingestellt. Normalerweise   *)
  168. (* sind Codepages aber mehr »Ballaststoff« als sinnvolle Systemer-   *)
  169. (* weiterung und machen nur dann Sinn, wenn nicht nur der Rechner    *)
  170. (* sondern auch der Drucker die Codeseitenumschaltung unterstützt    *)
  171. (* (PRINTER.SYS und MODE PRN CP PREP= ....). Es sind aber fast nur   *)
  172. (* IBM-Drucker, die damit zurechtkommen.                             *)
  173. VAR
  174.   Regs: Registers;
  175. BEGIN
  176.   WITH Regs DO BEGIN
  177.     AX := $6602;            (* DOS-Funktion 66h: Get/Set Code Page  *)
  178.     BX := CP;               (* UF 2: Codepage setzen (lesen = 1)    *)
  179.     MsDos(Regs);            (* Nummer der Codepage in BX            *)
  180.     IF Odd(Flags) THEN SetCodePage := Regs.AX
  181.                   ELSE SetCodePage := 0;
  182.   END;
  183. END;
  184.  
  185. FUNCTION GetCodePage: WORD; ASSEMBLER; {Ermitteln der aktiven Codepage}
  186. ASM   
  187.   MOV AX, 6601h             (* DOS-Funktion 66h: Get/Set Code Page   *)
  188.   INT 21h                   (* UF 1: Codepage ermitteln (setzen = 2) *)
  189.   MOV AX, BX                            (* aktive Codepage von »CON« *)
  190. (* DX :=                           Hardware-Codepage bei Systemstart *)
  191. END;
  192.  
  193. FUNCTION UpCase(ch: CHAR): CHAR;
  194. (* So ist es jetzt (endlich) halbwegs sinnvoll: Es werden möglichst  *)
  195. (* viele Informationen ausgewertet und dann die bestmögliche Umwand- *)
  196. (* lung durchgeführt. Kompromißlösung, die aber in den meisten Fäl-  *)
  197. (* len gut einsetzbar ist. Wer die Funktion auch auf Codepage 850    *)
  198. (* (Europa) erweitern will, kann sich äquivalent zu Upcase437 auch   *)
  199. (* hier eine Tabelle aufbauen.                                       *)
  200. BEGIN
  201.   IF DosVersion < Dos330 THEN
  202.      UpCase := StdUpCase(ch) ELSE
  203.   BEGIN
  204.     IF GetCodePage  = 437 THEN
  205.       UpCase := UpCase437(ch)                       (* Standard      *)
  206.     ELSE
  207.       UpCase := UpCaseCP(ch);                       (* International *)
  208.   END;
  209. END;
  210.  
  211. FUNCTION UpString(s: STRING): STRING;      (* Kommentar siehe UpCase *)
  212. BEGIN
  213.   IF DosVersion < Dos330 THEN
  214.      UpString := StdUpString(s) ELSE
  215.   BEGIN
  216.     IF GetCodePage  = 437 THEN
  217.       UpString := UpString437(s)                    (* Standard      *)
  218.     ELSE
  219.       UpString := UpStringCP(s);                    (* International *)
  220.   END;
  221. END;
  222.  
  223. END.
  224.  
  225. (*===================================================================*)
  226.