Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2005.09.25;
Скачать: [xml.tar.bz2];

Вниз

Ошибка в алгоритме   Найти похожие ветки 

 
kblc ©   (2005-09-04 19:59) [0]

Уважаемые мастера, помогите пожалуйста в поиске ошибки:
Есть три функции:

function DeCrypt(const sString: string): string;
var
 res: string;
 i, rannum: Cardinal;
begin
 if (length(GetKey)>0) and (length(sString)>0) then
 begin
   res:="";
   rannum:=0;
   for i:=1 to length(sString) do
   if (i mod 2)=0 then
      res:=res+char(ord(sString[i])-ord(GetKey[rannum])) else
      rannum:=StrToInt(sString[i]);
   Result:=res;
 end else Result:=sString;
end;

function Crypt(const sString: string): string;
var
 res: string;
 i, rannum: Cardinal;
begin
 if (length(GetKey)>0) and (length(sString)>0) then
 begin
   randomize;
   res:="";
   for i:=1 to length(sString) do
   begin
     rannum:=Random(length(GetKey))+1;
     res:=res+IntToStr(rannum);
     res:=res+char(ord(sString[i])+ord(GetKey[rannum]));
   end;
   Result:=res;
 end else Result:=sString;
end;

function GetKey: string;
var
 lpRootPathName:           array[0..MAX_PATH] of char;
 lpVolumeNameBuffer:       array[0..MAX_PATH] of char;
 lpMaximumComponentLength: Cardinal;
 lpFileSystemFlags:        Cardinal;
 lpFileSystemNameBuffer:   array[0..MAX_PATH] of char;
 lVolumeSerialNumber:      DWORD;
begin
 lpRootPathName:="C:\"#0;
 lVolumeSerialNumber:=0;

 if GetVolumeInformation(
      lpRootPathName,
      lpVolumeNameBuffer,
      sizeof(lpVolumeNameBuffer),
      @lVolumeSerialNumber,
      lpMaximumComponentLength,
      lpFileSystemFlags,
      lpFileSystemNameBuffer,
      sizeof(lpFileSystemNameBuffer)) then
    Result:=IntToStr(lVolumeSerialNumber) else
    Result:="";
end;


Проблема вот в чём:
 
 Эти функции работают-работают, а потом вдруг случается какая-то гадость:
 вот к приемру для тестирования оных я сделал так:

i:=0;
res:="фыва";
while TRUE do
begin
 inc(i);
 res:=DeCrypt(Crypt(res));
end;


 Вываливается программа при i=Randomize(Бесконечности)+1. В функции Decode происходит ошибка, программа говорит на rannum:=StrToInt(sString[i]); что sString[i] is not a valid integer value;
 Сколько просмартивал этот алгоритм - вроде бы всё верно. Бедьте добры - помогите найти ошибку.

 П.С. Функция GetKey всегда возвращает одно и тоже значение. Проверено.


 
Sam Stone ©   (2005-09-04 20:22) [1]

посмотри, чему равно sString[i], когда вылетает ошибка


 
kblc ©   (2005-09-04 20:23) [2]

то "-", то #14, то Ещё что-нибудь


 
kblc ©   (2005-09-04 20:50) [3]

Люди неспящие, помогите плз...!


 
Defunct ©   (2005-09-04 20:54) [4]

> что sString[i] is not a valid integer value;

C чего вдруг ему быть Valid? Вдруг это "-" лиюл "." либо ","
Вообще непонятно накой у тебя используется StrToInt? Может просветишь для чего оно используется?


 
begin...end ©   (2005-09-04 21:57) [5]

> kblc ©   (04.09.05 19:59)

Серийный номер тома может быть и десятизначным десятичным числом, вообще-то. А значит, в функции Crypt переменная rannum может быть равна 10, и её строковое представление будет составлять уже два символа, а не один. Со всеми вытекающими отсюда последствиями.

"Дети Ивана Кулибина" (с)


 
GanibalLector ©   (2005-09-05 02:22) [6]

2  kblc ©

begin...end ©   (04.09.05 21:57) [5] как всегда прав!
Для устранения я бы сделал так :

function Crypt(const sString: string): string;
var
res: string;
i, rannum: Cardinal;
begin
if (length(GetKey)>0) and (length(sString)>0) then
begin
  randomize;
  res:="";
  for i:=1 to length(sString) do
  begin
    rannum:=Random(length(GetKey))+1;
    res:=res+IntToHex(rannum,1);
    res:=res+char(ord(sString[i])+ord(GetKey[rannum]));
  end;
  Result:=res;
end else Result:=sString;
end;

function DeCrypt(const sString: string): string;
var
res: string;
i, rannum: Cardinal;
begin
if (length(GetKey)>0) and (length(sString)>0) then
begin
  res:="";
  rannum:=0;
  for i:=1 to length(sString) do
  if (i mod 2)=0 then
     res:=res+char(ord(sString[i])-ord(GetKey[rannum])) else
     rannum:=HexToInt(sString[i]);
  Result:=res;
end else Result:=sString;
end;


 
GanibalLector ©   (2005-09-05 02:23) [7]

Опс,забыл...

function HexToInt(HexStr : string) : Int64;
var RetVar : Int64;
   i : byte;
begin
 HexStr := UpperCase(HexStr);
 if HexStr[length(HexStr)] = "H" then
    Delete(HexStr,length(HexStr),1);
 RetVar := 0;
 for i := 1 to length(HexStr) do begin
     RetVar := RetVar shl 4;
     if HexStr[i] in ["0".."9"] then
        RetVar := RetVar + (byte(HexStr[i]) - 48)
     else
        if HexStr[i] in ["A".."F"] then
           RetVar := RetVar + (byte(HexStr[i]) - 55)
        else begin
           Retvar := 0;
           break;
        end;
 end;
 Result := RetVar;
end;


 
kblc ©   (2005-09-05 07:36) [8]

Сейчас всё переделываю... после проверки сообщу о результатах!

Всем большое спасибо!


 
begin...end ©   (2005-09-05 09:39) [9]

> kblc

function GetKey: string;
var
 VSN: Cardinal;
begin
 if GetVolumeInformation(PChar("C:\"), nil, 0, @VSN, Cardinal(nil^), Cardinal(nil^), nil, 0) then
   Result := IntToStr(VSN)
 else
   Result := ""
end


> GanibalLector ©   (05.09.05 02:23) [7]

StrToInt64


 
GanibalLector ©   (2005-09-05 09:45) [10]

2 begin...end ©   (05.09.05 09:39) [9]
>StrToInt64
Вы о чем ???


 
begin...end ©   (2005-09-05 09:47) [11]

> GanibalLector ©   (05.09.05 09:45) [10]

Я о том, что свою HexToInt писать не нужно.


 
GanibalLector ©   (2005-09-05 09:55) [12]

2 begin...end ©   (05.09.05 09:47) [11]
Это почему не нужно??? Нужно.
Ибо это

StrToInt64("b");

не работает.


 
begin...end ©   (2005-09-05 09:58) [13]

> GanibalLector ©   (05.09.05 09:55) [12]

Зато вот это:

StrToInt64("$" + "b")

работает.


 
GanibalLector ©   (2005-09-05 10:04) [14]

2 begin...end ©   (05.09.05 09:58) [13]
Хм...не знал.Ну,тогда согласен.
З.Ы. rannum:=StrToInt64("$"+sString[i]); // так что-ли?


 
begin...end ©   (2005-09-05 10:08) [15]

> GanibalLector ©   (05.09.05 10:04) [14]

> rannum:=StrToInt64("$"+sString[i]); // так что-ли?

Угу, хотя здесь достаточно и обычной StrToInt.



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2005.09.25;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.49 MB
Время: 0.037 c
5-1100590527
Kerim
2004-11-16 10:35
2005.09.25
Работа с вложенными контролами в design-time


2-1123885149
Витёк
2005-08-13 02:19
2005.09.25
Обработка события входа и выхода курсора мыши!


14-1125154722
psa247
2005-08-27 18:58
2005.09.25
Дыра в ядре 2000


5-1100515449
Lisii
2004-11-15 13:44
2005.09.25
Компонент наследник TGraphicsControl - вращение объёмной фигуры


2-1123677630
DimonNew
2005-08-10 16:40
2005.09.25
подстановочные поля





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский