I have to make some project for my college, and I need to calculate CRC32. But I almost didn't work with shifts before, so even after I read theory it's still hard to me. I found some CRC32 basic algorithm for C (not mine) and I tried to rewrite it for Lazarus(Delphi). But it doesn't work. I can't understand, what's wrong. Please, help (*_ _)人
Here my code:
procedure TMyFrame.CRC32_Checksum();
var
P : Pointer;
Size, i : Integer;
CRC, j : LongWord;
B : ^Byte;
flag : Boolean;
begin
AssignFile (f, FileName);
Reset(f, 1);
Size := FileSize(f);
GetMem(P, Size);
BlockRead(f, P^, Size);
B := P;
//
//
CRC := $FFFFFFFF;
for i := 1 to Size do
begin
CRC := CRC XOR B^;
Inc(B);
for j := 0 to 7 do
begin
flag := (CRC AND 1) > 0;
if flag then
CRC := (CRC SHR 1) XOR $04C11DB7
else
CRC := CRC SHR 1;
end;
end;
LabeledEdit1.Text := IntToHEX(CRC, 8);
//
//
Freemem(P);
CloseFile(f);
end;
0xCBF43926 is the bit-wise inverse ("not") of 0x340BC6D9. You just need to use not on the result, or exclusive or with $FFFFFFFF.
Note that FPC comes with a CRC32 unit. (derived from crc32.c by Mark Adler, above )
This unit has a function to calculate the CRC for a block called crc32()
function crc32 (crc : cardinal; buf : Pbyte; len : cardinal): cardinal;
The XOR is included in this crc32.crc32() function.
Related
I've been using a quicksort function to sort my stringlists, but as an exercise I wanted to try and code an heapsort function too. Unfortunately it does not work and I can't understand why. The utility functions I use work (because I use them in the quicksort script too and trying both on a list the quicksort one works and the other doesn't)
{------------------------------------------------------------------------------}
Procedure Heapify(AList : TStringList; N, Root : Integer);
Var
Max, L, R : Integer;
Begin
Max := Root;
L := (2 * Root) + 1;
R := (2 * Root) + 2;
If (L < N) And (ListSort(AList, Max, L) < 0 {function to compare strings, read as List[L]>List[Max]}) Then Max := L;
If (R < N) And (ListSort(AList, Max, R) < 0) Then Max := R;
If Max <> Root Then
Begin
ExchangeItems(AList, Root, Max); {Function to swap strings}
Heapify(AList, N, Max);
End;
End;
{------------------------------------------------------------------------------}
Procedure HeapSortStringList(AList : TStringList);
Var
I : Integer;
Begin
For I := (AList.Count / 2) - 1 DownTo 0 Do Heapify(AList, AList.Count, I);
For I := AList.Count - 1 DownTo 1 Do
Begin
ExchangeItems(AList, I, 0);
Heapify(AList, I, 0);
End;
End;
{------------------------------------------------------------------------------}
How did you compile this code?
Note that compiler gives us message:
[dcc32 Error] Unit2.pas(175): E2010 Incompatible types: 'Integer' and
'Extended'
(AList.Count / 2) should be (AList.Count div 2) for integers
After this correction code becomes working.
I'm trying to create a simple Crypting method for a school project, the idea is to change a character by increasing it's ascii with a user entered number then replacing it back.
So my problem is when I do it, it works, but it also includes symboles like %$! ...etc.
What I want to do is to limit the Ord function to letters only, For example if the user entered the number 100 but there's only 26 letters in the alphabet, it will keep looping over and over through that 26 till it reaches the 100th.
Hope I'm clear enough lol
Here's what I have so far, a part of a whole code:
Procedure Crypting( Var cryptFile : Text; tempVar2 : String; pNumber: Integer);
Begin
Writeln('Enter P : ');
Readln(P);
Reset( cryptFile );
For i:= 1 to length(tempVar2) do
Write(Chr(Ord(tempVar2[i])+P));
End;
It seems like you are looking to implement the Caesar cipher.
First, you need to use an if statement to check if the current character is a letter or not. If so, you transform it; if not, you leave it as it is.
Second, it is not enough to simply add P to the character code. Although it works for A and P = 3, producing D, what will happen for Y and P = 3? You need to use modular arithmetic so you get Y → Z → A → B.
Third, in programming, it is important to structure your code well and refactor it properly. Currently, you mix input and transformation. You should keep these separate. If you create a Caesar function, you can use it every time you need to perform the Caesar cipher.
If we also need to support both capital and small letters, it is better to use a case construct instead of an if .. else if .. else construct.
Putting it all together:
function Caesar(const S: string; N: Integer): string; // slow
var
i: Integer;
begin
Result := '';
for i := 1 to Length(S) do
case S[i] of
'A'..'Z':
Result := Result + Chr(Ord('A') + (Ord(S[i]) - Ord('A') + N) mod 26);
'a'..'z':
Result := Result + Chr(Ord('a') + (Ord(S[i]) - Ord('a') + N) mod 26);
else
Result := Result + S[i];
end;
end;
This function works, but is not optimal from a performance point of view, since you need a heap allocation for every iteration. It is better to allocate the result string once and then only fill it:
function Caesar(const S: string; N: Integer): string;
var
i: Integer;
begin
SetLength(Result, Length(S));
for i := 1 to Length(S) do
case S[i] of
'A'..'Z':
Result[i] := Chr(Ord('A') + (Ord(S[i]) - Ord('A') + N) mod 26);
'a'..'z':
Result[i] := Chr(Ord('a') + (Ord(S[i]) - Ord('a') + N) mod 26);
else
Result[i] := S[i];
end;
end;
A complete example:
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
function Caesar(const S: string; N: Integer): string;
var
i: Integer;
begin
SetLength(Result, Length(S));
for i := 1 to Length(S) do
case S[i] of
'A'..'Z':
Result[i] := Chr(Ord('A') + (Ord(S[i]) - Ord('A') + N) mod 26);
'a'..'z':
Result[i] := Chr(Ord('a') + (Ord(S[i]) - Ord('a') + N) mod 26);
else
Result[i] := S[i];
end;
end;
var
s: string;
N: Integer;
begin
Writeln('Please enter a string to transform:');
Readln(s);
Writeln('Please enter shift size:');
Readln(N);
Writeln;
Writeln('Result: ', Caesar(s, N));
Writeln;
Writeln('Thank you for using this program! Have a nice day!');
Writeln('Press Return to exit.');
Readln;
end.
(The precise program structure depends on the kind of Pascal you are using -- there are many different kinds of Pascal.)
Screenshot:
I'm learning algorithms and I'm trying to make an algorithm that extracts numbers lets say n in [1..100] from a string. Hopefully I get an easier algorithm.
I tried the following :
procedure ReadQuery(var t : tab); // t is an array of Integer.
var
x,v,e : Integer;
inputs : String;
begin
//readln(inputs);
inputs:='1 2 3';
j:= 1;
// make sure that there is one space between two integers
repeat
x:= pos(' ', inputs); // position of the space
delete(inputs, x, 1)
until (x = 0);
x:= pos(' ', inputs); // position of the space
while x <> 0 do
begin
x:= pos(' ', inputs); //(1) '1_2_3' (2) '2_3'
val(copy(inputs, 1, x-1), v, e); // v = value | e = error pos
t[j]:=v;
delete(inputs, 1, x); //(1) '2_3' (2) '3'
j:=j+1; //(1) j = 2 (2) j = 3
//writeln(v);
end;
//j:=j+1; // <--- The mistake were simply here.
val(inputs, v, e);
t[j]:=v;
//writeln(v);
end;
I get this result ( resolved ) :
1
2
0
3
expected :
1
2
3
PS : I'm not very advanced, so excuse me for reducing you to basics.
Thanks for everyone who is trying to share knowledge.
Your code is rather inefficient and it also doesn't work for strings containing numbers in general.
A standard and performant approach would be like this:
type
TIntArr = array of Integer;
function GetNumbers(const S: string): TIntArr;
const
AllocStep = 1024;
Digits = ['0'..'9'];
var
i: Integer;
InNumber: Boolean;
NumStartPos: Integer;
NumCount: Integer;
procedure Add(Value: Integer);
begin
if NumCount = Length(Result) then
SetLength(Result, Length(Result) + AllocStep);
Result[NumCount] := Value;
Inc(NumCount);
end;
begin
InNumber := False;
NumCount := 0;
for i := 1 to S.Length do
if not InNumber then
begin
if S[i] in Digits then
begin
NumStartPos := i;
InNumber := True;
end;
end
else
begin
if not (S[i] in Digits) then
begin
Add(StrToInt(Copy(S, NumStartPos, i - NumStartPos)));
InNumber := False;
end;
end;
if InNumber then
Add(StrToInt(Copy(S, NumStartPos)));
SetLength(Result, NumCount);
end;
This code is intentionally written in a somewhat old-fashioned Pascal way. If you are using a modern version of Delphi, you wouldn't write it like this. (Instead, you'd use a TList<Integer> and make a few other adjustments.)
Try with the following inputs:
521 cats, 432 dogs, and 1487 rabbits
1 2 3 4 5000 star 6000
alpha1beta2gamma3delta
a1024b2048cdef32
a1b2c3
32h50s
5020
012 123!
horses
(empty string)
Make sure you fully understand the algorithm! Run it on paper a few times, line by line.
I have this function called IntToStrLen which converts an integer to a string of a padded size. For example, an integer value of 42 with a size of 4 would result in a string __42 (padded with a given character, space by default).
The problem is when this function is used in bulk (for example 1,000,000 times in a loop), it adds extra weight onto the loop. The loop I'm using this in, without this function, takes about 20 seconds, but with this function, I'm still waiting as of right now for this function to complete, after about 5 minutes.
How can I speed up the following function?
function IntToStrLen(const Value: Integer; const Len: Integer;
const Fill: String = ' '): String;
var
T: String;
begin
Result:= IntToStr(Value); //convert result
if Length(Result) > Len then
Result:= Copy(Result, 1, Len) //forcefully truncate
else if Length(Result) < Len then begin
T:= '';
while Length(T) < (Len - Length(Result)) do //fill space with character
T:= T + Fill;
Result:= T + Result; //return combination
end;
end;
The absolute number one change that you can make here is to avoid heap allocations. Your code presently has multiple heap allocations. Your goal here is to write a function with zero heap allocations.
That means you need the caller to allocate and provide the buffer. Typically they will do so with a stack allocated buffer, which hence costs nothing to allocate (or deallocate). If the caller really needs a string, which is always allocated on the heap, then the caller can wrap your function with a call to SetString.
The function prototype might look like this:
procedure IntToStrLen(const Value, Len: Integer; var Buffer: array of Char;
const Fill: Char = ' ');
The first point to stress here is that Fill must be a Char. Your use of string is inefficient and allows the caller to call a fill "character" with length not equal to one. Doing so would of course break your function because it would return a value with length not equal to Len.
Do note also that the implementation must not call IntToStr because that involves heap allocation. So you need to write your own heap allocation free integer to decimal text conversion code because, astonishingly, the RTL does not offer such functionality. When I do this I use code like so:
procedure DivMod(Dividend, Divisor: Cardinal;
out Quotient, Remainder: Cardinal);
{$IFDEF CPUX86}
asm
PUSH EBX
MOV EBX,EDX
XOR EDX,EDX
DIV EBX
MOV [ECX],EAX
MOV EBX,Remainder
MOV [EBX],EDX
POP EBX
end;
{$ELSE IF Defined(CPUX64)}
asm
.NOFRAME
MOV EAX,ECX
MOV ECX,EDX
XOR EDX,EDX
DIV ECX
MOV [R8],EAX
MOV [R9],EDX
end;
{$ELSE}
{$Message Error 'Unrecognised platform.'}
{$ENDIF}
function CopyIntegerToCharBuffer(const Value: Integer;
var Buffer: array of Char): Integer;
var
i, j: Integer;
val, remainder: Cardinal;
negative: Boolean;
tmp: array [0..15] of Char;
begin
negative := Value<0;
val := abs(Value);
Result := 0;
repeat
DivMod(val, 10, val, remainder);
tmp[Result] := Chr(remainder + ord('0'));
inc(Result);
until val=0;
if negative then begin
tmp[Result] := '-';
inc(Result);
end;
Assert(Result<=Length(Buffer));
i := 0;
j := Result-1;
while i<Result do begin
Buffer[i] := tmp[j];
inc(i);
dec(j);
end;
end;
Now you can make decimal text representations of integers without touching the heap. From there it's a short way to your function.
procedure IntToStrLen(const Value, Len: Integer; var Buffer: array of Char;
const Fill: Char = ' ');
var
tmp: array [0..15] of Char;
i, N: Integer;
begin
Assert(Length(Buffer)>=Len);
N := CopyIntegerToCharBuffer(Value, tmp);
if N>=Len then begin
Move(tmp, Buffer, SizeOf(Char)*Len);
end else begin
for i := 0 to Len-N-1 do begin
Buffer[i] := Fill;
end;
Move(tmp, Buffer[Len-N], SizeOf(Char)*N);
end;
end;
At this point you'll have gained the bulk of the available performance benefits. From here on in you will be into diminishing returns. You could micro-optimise CopyIntegerToCharBuffer as is done in SysUtils._IntToStr32 for instance. Beyond that I'm sure the implementation of IntToStrLen could be optimised with judicious use of assembler. But such optimisations will yield nothing like the benefit you have gained so far from avoiding the heap.
Of course, all this assumes that you have correctly identified your performance bottleneck. It's all too easy to assume that you know where the performance bottleneck is by statically analysing the code. Unless you've actually profiled it carefully expect to find that your intuition is a poor judge of where to invest optimisation effort.
Try this variant
(and you don't treat negative numbers)
function IntToStrLen(const Value: Integer; const Len: Integer;
const Fill: Char = ' '): String;
var
T: String;
begin
Result:= IntToStr(Value);
if Length(Result) > Len then
SetLength(Result, Len) //forcefully truncate
else if Length(Result) < Len then
Result := StringOfChar(Fill, Len - Length(Result)) + Result;
end;
P.S. So strange truncation (2014=>20) - is what you really want?
It's actually my first time in here, so..
What's the problem: standard graph module is too damn slow in drawing.
I have an institute task to make a big program with modules on pascal. Program has several parts but i'm interested in graphical one. I have something like counter (number) in the left corner of the screen and i need it to update fast. But I see every pixel it fills with color, lol.
I'm using Free Pascal 2.6.4.
Asking for some ideas or other ways to draw in a command window fast.
program graphical;
uses
wincrt, graph, querystring, kbd, Timer, sysutils;
const
speedX1 = 0;
speedY1 = 0;
var
//draw part
gd, gm, error, tw, th, i: integer;
speedX2: integer = 10;
speedY2: integer = 10;
speedSize: word;
speedImage: pointer;
size: word;
//qstring part
qrec: qstr;
qtext: AnsiString;
current, ch: char;
//keyboard part
kbrd: kb;
//speedometer part
counter: word = 0;
time: word;
speed: word;
//debug part
c: string;
t: comp;
procedure draw; //screens text
begin
qtext := copy(qrec.text, qrec.qpointer, Length(qrec.text) - qrec.qpointer + 1);
outTextXY(getMaxX div 2, getMaxY div 8, qtext);
end;
begin
//graphic initialization
//gd := detect;
gd := VGA;
gm := VGAHi;
initgraph(gd, gm, '..\bgi');
//checking for errors
error := graphResult;
if (error <> grOk) then
begin
writeln('800x600x256 is not supported');
halt(1);
end;
//querystring initialization
qInit(qrec);
//keyboard initialization
initKeyboard(kbrd);
//timer initialization
TimerOn;
time := 0;
//drawing
setTextStyle(defaultFont, horizDir, 8);
draw;
drawKeyboard(kbrd);
current := getCurrent(qrec);
randomize;
speedX2 := 200;
speedY2 := 100;
repeat
//on timer events
if (isTimer) then
begin
size := ImageSize(speedX1, speedY1, speedX2, speedY2);
GetMem(speedImage, size);
GetImage(speedX1, speedY1, speedX2, speedY2, speedImage^);
PutImage(speedX1, speedY1, speedImage^, 1); FreeMem(speedImage, size);
inc(time);
speed := round(counter/time/25*60);
speed := time;
outTextXY(0, 0, IntToStr(speed));
end;
if KeyPressed then
begin
ch := readkey;
if (ch = #0) then
ch := readkey;
end;
if (UpCase(ch) = UpCase(current)) then
begin
drawKeyboard(kbrd);
draw;
current := getCurrent(qrec);
inc(counter);
end
else
if (counter > 0) then
dec(counter);
until (ch = #27) or (getLength(qrec) < 0);
closegraph;
end.
What I see from the code:
drawKeyboard is called on each iteration, which might not be necessary
for each timer event, memory is allocated and released again, which normally is a rather costly operation. The memory needed seems to be of constant size, so try to move allocation and deallocation out of the loop.
Without fixing those, you'd probably have the same problems with other graph libraries too, so give it a try.