home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / kzr_0899.zip / b2x.CMD < prev    next >
OS/2 REXX Batch file  |  1998-07-31  |  7KB  |  256 lines
  1. /* REXX-Programm B2X.CMD                                 */
  2. /* B2X.CMD wandelt binäre Zahlen in hexadezimale Zahlen. */
  3.    Call RxFuncAdd 'SysLoadFuncs', RexxUtil, 'SysLoadFuncs'
  4.    Call SysLoadFuncs
  5.    Signal on syntax name B2XMsg
  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.    
  17.    /* Im Eingabestring strstr gibt es ein Komma. */
  18.    if Pos(",", strstr)>0 then
  19.    do
  20.      Call Komma strstr
  21.    end
  22.    
  23.    /* Zwischenräume aus dem String  strstr  entfernen */
  24.    do forever
  25.      lzw=Pos(" ", strstr)
  26.      if lzw = 0 then leave
  27.      strstr=DelStr(strstr,lzw,1)
  28.    end
  29.    
  30.    if (length(strstr)= 0) then
  31.    do
  32.      "start view.exe" Pfd||"KZR.INF B2X"
  33.      EXIT
  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, 'B')<>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, 'B')<>1 then Call EingStr stV
  53.      if length(strip(stN))>0 & DataType(stN, 'B')<>1 then Call EingStr stN
  54.    end
  55.  
  56. WW:
  57.    stV=strip(stV) 
  58.    if length(stV)>0 then 
  59.    do
  60.      stV=B2XInt(stV, NM)
  61.    end
  62.  
  63.    stN=strip(stN) 
  64.    if length(stN)>0 then
  65.    do
  66.      stN=B2XMant(stN, NM)
  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,"        Binär: "
  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,"  Hexadezimal: "
  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. B2XInt:
  94.    Procedure
  95.    parse upper arg s
  96.  
  97.    /* Durch Einfügen  f ü h r e n d e r  Ziffern  0                  */ 
  98.    /* die Länge des Strings auf ein ganzes Vielfaches von 4 bringen. */ 
  99.    do forever 
  100.      if length(s)//4 == 0 then leave
  101.      s=Insert("0", s, 0)
  102.    end /* do */
  103.  
  104.    /* Der ganzzahlige Anteil wird in Gruppen zu je 4 Stellen zerlegt. */
  105.    i=1
  106.    do forever
  107.      l.i=length(s);
  108.      if l.i==0 then leave
  109.      l.i=length(s); 
  110.      b.i=SubStr(s, l.i-3, 4)
  111.      s=DelStr(s, l.i-3, 4)
  112.      i=i+1
  113.    end /* do */
  114.    m=i
  115.    
  116.    HEX=""
  117.    do i=1 to m
  118.      /* Hier noch nicht A bis F für 10 bis 15 */
  119.      if DataType(strip(b.i), 'W')<>1 then leave
  120.      /* Umwandlung der Zahlen 10 bis 15 in die Buchstaben A bis F */
  121.      HEX=HEX||Bin2Hex(b.i)
  122.    end /* do */
  123.    HEX=REVERSE(HEX)
  124.  
  125.    /* Nullen am  A n f a n g   des Strings werden entfernt. */ 
  126.    do forever
  127.       if Pos("0", HEX, 1) <>1 then leave 
  128.       HEX=SubStr(HEX, 2)
  129.    end /* do */
  130.  
  131.    Return(HEX)
  132.  
  133.  
  134. B2XMant:
  135.    Procedure
  136.    parse upper arg s
  137.  
  138.    /* Durch Einfügen von Ziffern  0  am  E n d e  des Strings        */ 
  139.    /* die Länge des Strings auf ein ganzes Vielfaches von 4 bringen. */ 
  140.    do forever 
  141.      ls=length(s)
  142.      if ls//4 == 0 then leave
  143.      s=Insert("0", s, ls)
  144.    end /* do */
  145.    
  146.    i=1 ; HEX="."
  147.    do forever
  148.      l.i=length(s);
  149.      if l.i==0 then leave
  150.      l.i=length(s); 
  151.      b.i=SubStr(s, 1, 4)
  152.      HEX=HEX||Bin2Hex(b.i)
  153.      s=DelStr(s, 1, 4)
  154.      i=i+1
  155.    end /* do */
  156.  
  157.    /* Nullen am  E n d e  des Strings werden entfernt. */ 
  158.    do forever
  159.       l=length(HEX)
  160.       if Pos("0", HEX, l)==0 then leave 
  161.       HEX=DelStr(HEX, l)
  162.    end /* do */
  163.  
  164.    Return(HEX)
  165.  
  166.  
  167. Bin2Hex:
  168.   arg b
  169.   select
  170.     when b == 0000 then x = '0'
  171.     when b == 0001 then x = '1'
  172.     when b == 0010 then x = '2'
  173.     when b == 0011 then x = '3'
  174.     when b == 0100 then x = '4'
  175.     when b == 0101 then x = '5'
  176.     when b == 0110 then x = '6'
  177.     when b == 0111 then x = '7'
  178.     when b == 1000 then x = '8'
  179.     when b == 1001 then x = '9'
  180.     when b == 1010 then x = 'A'
  181.     when b == 1011 then x = 'B'
  182.     when b == 1100 then x = 'C'
  183.     when b == 1101 then x = 'D'
  184.     when b == 1110 then x = 'E'
  185.     when b == 1111 then x = 'F'
  186.   otherwise NOP
  187.   end  /* select */
  188.   Return(x)
  189.  
  190.  
  191. EingStr:
  192.   say
  193.   parse upper arg stst 
  194.   Call Color 1,White
  195.   Call Charout,"Sie haben in den String "
  196.   Call Color 1,Cyan
  197.   /* Für die Anzeige der aktuellen Berechnung sollen die von  B2X.CMD  */
  198.   /* in große Buchstaben umgewandelte kleinen Buchstaben wieder        */
  199.   /* in kleine Buchstaben umgewandelt werden.                          */
  200.   kl="abcdefghijklmnopqrstuvwxyzäöü";  gr="ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ"
  201.   stst=translate(stst, kl, gr)
  202.   Call Charout,stst; say
  203.   Call Color 1,White
  204.   Call Charout,"der Eingabe-Kette ein oder mehrere"; say
  205.   Call Charout,"für binäre Darstellung nicht erlaubte Zeichen eingegeben."; say
  206.   Beep(444, 200); Beep(628,300)
  207.   Signal PgmEnd
  208.  
  209.  
  210. Nichts:
  211.   say
  212.   Call Color 1,White
  213.   Call Charout,"Sie haben in die Eingabe-Kette"; say
  214.   Call Charout,"weder für den ganzzahligen Anteil noch für die Mantisse"; say
  215.   Call Charout,"eine Binärzahl eingegeben."; say
  216.   Beep(444, 200); Beep(628,300)
  217.   Signal PgmEnd
  218.  
  219.  
  220. Komma:
  221.   say
  222.   Call Color 1,White
  223.   Call Charout,"Sie haben in die Eingabe-Kette "
  224.   Call Color 1,Cyan
  225.   Call Charout,strstr; say
  226.   Call Color 1,White
  227.   Call Charout,"ein im Argument der Funktion "
  228.   Call Color 1,Green
  229.   Call Charout,"B2X.CMD"
  230.   Call Color 1,White
  231.   Call Charout," verbotenes Komma eingegeben."; say
  232.   Beep(444, 200); Beep(628,300)
  233.   Signal PgmEnd
  234.  
  235.  
  236. B2XMsg:
  237.    say
  238.    Call Color 1,White
  239.    Call Charout,"Sie haben bei der Eingabe der Umwandlungs-Aufgabe"; say
  240.    Call Charout,"eines oder mehrere für binäre Darstellung nicht erlaubte "
  241.    Call Charout,"Zeichen eingegeben."; say
  242.    Beep(444, 200); Beep(628,300)
  243.    Signal PgmEnd
  244.  
  245. /***************************** ANSI-Prozeduren ******************************/
  246.  
  247.  
  248. Color:     /* Call Color <Attr>,<ForeGround>,<BackGround>                */  
  249. Procedure  /* Attr=1 -> HIGH;  Attr=0 -> LOW; Attr only for ForeGround ! */
  250. arg A,F,B   
  251. CLRS = "BLACK RED GREEN YELLOW BLUE MAGENTA CYAN WHITE"
  252. A=strip(A); if length(A)==0 then A=0    
  253. F=strip(F); if length(F)==0 then F=WHITE
  254. B=strip(B); if length(B)==0 then B=BLACK
  255. return CHAROUT(,D2C(27)||"["A";"WORDPOS(F,CLRS)+29";"WORDPOS(B,CLRS)+39"m")
  256.