急！急！200分解决小问题！关于进制转换，谢谢！(200分)

一个计算器的小程序，在二进制与十进制转换是出现了个小问题，就是重复进行转换时不对。
原代码：http://youngclub.myetang.com/jsq.zip
部分代码如下：
function octtobin(i:integer):string
{十进制转换为二进制函数}
var
j:integer;
s:string;
begin
j:=i;
s:=' ';
while j>=2 do
begin
if (j mod 2)=1 then
begin
s:='1'+s;
j:=j div 2;
end
else
begin
s:='0'+s;
j:=j div 2;
end;
end;
s:=chr(ord('0')+j) + s;
octtobin:=s;
end;

function bintooct(k:string):integer
{二进制转换为十进制函数}
var
i,j,t:integer;
s:char;
begin
t:=1;
j:=length(k);
j:=0+(ord(k[j])-ord('0'))*t;
for i:=length(k)-1 downto 1 do
begin
s:=k;
t:=t*2;
j:=j + ((ord(s)-ord('0'))*t);
end;
bintooct:=j;
end;

function HexaToDecimal(Hexa:string):longint;
const
ValoresHexa : array['A'..'F'] of integer = (10,11,12,13,14,15);
var
nDecimal : longint;
nIndex : byte;
begin
nDecimal := 0;
Hexa := Uppercase(Hexa);
for nIndex := Length(Hexa) downto 1 do
if Hexa[nIndex] in ['0'..'9']
then nDecimal := nDecimal + StrToInt(Hexa[nIndex]) *
Trunc(Exp((Length(Hexa)-nIndex)*ln(16)))
else nDecimal := nDecimal + ValoresHexa[Hexa[nIndex]] *
Trunc(Exp((Length(Hexa)-nIndex)*ln(16)));
HexaToDecimal := nDecimal;
end;
帮忙修改原程序，请发给dsq1980@163.net ！！！200分相送！！！！

/总有一个适合你把
function IntToBin(Value: LongInt;Size: Integer): String;
var
i: Integer;
begin
Result:='';
for i:=Size downto 0 do
begin
if Value and (1 shl i)<>0 then
Result:=Result+'1';
else
Result:=Result+'0';
end;
end;

function BinToInt(Value: String): LongInt;
var
i,Size: Integer;
begin
Result:=0;
Size:=Length(Value);
for i:=Size downto 0 do
begin
if Copy(Value,i,1)='1' then
Result:=Result+(1 shl i);
end;
end

////////////////////////////////////////////////
// convert 32 bit base2 to 32 bit base10 //
// max number = 99 999 999, return -1 if more //
////////////////////////////////////////////////

function Base10(Base2:Integer) : Integer
assembler;
asm
cmp eax,100000000 // check upper limit
jb @1 // ok
mov eax,-1 // error flag
jmp @exit // exit with -1
@1:
push ebx // save registers
push esi
xor esi,esi // result = 0
mov ebx,10 // diveder base 10
mov ecx,8 // 8 nibbles (10^8-1)
@2:
mov edx,0 // clear remainder
div ebx // eax DIV 10, edx mod 10
add esi,edx // result = result + remainder
ror esi,4 // shift nibble
loop @2 // loop for all 8 nibbles
mov eax,esi // function result
pop esi // restore registers
pop ebx
@exit:
end;

function DecToBinStr(n: integer): string;

var
S: string;
i: integer;
Negative: boolean;

begin
if n < 0 then Negative := true;
n := Abs;
for i := 1 to SizeOf * 8 do
begin
if n < 0 then S := S + '1' else S := S + '0';
n := n shl 1;
end;
Delete(S,1,Pos('1',S) - 1);//remove leading zeros
if Negative then S := '-' + S;
Result := S;
end;

Function StrToBin(a: String): PChar;
var
i, j: Integer;
s: String;
p, r: PChar;
const
HexString: array[0..15] of Char = ('0', '1', '2', '3',
'4', '5', '6', '7',
'8', '9', 'A', 'B',
'C', 'D', 'E', 'F');
BinString: array[0..15] of String = ('0000', '0001', '0010', '0011',
'0100', '0101', '0110', '0111',
'1000', '1001', '1010', '1011',
'1100', '1101', '1110', '1111');
begin
s := '';
r := StrAlloc(65000);
p := StrAlloc(65000);
StrPCopy(r, '');
for i := 1 to Length(a) do
s := s + IntToHex(Ord(a), 2);
for i := 1 to Length(s) do begin
for j := 0 to 15 do begin
if s = HexString[j] then begin
StrPCopy(p, '');
StrPCopy(p, BinString[j]);
StrCat(r, p);
end;
end;
end;
StrDispose(p);
Result := StrAlloc(65000);
StrCopy(Result, r);
end;

to dsq1980:
我测试了一下，你的东西没有问题呀？
是不是在其他地方出了问题？

Three functions as following:

function TTSDigital.DWORD2BinStr(dwDataWORD):WideString;
const
BASE = $80000000;
var
iBaseWORD;

First1Pos:Integer;
begin
iBase:=BASE;
while ( iBase <> 0 ) do
begin
if ( dwData and iBase ) <> 0 then Result:= Result + '1'
else Result:= Result + '0';
iBase:=iBase shr 1;
end;

First1Pos:=pos('1',Result);
if First1Pos = 0 then Result:='0'
else Result:=copy(Result,First1Pos,32);
end;

function TTSDigital.BinStr2DWORD(pcBSChar)WORD;
var
S:string;
SLen,iIndex:Integer;
BaseWORD;
begin
Result:=0;
S:=StrPas(pcBS);
SLen:=Length(S);
if SLen = 0 then raise Exception.Create('Null bin string !')
else
begin
iIndex:=1;
while ( ( S[iIndex] = '0' ) and ( iIndex < SLen ) ) do Inc(iIndex);
S:=copy(S,iIndex,32);

SLen:=Length(S);
iIndex:=SLen;
Base:=$00000001;
while ( iIndex >= 1 ) do
begin
if ( S[ iIndex ] <> '0' ) and ( S[ iIndex ] <> '1' ) then
raise Exception.Create('Bad bin char found !');

if S[ iIndex ] = '1' then Result := Result or ( Base shl ( SLen - iIndex ) );
Dec( iIndex );
end;
end;
end;

function TTSDigital.HexStr2DWORD(pcHSChar)WORD;
const
HEXSTR = '0123456789ABCDEF';
var
S:string;
SLen,iIndex:Integer;
HexStrPosWORD;
begin
Result:=0;
S:=StrPas(pcHS);
SLen:=Length(S);
if SLen = 0 then raise Exception.Create('Null hex string !')
else
begin
iIndex:=1;
while ( ( S[iIndex] = '0' ) and ( iIndex < SLen ) ) do Inc(iIndex);
S:=copy(S,iIndex,8);
S:=UpperCase(S);

SLen:=Length(S);
iIndex:=SLen;

while ( iIndex >= 1 ) do
begin
if not ( S[ iIndex ] in ['0'..'9','A'..'F'] ) then
raise Exception.Create('Bad hex char found !');

HexStrPos:=Pos(S[ iIndex ],HEXSTR);
Result := Result or ( ( HexStrPos - 1 ) shl ( 4 * ( SLen - iIndex ) ) );

Dec( iIndex );
end;
end;
end;

原程序http://youngclub.myetang.com/jsq.rar
只转换一次是没问题，但如果反复转换几次就有问题了，我也试过其他几个函数，差不多

我写的一个进制转换的程序，希望对你有所帮助：
unit wnAscii;

interface

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

type
TfmAscii = class(TForm)
ledtDec: TLabeledEdit;
ledtBin: TLabeledEdit;
ledtHex: TLabeledEdit;
ledtChar: TLabeledEdit;
ledt64: TLabeledEdit;
procedure FormCreate(Sender: TObject);
procedure ledtCharChange(Sender: TObject);
procedure ledtDecChange(Sender: TObject);
procedure ledtBinChange(Sender: TObject);
procedure ledtHexChange(Sender: TObject);
procedure FormMouseDown(Sender: TObject
Button: TMouseButton;
Shift: TShiftState
X, Y: Integer);
procedure ledt64Change(Sender: TObject);
private
{ Private declarations }

function IntToBinX(const aiDec: Integer
abWithLeadingZero: Boolean = False): string;
function BinToInt(asBin: string): LongInt;

function HexToInt(const asHex: string
aiDefault: Integer): Integer;
//function IntToHex(Value: Integer
Digits: Integer): string //SysUtils.pas;

public
{ Public declarations }
end;

var
fmAscii: TfmAscii;

implementation

{$R *.dfm}

procedure TfmAscii.FormCreate(Sender: TObject);
begin
inherited;

DLGNeedMin := True;
imgIcon.Visible := True;
end;

procedure TfmAscii.ledtCharChange(Sender: TObject);
var
iASCii: Integer;
sChr: string;
begin
if ActiveControl.Name <> TLabeledEdit(Sender).Name then
Exit;

sChr := ledtChar.Text;
if Length(sChr) = 0 then
Exit;

iASCii := Ord(sChr[1]);
ledtDec.Text := Format('%d', [iASCii]);

ledtBin.Text := IntToBinX(iASCii);
ledtHex.Text := Format('%x', [iASCii]);
ledtChar.SelectAll;
end;

procedure TfmAscii.ledtDecChange(Sender: TObject);
var
iASCii: Integer;
begin
if ActiveControl.Name <> TLabeledEdit(Sender).Name then
Exit;

iASCii := StrToIntDef(ledtDec.Text, 0);
ledtChar.Text := Chr(iASCii);
ledtBin.Text := IntToBinX(iASCii);
ledtHex.Text := Format('%x', [iASCii]);
end;

procedure TfmAscii.ledtBinChange(Sender: TObject);
var
iASCii: Integer;
begin
if ActiveControl.Name <> TLabeledEdit(Sender).Name then
Exit;

iASCii := BinToInt(ledtBin.Text);

ledtChar.Text := Chr(iASCii);
ledtDec.Text := IntToStr(iASCii);
ledtHex.Text := Format('%x', [iASCii]);
end;

procedure TfmAscii.ledtHexChange(Sender: TObject);
var
iASCii: Integer;
begin
if ActiveControl.Name <> TLabeledEdit(Sender).Name then
Exit;

if ledtHex.Text = '' then
Exit;

iASCii := HexToInt(ledtHex.Text, -1);

ledtDec.Text := Format('%D', [iASCii]);
ledtChar.Text := Chr(iASCii);
ledtBin.Text := IntToBinX(iASCii);
end;

function TfmAscii.IntToBinX(const aiDec: Integer
abWithLeadingZero: Boolean = False): string;
begin
Result := IntToBin(aiDec)
//IdGlobal.pas is necessary here.
if abWithLeadingZero then
Exit;

while (Length(Result) > 1) and (Result[1] = '0') do
begin
Delete(Result, 1, 1 );
end;
end;

procedure TfmAscii.FormMouseDown(Sender: TObject
Button: TMouseButton;
Shift: TShiftState
X, Y: Integer);
begin
ReleaseCapture;

Perform(WM_SYSCOMMAND, $F012, 0);
end;

function TfmAscii.HexToInt(const asHex: string
aiDefault: Integer): Integer;
begin
Result := StrToIntDef('$' + asHex, aiDefault);
end;

function TfmAscii.BinToInt(asBin: string): LongInt;
var
i: Integer;
begin
Result := 0;

for i := 1 to Length(asBin) do
begin
Result := Result shl 1;
if asBin = '1' then
begin
Result := Result + 1;
end;
end;
end;
end.

object fmAscii: TfmAscii
Left = 284
Top = 193
VertScrollBar.Range = 0
BorderStyle = bsDialog
Caption = 'ASCII测试'
ClientHeight = 247
ClientWidth = 214
OldCreateOrder = True
OnMouseDown = FormMouseDown
PixelsPerInch = 96
TextHeight = 12
object ledt64: TLabeledEdit [0]
Left = 12
Top = 212
Width = 180
Height = 20
EditLabel.Width = 60
EditLabel.Height = 12
EditLabel.Caption = '64进制(&amp;H):'
LabelPosition = lpAbove
LabelSpacing = 3
TabOrder = 5
OnChange = ledt64Change
end
object ledtChar: TLabeledEdit [1]
Left = 12
Top = 52
Width = 180
Height = 20
EditLabel.Width = 48
EditLabel.Height = 12
EditLabel.Caption = '字符(&amp;C):'
LabelPosition = lpAbove
LabelSpacing = 3
MaxLength = 1
TabOrder = 1
OnChange = ledtCharChange
end
object ledtDec: TLabeledEdit [2]
Left = 12
Top = 92
Width = 180
Height = 20
EditLabel.Width = 60
EditLabel.Height = 12
EditLabel.Caption = '10进制(&amp;D):'
LabelPosition = lpAbove
LabelSpacing = 3
TabOrder = 2
OnChange = ledtDecChange
end
object ledtBin: TLabeledEdit [3]
Left = 12
Top = 132
Width = 180
Height = 20
EditLabel.Width = 54
EditLabel.Height = 12
EditLabel.Caption = '2进制(&amp;B):'
LabelPosition = lpAbove
LabelSpacing = 3
TabOrder = 3
OnChange = ledtBinChange
end
object ledtHex: TLabeledEdit [4]
Left = 12
Top = 172
Width = 180
Height = 20
EditLabel.Width = 60
EditLabel.Height = 12
EditLabel.Caption = '16进制(&amp;H):'
LabelPosition = lpAbove
LabelSpacing = 3
TabOrder = 4
OnChange = ledtHexChange
end
inherited panTitle: TPanel
Width = 214
inherited imgARightTop: TImage
Left = 116
end
inherited imgDRightTop: TImage
Left = 18
end
end
end

to dsq1980: [red]我已经找到问题了！[/red]

你的 octtobin 函数在末尾多了一个空格，导致 bintooct 函数处理错误

两种改法：

1) 修改 octtobin :
只需要修改最后一句即可： octtobin := Trim(s);

2) 修改 bintooct :
在最开始插入一句： k := Trim(k);

谢谢各位，问题已解决，谢谢beta。