Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Convert binary to decimal format

Status
Not open for further replies.

misi444

Technical User
Aug 21, 2009
14
LV
need help modify code to convert binary to decimal format, with option to set custom delimiter. Existing code converts binary to HEX format.

Code:
//*****************************************************************//
//                                                                 //
//  Binary to Hexadecimal conversion Demo                          //
//  Copyright© BrandsPatch LLC                                     //
//  [URL unfurl="true"]http://www.explainth.at[/URL]                                        //
//                                                                 //
//  All Rights Reserved                                            //
//                                                                 //
//  Permission is granted to use, modify and redistribute          //
//  the code in this Delphi unit on the condition that this        //
//  notice is retained unchanged.                                  //
//                                                                 //
//  BrandsPatch  declines all responsibility for any losses,       //
//  direct or indirect, that may arise  as a result of using       //
//  this code.                                                     //
//                                                                 //
//*****************************************************************//
unit Converter;

interface

uses Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
     Dialogs,StdCtrls,Buttons,ExtCtrls,ComCtrls;

type TMaster = class(TForm)
  pgcDemo:TPageControl;
  tsReadMe:TTabSheet;
  tsDemo:TTabSheet;
  sbnBrowse:TSpeedButton;
  ledFile:TLabeledEdit;
  btnConvert:TButton;
  memInfo:TMemo;
  richInfo:TRichEdit;
  procedure DoBrowse(Sender:TObject);
  procedure DoConvert(Sender:TObject);
  procedure FormCreate(Sender:TObject);
private
  FFile:String;
public
end;

var Master:TMaster;

implementation

{$R *.dfm}
{$R WindowsXP.RES}

procedure TMaster.FormCreate(Sender:TObject);
var AFile:String;
begin
  AFile:=Format('%sReadMe.RTF',[ExtractFilePath(Application.EXEName)]);
  if FileExists(AFile) then richInfo.Lines.LoadFromFile(AFile);
end;

procedure TMaster.DoBrowse(Sender:TObject);
var AFlag:Boolean;
begin
  with TOpenDialog.Create(Self) do
  try
    Title:='Select a file';
    InitialDir:=ExtractFilePath(Application.ExeName);
    Options:=[ofFileMustExist];
    AFlag:=Execute;
    FFile:=FileName;
  finally Free end;

  AFlag:=AFlag and FileExists(FFile);
  btnConvert.Enabled:=AFlag;
  if AFlag then memInfo.Clear;
  ledFile.Text:=FFile;
end;

type TByteArray = array[0..MAXINT - 1] of Byte;
     TCharArray = array[0..MAXINT - 1] of Char;
     TBackArray = array['0'..'F'] of Byte;
     TTwoChar = array[0..1] of Char;
     TShifts = array[0..1] of Byte;
     TByteHex = array[0..255] of TTwoChar;
     PByteArray = ^TByteArray;
     PCharArray = ^TCharArray;

const BackArray:TBackArray = (0,1,2,3,4,5,6,7,8,9,
                              0,0,0,0,0,0,0,
                            //:,;,<,=,>,?,@
                              10,11,12,13,14,15);

{The hex chars we need to back convert are 0-9 and A-F.
 Trouble is there is in the ASCII character set there
 is a a gap between the 9 and the A occupied by the
 characters :;<=>? & @. We DONT want to slow down back
 conversion by doing any conditional tests. So we simply
 create a contiguious lookup table from 0 to F. The
 table elements from : to @ don't really matter - they
 will never get referenced}

      Shifts:TShifts = (0,4);

var ByteHex:TByteHex;

procedure BackConvert(P2:PCharArray;ASize:Integer;AFile:String;ALines:TStrings);
var i,j,k,BSize,ATime:Integer;
    P1:PByteArray;
    BFile:String;
begin
  BSize:=ASize shr 1;
  dec(ASize);
  P1:=AllocMem(BSize);
  {backconverted file will be half as long - one byte
  for every two hex chars}
  ATime:=GetTickCount;//when did we start
  try
    j:=0;k:=1;
    for i:=0 to ASize do
    begin
      P1^[j]:=P1^[j] or (BackArray[P2[i]] shl Shifts[k]);
      {On each even iteration we need to interpet the
       hex character after doing a left shift of 4. For
       instance, take the hex pair FF. The second F should
       result in P1^[j] being set to 15, $F. But the first
       F should increment P1^[j] by $F shl 4. We use the
       Shifts lookup table for this purpose. A left shift of
       zero is pointless but faster than a conditional test.

       Remember that byte order on Wintel machines is back to
       front? That is why we need to left shift the odd hex
       characters!}
      k:=1 - k;
      inc(j,k);
      {We OR the SAME memory location for every odd-even pair
       of hex chars. How do we ensure that we move to the next
       memory loation on each odd iteration of the loop? A
       conditional test would be too time consuming so we do
       some simple math instead. k flip-flops between 1 and 0.
       Incrementing j by k when it is 0 changes nothing but when
       it is 1 it causes the memory location being addressed,
       P1^[j] to change}
    end;
    ATime:=GetTickCount - ATime;//how long did it take
    BFile:=ChangeFileExt(AFile,'.unhex');
    ALines.Add(Format('%s converted back to %s in %d ms',[ExtractFileName(AFile),BFile,ATime]));
    with TMemoryStream.Create do
    try
      WriteBuffer(P1^,BSize);
      SaveToFile(BFile);
    finally Free end;
  finally ReAllocMem(P1,0) end;
  ALines.Add(Format('%s is identical to the original file',[ExtractFileName(BFile)]));
end;

procedure ConvertFile(AFile:String;ALines:TStrings);
var i,j,ASize,ATo:Integer;
    AStream:TMemoryStream;
    P1:PByteArray;
    P2:PCharArray;
    BFile:String;

  procedure SaveAsString;
  begin
    with TMemoryStream.Create do
    try
      WriteBuffer(P2^,ASize shl 1);
      SaveToFile(BFile);
    finally Free end;
  end;

begin
  AStream:=TMemoryStream.Create;
  with AStream do
  try
    LoadFromFile(AFile);
    ASize:=Size;j:=0;
    P1:=Memory;
    P2:=AllocMem((ASize + 1) shl 1);
    {The hexadecimal representation will be twice as large as
    the original file - two hex characters per byte!}
    ATo:=GetTickCount;//when did we start
    for i:=0 to ASize - 1 do
    begin
      Move(ByteHex[P1^[i]],P2^[j],2);
      {write the two char hex representation of
       each byte in the original file. With ByteHex
       having been built already all that is required
       is a very fast table lookup}
      inc(j,2);
    end;
    ATo:=GetTickCount - ATo;
    {How much time did it take? Note that such time
     estimates in a multi-tasking OS are inherently
     unreliable}
    BFile:=ChangeFileExt(AFile,'.hex');
    ALines.Add(Format('%s converted to %s in %d ms',[ExtractFileName(AFile),BFile,ATo]));
    SaveAsString;
    BackConvert(P2,ASize shl 1,BFile,ALines);
  finally
    AStream.Free;
    ReAllocMem(P2,0);
  end;
end;

procedure TMaster.DoConvert(Sender:TObject);
begin
  if FileExists(FFile) then
  begin
    memInfo.Clear;
    ConvertFile(FFile,memInfo.Lines);
  end;
end;

procedure Initiate;
var i:Integer;
begin
  for i:=0 to 255 do Move(PChar(IntToHex(i,2))^,ByteHex[i],2);
  {We create a lookup table containing the two character
   hexadecimal string representation of all byte values
   from 0 to 255}
end;


initialization Initiate;

end.
 
heres a start.
Code:
function BinToInt(Value: string): Integer; 
var 
  i, iValueSize: Integer; 
begin 
  Result := 0; 
  iValueSize := Length(Value); 
  for i := iValueSize downto 1 do 
    if Value[i] = '1' then Result := Result + (1 shl (iValueSize - i)); 
end;



Aaron
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top