Analitcs

Pesquisar no conteúdo do blog.atlabs.com.br

sexta-feira, 4 de abril de 2014

DELPHI - Conversor de binário para String / Binary to String

Reações: 


unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type

  TForm1 = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  sA, sB : String;
  I : Integer;
  Function BinToHex(BinStr : String) : String;
    Const
      BinArray: array[0..15, 0..1] of string =
             (('0000', '0'), ('0001', '1'), ('0010', '2'), ('0011', '3'),
              ('0100', '4'), ('0101', '5'), ('0110', '6'), ('0111', '7'),
              ('1000', '8'), ('1001', '9'), ('1010', 'A'), ('1011', 'B'),
              ('1100', 'C'), ('1101', 'D'), ('1110', 'E'), ('1111', 'F'));
    var
      Error: Boolean;
      j: Integer;
      BinPart: string;
    begin
      Result:='';
      Error:=False;
      for j:=1 to Length(BinStr) do
        if not (BinStr[j] in ['0', '1']) then
        begin
          Error:=True;
          Continue;
        end;
      if not Error then
      begin
        case Length(BinStr) mod 4 of
          1: BinStr:='000'+BinStr;
          2: BinStr:='00'+BinStr;
          3: BinStr:='0'+BinStr;
        end;
        while Length(BinStr)>0 do
        begin
          BinPart:=Copy(BinStr, Length(BinStr)-3, 4);
          Delete(BinStr, Length(BinStr)-3, 4);
          for j:=1 to 16 do
            if BinPart=BinArray[j-1, 0] then
              Result:=BinArray[j-1, 1]+ Result;
        end;
      end;
    end;
    function HexToString(S : string) : string;
    var
      Str : String;
      i   : Integer;
    begin
      I := 1;
      while I <= Length(S) do
      begin
        Str := Str + Char(StrToInt('$' + Copy(S, I, 2)));
        I := I + 2;
      end;
      Result := Str;
    end;
begin
  sA := Memo1.Lines.Text;
  // Limpa a string caso tenha lixo dentro do binário
  For I := 1 to Length(sA) do
  begin
    Case sA[I] of
      '0','1' : sB := sB + sA[I];
    end;
  End;
  //----------------
  Memo2.Lines.Text := HexToString(BinToHex(sB));
end;
end.

Nenhum comentário:

Postar um comentário

Observação: somente um membro deste blog pode postar um comentário.

Max Gehringer