Chiffre BinärtoText TexttoBinär

[pirechner]

So, tach auch!
Dieses Programm liegt hier schon ne ganze Zeit bei mir ungenutzt rum, da ich nicht gedächt hätte, dass andere das brauchen könnten (siehe Zeitmaschinen-Thread).

Enthaltenden Ordner(mit Sourcen)
Direktlink zum Programm

Größe ca. 376 KB

Viel Spass damit!


Es wurden nur Standardkomponenten verwendet.

[PierreB]

Moin,

ich wollte das grad testen und hab dazu mal den "Code" aus dem Zeitmaschinenthread eingegeben:

Zitat:

01000100 01110101 00100000 01110011 01101111 01101100 01101100 01110011 01110100 00100000 01000010 01100001 01100011 01101011 01110101 01110000 00100111 01110011 00100000 01101101 01100001 01100011 01101000 01100101 01101110 00100001 00100001

Leider übersetzt er aber nur 'Du sollst Bac', und mehr nicht. Dann kommt noch ne Fehlermeldung:

Zitat:

'' ist kein gültiger Integerwert

Is also noch irgendwo der Wurm drin.

[pirechner]

ja in ein Edit kann man leider kein Enter/ Zeilenumbruch eingeben bzw. auch nicht hineinkopieren. War mir auch schon aufgefallen!

[PierreB]

Dann machs doch einfach mit nem TMemo oder TRichedit.

[pirechner]

Jeder darf am Quelltext etc. soviel 'rumfrickeln' wie er will.
Ist wohl eher Opensource als Freeware, wie mir gerade auffällt.

[glkgereon]

Ich hab das ganze mal mit Memos gebastelt...

Delphi-Quellcode:

procedure TForm1.Button2Click(Sender: TObject);
//TextToBin
var i, j:Integer;
    T: String;
begin
  Memo2.Lines.Clear;
  for i:=0 to Memo1.Lines.Count-1 do
    begin
    T:='';
    for j:=1 to Length(Memo1.Lines[i]) do
      T:=T+IntToBin(Ord(Memo1.Lines[i][j]))+' ';
    Memo2.Lines.Add(T);
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
//BinToText
var i, j:Integer;
    T, T2: String;
begin
  Memo2.Lines.Clear;
  T:=Memo1.Text;
  for i:=Length(T) downto 1 do
    if (T[i]<>'1') and (T[i]<>'0') then Delete(T,i,1);
  T2:='';
  while Length(T)>0 do
    begin
    T2:=T2+Chr(BinToInt(copy(T,1,8)));
    Delete(T,1,8);
    end;
  Memo2.Lines.Add(T2);
end;

[Eichhoernchen]

mann muss einen Zeileumbruch abfangen der ja #10#13 entspricht!

ich hab mich auchmal versucht sowas zu Programmieren:

Delphi-Quellcode:

function TBin.texttobin(s : string) : string;
var i, j : integer;
    c : char;
Begin
 result := '';
 for i := 1 to length(s) do
  Begin
   c := s[i];
   if s[i] = #10
     then Begin
           result := result + #10;
           continue;
          end
     else if s[i] = #13
            then Begin
                  result := result + #13;
                  continue;
                 end;
   for j := 7 downto 0 do
     if byte(c) and (1 shl j) <> 0
       then result := result + '1'
       else result := result + '0';
   result := result + ' ';
  end;
end;

function TBin.bintotext(s : string) : string;
var i, preres, j : integer;
    b : string;
Begin
 result := '';
 i := 1;
 while i < length(s) do
  Begin
    preres := 0;
    b := '';
    if s[i] = ' '
      then Begin
            inc(i);
            continue;
           end
      else if (s[i] = #10)
              then Begin
                    inc(i,2);
                    result := result + #10;
                    continue;
                   end
              else if (s[i] = #13)
                      then Begin
                            inc(i,2);
                            result := result + #13;
                            continue;
                           end;
    for j := i to i+7 do
     b := b + s[j];
    for j := 8 downto 1 do
     preres := preres + (StrToInt(b[j]) shl (8-j));
   result := result + chr(preres);
   inc(i, 8);
  end;
end;

[glkgereon]

Also, ich hab das ganze nochmal geschrieben.

Was es kann:
- umformen in jede basis (nicht nur Binär)
- Zurückumformen aus jeder Basis

Zeilenumbrücher ignoriere ich einfach, beim zurückkonvertieren werden sie ja eh wiederhergestellt^^

Mein Formular:
2 Memos, ein SpinEdit und zwei Buttons

Die Umrechnungen entstammen übrigens der Unit UBase2Base von mir die afaik auch in der CodeLib steht.

Delphi-Quellcode:

function Potenz(Base, Exp : Integer):Int64;
var i:Integer;
begin
   Result:=1;
   for i:=1 to Exp do Result:=Result * Base;
end;

function GetChar(Number: Integer):Char;
begin
  if Number<10 then Result:=Chr(Number+48)
  else if Number<91 then Result:=Chr(Number+55)
  else Result:=' ';
end;

function GetInt(Value: Char):Integer;
begin
  Result:=Ord(Value);
  if Result<58 then Result:=Result-48
  else if Result<91 then Result:=Result-55
  else Result:=0;
end;

function DecToBase(Value:Int64; Base:Integer):String;
var Rest:Integer;
begin
  Result:='';
  repeat
    Rest:=Value Mod Base;
    Value:=Value Div Base;
    Result:=GetChar(Rest) + Result;
  until Value=0;
end;

function BaseToDec(Value:String; Base:Integer):Int64;
var i, j:Integer;
begin
  Value:=Trim(Value);
  j:=Length(Value)-1;
  Result:=0;
  for i:=1 to Length(Value) do
    begin
    Result:=Result + GetInt(Value[i]) * Potenz(Base,j);
    dec(j);
    end;
end;

function Code(Val: String; Base: Integer):String;
var i:Integer;
begin
  Result:='';
  for i:=1 to Length(Val) do
    Result:=Result+DecToBase(Ord(Val[i]),Base)+' ';
end;

function DeCode(Val: String; Base: Integer):String;
var P: Integer;
    A: String;
begin
  Result:='';
  P:=Pos(' ',Val);
  while P>1 do
    begin
    A:=copy(Val,1,P);
    Result:=Result+Chr(BaseToDec(A,Base));
    Delete(Val,1,P);
    P:=Pos(' ',Val);
    end;
end;

Edit: Schön verpackt^^
BTW:
Basis 2: 1000101 1100100 1101001 1110100 111010 100000 1010011 1100011 1101000 11110110 1101110 100000 1110110 1100101 1110010 1110000 1100001 1100011 1101011 1110100 1011110 1011110
Basis 4: 1011 1210 1221 1310 322 200 1103 1203 1220 3312 1232 200 1312 1211 1302 1300 1201 1203 1223 1310 1132 1132
Basis 16: 45 64 69 74 3A 20 53 63 68 F6 6E 20 76 65 72 70 61 63 6B 74 5E 5E