home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 02 / titel / list2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-11-26  |  1.8 KB  |  55 lines
  1. (* ------------------------------------------------------ *)
  2. (*     Hex-in-ASCII-Wandler für Turbo Pascal 4.0 - 5.5    *)
  3. (*         Listing 2: prozedurale Programmierung          *)
  4. (*             (c) 1991 G. Born & TOOLBOX                 *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM ASC;
  7.  
  8. TYPE
  9.   LongStr = STRING[80];
  10.  
  11. VAR
  12.   j     : INTEGER;
  13.   zchn  : LongStr;                (* eingelesenes Zeichen *)
  14.  
  15. (* ---- Hilfsroutinen ----------------------------------- *)
  16.  
  17.   PROCEDURE Error;
  18.     (* Abbruch mit Fehlermeldung *)
  19.   BEGIN
  20.     WriteLn('Fehler: falsche Hexzahl ', ParamStr(j));
  21.     Halt($FF);
  22.   END; (* Error *)
  23.  
  24.   FUNCTION asc_hex(text : LongStr) : BYTE;
  25.     (* Decodieren der Hexzahl *)
  26.   VAR
  27.     i, tmp : INTEGER;
  28.     zchn   : CHAR;
  29.     wert   : WORD;
  30.   BEGIN
  31.     wert := 0;                            (* init Wert    *)
  32.     FOR i := 1 TO Length(text) DO BEGIN   (* alle Ziffern *)
  33.       zchn := UpCase(text[i]);            (* hole Ziffer  *)
  34.       tmp  := Pos (zchn,'0123456789ABCDEF');
  35.                                           (* decodiere    *)
  36.       IF tmp = 0 THEN                     (* Fehler ?     *)
  37.         Error;
  38.       wert := wert * 16 + (tmp - 1);    (* addiere Ziffer *)
  39.     END;
  40.     asc_hex := Lo(wert);               (* Ergebnis zurück *)
  41.   END;  (* asc_hex *)
  42.  
  43. (* ---- Hauptprogramm ----------------------------------- *)
  44.  
  45. BEGIN
  46.   IF ParamCount > 0 THEN                (* lese Parameter *)
  47.     FOR j := 1 TO ParamCount DO BEGIN
  48.       zchn := ParamStr(j);              (* hole Parameter *)
  49.       IF Length (zchn) > 2 THEN         (* Fehler ?       *)
  50.         error;                          (* Exit           *)
  51.       Write (Chr(asc_hex(zchn)));       (* Ausgabe Hex    *)
  52.     END; (* FOR *)
  53.   Halt(0);                        (* Exit und setze Code  *)
  54. END.
  55.