Форум: "Основная";
Текущий архив: 2004.04.11;
Скачать: [xml.tar.bz2];
ВнизCRC32 - понимаш Найти похожие ветки
← →
Frozzen (2004-04-25 16:26) [0]подскажите где может быть косяк в нахождении crc искать запарился
таблицу не привожу она правельная?
function Crc32Next (CRC32Current: LongWord; data: LongWord): LongWord;
Asm //EAX - CRC32Current; EDX - Data;
XOR EDX, EAX
AND EDX, $FF
SHR EAX, 8
XOR EAX, DWORD PTR CRC32Tab[EDX]
End;//Crc32Next
//------------------------------------------------------------------------------
function GetCRC32(data : String): LongWord;
var i : Integer;
begin
Result := $FFFFFFFF;
for i := 1 to Length(data) do
Result := Crc32Next(Result, LongWord(data[i]));
Asm
NOT Result
end;
end;
← →
Frozzen (2004-04-25 16:26) [0]подскажите где может быть косяк в нахождении crc искать запарился
таблицу не привожу она правельная?
function Crc32Next (CRC32Current: LongWord; data: LongWord): LongWord;
Asm //EAX - CRC32Current; EDX - Data;
XOR EDX, EAX
AND EDX, $FF
SHR EAX, 8
XOR EAX, DWORD PTR CRC32Tab[EDX]
End;//Crc32Next
//------------------------------------------------------------------------------
function GetCRC32(data : String): LongWord;
var i : Integer;
begin
Result := $FFFFFFFF;
for i := 1 to Length(data) do
Result := Crc32Next(Result, LongWord(data[i]));
Asm
NOT Result
end;
end;
← →
Yanis © (2004-04-25 16:32) [1]>правельная?
:)
Попробуй другой алгоритм. Если этот проблемный.
← →
Yanis © (2004-04-25 16:32) [1]>правельная?
:)
Попробуй другой алгоритм. Если этот проблемный.
← →
Frozzen (2004-04-25 16:36) [2]а мож не стремиться к стандарту
работает да и ладно
← →
Frozzen (2004-04-25 16:36) [2]а мож не стремиться к стандарту
работает да и ладно
← →
Yanis © (2004-04-25 16:39) [3]Так работает или нет!? Ты определись сначала.
Не надо выбумавать велосипед, когда уже есть машина.
з.ы. Но это не значит, что не стандартное мышление не приветствуется!
← →
Yanis © (2004-04-25 16:39) [3]Так работает или нет!? Ты определись сначала.
Не надо выбумавать велосипед, когда уже есть машина.
з.ы. Но это не значит, что не стандартное мышление не приветствуется!
← →
Sha © (2004-04-25 17:40) [4]
unit CRCunit;
interface
function GetNewCRC(OldCRC: cardinal; StPtr: pointer; StLen: integer): cardinal;
procedure UpdateCRC(StPtr: pointer; StLen: integer; var CRC: cardinal);
function GetZipCRC(StPtr: pointer; StLen: integer): cardinal;
function GetFileCRC(const FileName: string): cardinal;
implementation
var
CRCtable: array[0..255] of cardinal;
function GetNewCRC(OldCRC: cardinal; StPtr: pointer; StLen: integer): cardinal;
asm
test edx,edx;
jz @ret;
neg ecx;
jz @ret;
sub edx,ecx; // Address after last element
push ebx;
mov ebx,0; // Set ebx=0 & align @next
@next:
mov bl,al;
xor bl,byte [edx+ecx];
shr eax,8;
xor eax,cardinal [CRCtable+ebx*4];
inc ecx;
jnz @next;
pop ebx;
@ret:
end;
procedure UpdateCRC(StPtr: pointer; StLen: integer; var CRC: cardinal);
begin
CRC:=GetNewCRC(CRC,StPtr,StLen);
end;
function GetZipCRC(StPtr: pointer; StLen: integer): cardinal;
begin
Result:=not GetNewCRC($FFFFFFFF, StPtr, StLen);
end;
function GetFileCRC(const FileName: string): cardinal;
const
BufSize = 64*1024;
var
Fi: file;
pBuf: PChar;
Count: integer;
begin
Assign(Fi,FileName);
Reset(Fi,1);
GetMem(pBuf,BufSize);
Result:=$FFFFFFFF;
repeat
BlockRead(Fi,pBuf^,BufSize,Count);
if Count=0 then break;
Result:=GetNewCRC(Result,pBuf,Count);
until false;
Result:=not Result;
FreeMem(pBuf);
CloseFile(Fi);
end;
procedure CRCInit;
var
c: cardinal;
i, j: integer;
begin
for i:=0 to 255 do begin
c:=i;
for j:=1 to 8 do if odd(c) then c:=(c shr 1) xor $EDB88320 else c:=(c shr 1);
CRCtable[i]:=c;
end;
end;
initialization
CRCinit;
end.
Пример использования:uses
CRCunit;
procedure TForm1.Button1Click(Sender: TObject);
const
FileName="CRCunit.pas";
begin
ShowMessage("CRC32 файла="+IntToHex(GetFileCRC(FileName),8));
ShowMessage("CRC32 имени="+IntToHex(GetZipCRC(PChar(FileName),Length(FileName)),8));
end;
← →
Sha © (2004-04-25 17:40) [4]
unit CRCunit;
interface
function GetNewCRC(OldCRC: cardinal; StPtr: pointer; StLen: integer): cardinal;
procedure UpdateCRC(StPtr: pointer; StLen: integer; var CRC: cardinal);
function GetZipCRC(StPtr: pointer; StLen: integer): cardinal;
function GetFileCRC(const FileName: string): cardinal;
implementation
var
CRCtable: array[0..255] of cardinal;
function GetNewCRC(OldCRC: cardinal; StPtr: pointer; StLen: integer): cardinal;
asm
test edx,edx;
jz @ret;
neg ecx;
jz @ret;
sub edx,ecx; // Address after last element
push ebx;
mov ebx,0; // Set ebx=0 & align @next
@next:
mov bl,al;
xor bl,byte [edx+ecx];
shr eax,8;
xor eax,cardinal [CRCtable+ebx*4];
inc ecx;
jnz @next;
pop ebx;
@ret:
end;
procedure UpdateCRC(StPtr: pointer; StLen: integer; var CRC: cardinal);
begin
CRC:=GetNewCRC(CRC,StPtr,StLen);
end;
function GetZipCRC(StPtr: pointer; StLen: integer): cardinal;
begin
Result:=not GetNewCRC($FFFFFFFF, StPtr, StLen);
end;
function GetFileCRC(const FileName: string): cardinal;
const
BufSize = 64*1024;
var
Fi: file;
pBuf: PChar;
Count: integer;
begin
Assign(Fi,FileName);
Reset(Fi,1);
GetMem(pBuf,BufSize);
Result:=$FFFFFFFF;
repeat
BlockRead(Fi,pBuf^,BufSize,Count);
if Count=0 then break;
Result:=GetNewCRC(Result,pBuf,Count);
until false;
Result:=not Result;
FreeMem(pBuf);
CloseFile(Fi);
end;
procedure CRCInit;
var
c: cardinal;
i, j: integer;
begin
for i:=0 to 255 do begin
c:=i;
for j:=1 to 8 do if odd(c) then c:=(c shr 1) xor $EDB88320 else c:=(c shr 1);
CRCtable[i]:=c;
end;
end;
initialization
CRCinit;
end.
Пример использования:uses
CRCunit;
procedure TForm1.Button1Click(Sender: TObject);
const
FileName="CRCunit.pas";
begin
ShowMessage("CRC32 файла="+IntToHex(GetFileCRC(FileName),8));
ShowMessage("CRC32 имени="+IntToHex(GetZipCRC(PChar(FileName),Length(FileName)),8));
end;
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2004.04.11;
Скачать: [xml.tar.bz2];
Память: 0.47 MB
Время: 0.035 c