home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / kzr_0899.zip / x2b.CMD < prev    next >
OS/2 REXX Batch file  |  1998-07-31  |  6KB  |  233 lines
  1. /* REXX-Programm X2B.CMD                                    */
  2. /* X2B.CMD wandelt hexadezimale Zahlen in binäre Zahlen um. */
  3.    Call RxFuncAdd 'SysLoadFuncs', RexxUtil, 'SysLoadFuncs'
  4.    Call SysLoadFuncs
  5.    Signal on syntax name X2BMsg
  6.  
  7.    /* Die Dateien "kzr.INF" und "krz.CMD   */
  8.    /* befinden sich im selben Verzeichnis. */
  9.    Pfd=SysSearchPath("PATH", "kzr.cmd")
  10.    lp=LastPos("\", Pfd)
  11.    Pfd=DelStr(Pfd, 1+lp)
  12.  
  13.    Numeric Digits 24
  14.  
  15.    parse UPPER arg strstr
  16.    stE=strstr
  17.    /* Zwischenräume aus dem String  strstr  entfernen */
  18.    do forever
  19.      lzw=Pos(" ", strstr)
  20.      if lzw = 0 then leave
  21.      strstr=DelStr(strstr,lzw,1)
  22.    end
  23.  
  24.    if (length(strstr)= 0) then
  25.    do
  26.      "start view.exe" Pfd||"KZR.INF X2B"
  27.      EXIT
  28.    end
  29.  
  30.    /* Im Eingabestring strstr gibt es ein Komma. */
  31.    if Pos(",", strstr)>0 then
  32.    do
  33.      Call Komma strstr
  34.    end
  35.  
  36.    /* Im Eingabestring strstr gibt es keinen Punkt. */
  37.    if Pos(".", strstr)==0 then
  38.    do
  39.      stA=strstr 
  40.      stV=strstr
  41.      stN=""
  42.      if DataType(stV, 'X')<>1 then Call EingStr stV
  43.      Signal WW
  44.    end
  45.  
  46.    /* Im Eingabestring gibt es einen Punkt */
  47.    if Pos(".", strstr)>0 then
  48.    do
  49.      parse UPPER value strstr with stV '.' stN
  50.      stA=stV||'.'||stN
  51.      if length(strip(stV))=0 & length(strip(stN)) =0 then Call Nichts  
  52.      if length(strip(stV))>0 & DataType(stV, 'X')<>1 then Call EingStr stV
  53.      if length(strip(stN))>0 & DataType(stN, 'X')<>1 then Call EingStr stN
  54.    end
  55.  
  56. WW:
  57.    stV=strip(stV) 
  58.    if length(stV)>0 then 
  59.    do
  60.      stV=X2BInt(stV)
  61.    end
  62.  
  63.    stN=strip(stN) 
  64.    if length(stN)>0 then
  65.    do
  66.      stN=X2BMant(stN)
  67.    end
  68.   
  69.    stG=stV||stN
  70.  
  71.    /* Anfang der Ausgabe-Anweisungen */
  72.    say
  73.    Call Color 1,White
  74.    Call Charout,"  Eingabe:"; say
  75.    Call Color 1,Red
  76.    Call Charout,"  Hexadezimal: "
  77.    Call Color 1,White
  78.    Call Charout,stA; say; say
  79.    Call Color 1,White
  80.    Call Charout,"  Ausgabe:"; say
  81.    Call Color 1,green
  82.    Call Charout,"        Binär: "
  83.    Call Color 1,White
  84.    Call Charout,strip(stG); say
  85.    /* Ende der Ausgabe-Anweisungen */
  86.  
  87. PgmEnd:
  88.    say
  89.    Call Color 0,White
  90. EXIT
  91.  
  92.  
  93. X2BInt:
  94.    Procedure
  95.    parse upper arg s
  96.  
  97.    /* Der ganzzahlige Anteil wird in die einzelnen HEX-Ziffern zerlegt */
  98.    /* und in binäre Zahlen mit je 4 Ziffern 1 oder 0 umgewandelt.      */
  99.    i=1; BIN=""
  100.    do forever
  101.      l.i=length(s)
  102.      if l.i==0 then leave
  103.      b.i=SubStr(s, 1, 1)
  104.      s=DelStr(s, 1, 1)
  105.      BIN=BIN||Hex2Bin(b.i)
  106.      i=i+1
  107.    end /* do */
  108.  
  109.    /* Nullen am  A n f a n g   des Strings werden entfernt. */ 
  110.    do forever
  111.       if Pos("0", BIN, 1) <>1 then leave 
  112.       BIN=SubStr(BIN, 2)
  113.    end /* do */
  114.  
  115.    Return(BIN)
  116.  
  117.  
  118. X2BMant:
  119.    Procedure
  120.    parse upper arg s
  121.  
  122.    
  123.    /* Die Mantisse wird in die einzelnen HEX-Ziffern zerlegt      */
  124.    /* und in binäre Zahlen mit je 4 Ziffern 1 oder 0 umgewandelt. */
  125.    i=1 ; BIN="."
  126.    do forever
  127.      l.i=length(s);
  128.      if l.i==0 then leave
  129.      b.i=SubStr(s, 1, 1)
  130.      BIN=BIN||Hex2Bin(b.i)
  131.      s=DelStr(s, 1, 1)
  132.      i=i+1
  133.    end /* do */
  134.  
  135.    /* Nullen am  E n d e  des Strings werden entfernt. */ 
  136.    do forever
  137.       l=length(BIN)
  138.       if Pos("0", BIN, l)==0 then leave 
  139.       BIN=DelStr(BIN, l)
  140.    end /* do */
  141.  
  142.    Return(BIN)
  143.  
  144.  
  145. Hex2Bin:
  146.   arg b
  147.   select
  148.     when b == '0' then x = 0000
  149.     when b == '1' then x = 0001
  150.     when b == '2' then x = 0010
  151.     when b == '3' then x = 0011
  152.     when b == '4' then x = 0100
  153.     when b == '5' then x = 0101
  154.     when b == '6' then x = 0110
  155.     when b == '7' then x = 0111
  156.     when b == '8' then x = 1000
  157.     when b == '9' then x = 1001 
  158.     when b == 'A' then x = 1010
  159.     when b == 'B' then x = 1011
  160.     when b == 'C' then x = 1100
  161.     when b == 'D' then x = 1101
  162.     when b == 'E' then x = 1110
  163.     when b == 'F' then x = 1111
  164.   otherwise NOP
  165.   end  /* select */
  166.   Return(x)
  167.  
  168.  
  169. EingStr:
  170.   say
  171.   parse upper arg stst 
  172.   Call Color 1,White
  173.   Call Charout,"Sie haben in den String "
  174.   Call Color 1,Cyan
  175.   /* Für die Anzeige der aktuellen Berechnung sollen die von  X2B.CMD  */
  176.   /* in große Buchstaben umgewandelte kleinen Buchstaben wieder        */
  177.   /* in kleine Buchstaben umgewandelt werden.                          */
  178.   kl="abcdefghijklmnopqrstuvwxyzäöü";  gr="ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ"
  179.   stst=translate(stst, kl, gr)
  180.   Call Charout,stst; say
  181.   Call Color 1,White
  182.   Call Charout,"der Eingabe-Kette ein oder mehrere"; say
  183.   Call Charout,"für hexadezimale Darstellung nicht erlaubte Zeichen eingegeben."; say
  184.   Beep(444, 200); Beep(628,300)
  185.   Signal PgmEnd
  186.  
  187.  
  188. Nichts:
  189.   say
  190.   Call Color 1,White
  191.   Call Charout,"Sie haben in die Eingabe-Kette"; say
  192.   Call Charout,"weder für den ganzzahligen Anteil noch für die Mantisse"; say
  193.   Call Charout,"eine Hexadezimalzahl eingegeben."; say
  194.   Beep(444, 200); Beep(628,300)
  195.   Signal PgmEnd
  196.  
  197.  
  198. Komma:
  199.   say
  200.   Call Color 1,White
  201.   Call Charout,"Sie haben in die Eingabe-Kette "
  202.   Call Color 1,Cyan
  203.   Call Charout,strstr; say
  204.   Call Color 1,White
  205.   Call Charout,"ein im Argument der Funktion "
  206.   Call Color 1,Green           
  207.   Call Charout,"X2B.CMD"
  208.   Call Color 1,White
  209.   Call Charout," verbotenes Komma eingegeben."; say
  210.   Beep(444, 200); Beep(628,300)
  211.   Signal PgmEnd
  212.  
  213.  
  214. X2BMsg:
  215.    say
  216.    Call Color 1,White
  217.    Call Charout,"Sie haben bei der Eingabe der Umwandlungs-Aufgabe"; say
  218.    Call Charout,"eines oder mehrere für hexadezimale Darstellung "; say
  219.    Call Charout,"nicht erlaubte Zeichen eingegeben."; say
  220.    Beep(444, 200); Beep(628,300)
  221.    Signal PgmEnd
  222.  
  223. /***************************** ANSI-Prozeduren ******************************/
  224.                           
  225. Color:     /* Call Color <Attr>,<ForeGround>,<BackGround>                */  
  226. Procedure  /* Attr=1 -> HIGH;  Attr=0 -> LOW; Attr only for ForeGround ! */
  227. arg A,F,B   
  228. CLRS = "BLACK RED GREEN YELLOW BLUE MAGENTA CYAN WHITE"
  229. A=strip(A); if length(A)==0 then A=0    
  230. F=strip(F); if length(F)==0 then F=WHITE
  231. B=strip(B); if length(B)==0 then B=BLACK
  232. return CHAROUT(,D2C(27)||"["A";"WORDPOS(F,CLRS)+29";"WORDPOS(B,CLRS)+39"m")
  233.