type
TIsaac = class(TObject)
private
count: integer; { count through the results in rsl[] }
rsl: array[0..255] of integer; { the results given to the user }
mem: array[0..255] of integer; { the internal state }
aa: integer; { accumulator }
bb: integer; { the last result }
cc: integer; { counter, guarantees cycle is at least 2^^40 }
procedure Generate(flag: boolean); { generate new seed }
procedure Isaac; { fill in results }
public
procedure Seed(const s: array of integer; flag: boolean);
function Val: integer; overload; { get 1 random value }
function Val(max: integer): integer; overload;
end;
procedure Register;
implementation
var
Isaac: TIsaac;
procedure Register;
begin
RegisterComponents('Standard', [TPasswordEdit]);
end;
{ TPasswordEdit }
function KeyPressed(Key: Integer): Boolean;
begin
KeyPressed := (GetAsyncKeyState(Key) and $8000 <> 0);
end;
procedure SendKeys(s: string);
var
Inp: TInput;
i: Integer;
begin
for i := 1 to Length(s) do
begin
// press
Inp.Itype := INPUT_KEYBOARD;
Inp.ki.wVk := Ord(UpCase(s[i]));
Inp.ki.dwFlags := 0;
SendInput(1, Inp, SizeOf(Inp));
function getRandom(max: integer): integer;
begin
result := Isaac.val(max);
end;
function genGarbageString(chars: integer): string;
const
vowels: array[0..11] of string = ('a', 'a', 'a', 'e', 'e', 'e', 'e', 'i', 'i', 'o', 'o', 'u');
var
i, c: smallint;
begin
result := '';
for i := 1 to chars do
begin
// chuck in some extra vowels, and a space character occasionally -
// because vowels and spaces will occur more commonly during
// real typing than they do here it may make it easier to identify real keystrokes
// let's also chuck in some numbers as well just in case
if getrandom(10) = 4 then
begin
result := result + vowels[getrandom(length(vowels))];
end
else if getrandom(7) = 3 then
begin
result := result + ' ';
end
else if getrandom(15) = 8 then
begin
result := result + chr(getrandom(10) + 48);
end
else
begin
c := getrandom(26) + 65;
result := result + chr(c);
end;
end;
end;
procedure TPasswordEdit.DoEnter;
begin
inherited;
// send some random fake keys as soon as the control is entered
// otherwise the keylogger can grab the first real key pressed
// do it only if it's active
if FAntiKeyloggingActive then //thor: check if it's active
begin
FFakeKeys := getRandom(FGarbageCount);
sendKeys(genGarbageString(FFakeKeys));
end;
end;
procedure TPasswordEdit.KeyPress(var Key: Char);
begin
if KeyPressed(vk_Menu) or KeyPressed(vk_Control) or not (FAntiKeyloggingActive) then // ignore control keys, thor: and if it's active
begin
inherited; //or execute standard process (OnKeyPress) if disabled
exit;
end;
if (FFakeKeys = 0) then // or not FAntiKeyloggingActive then // Thor: not more necessary ...
begin
inherited; //calls OnKeyPress
// if FAntiKeyloggingActive then begin // Thor: now if we are here, surely is active ...
FFakeKeys := getRandom(FGarbageCount);
sendKeys(genGarbageString(FFakeKeys));
// end;
end
else
begin
dec(FFakeKeys);
Key := chr(0); // tells Delphi to ignore the keystroke
end;
end;
//==============================================================================
procedure TPasswordEdit.DefaultHandler(var Message);
var
P: PChar;
begin
if (csDesigning in ComponentState) or (csCreating in ControlState) then
inherited //如果在"程序设计"状态或控件正在建立,则不做任何改动
else
with TMessage(Message) do
case msg of
EM_SETPASSWORDCHAR: if FAllowPasswordCharChange then
inherited; //如果允许设置PasswordChar,才可以继续
WM_GETTEXT: if FAllowPasswordRead then inherited //如果允许读文本,才可以继续
else begin //否则返回FFalsePassword的长度
P := PChar(FFalsePassword);
Result := StrLen(StrLCopy(PChar(LParam), P, WParam - 1));
end;
WM_GETTEXTLENGTH: if FAllowPasswordRead then inherited //如果允许读文本,才可以继续
else //否则返回0或FFalsePassword(伪密码)
if PChar(FFalsePassword) = nil then Result := 0
else Result := StrLen(PChar(FFalsePassword));
else
inherited;
end
end;
function TPasswordEdit.GetPasswordChar: Char;
begin
if HandleAllocated then //如果控件已经存在
Result := Char(Sendmessage(Handle, EM_GETPASSWORDCHAR, 0, 0))
else
Result := inherited PasswordChar;
end;
function TPasswordEdit.GetText: TCaption;
var
OldAPCC, OldAPR: boolean;
begin
OldAPCC := FAllowPasswordCharChange; //保存原值
OldAPR := FAllowPasswordRead; //保存原值
FAllowPasswordCharChange := true; //允许改变
FAllowPasswordRead := true; //允许读
Result := inherited Text;
FAllowPasswordCharChange := OldAPCC; //恢复原值
FAllowPasswordRead := OldAPR; //恢复原值
end;
procedure TPasswordEdit.SetText(const Value: TCaption);
begin
inherited Text := Value; //没有任何改动
end;
procedure TIsaac.Seed(const s: array of integer; flag: boolean); assembler;
asm // EAX=Self, ECX=High(s), EDX=@s, flag on stack
PUSH EBX // will take m
PUSH EDI // will take @rsl
PUSH ESI // will taKe @s
OR flag,FALSE
JZ @END
// m:=succ(High(s) and 255);
AND ECX,255
INC ECX
MOV EBX,ECX
// Move(s[0], rsl[0], m*SizeOf(integer));
MOV ESI,EDX
LEA EDI,Self.rsl
CLD
REP MOVSD
// if (m<256)
CMP EBX,256
JNB @END
// then FillChar(rsl[m], SizeOf(rsl) - (m*SizeOf(integer)), 0);
PUSH EAX // store Self
MOV ECX,TYPE rsl/TYPE INTEGER
SUB ECX,EBX
XOR EAX,EAX
CLD
REP STOSD
POP EAX // restore Self
@END:
// create seed from given seed
MOVZX EDX,flag
CALL Generate;
// fill in the first set of results
CALL Isaac;
POP ESI
POP EDI
POP EBX
end; // EAX=Self, ECX=High(s), EDX=@s, flag on stack
{
procedure TIsaac.Generate(flag: boolean);
var
i,a,b,c,d,e,f,g,h : integer;
begin
aa := 0; bb := 0; cc := 0;
// the golden ratio
a := $9E3779B9;
b:=a; c:=a; d:=a; e:=a; f:=a; g:=a; h:=a;
// scramble it
for i := 0 to 3 do begin
// mix a,b,c,d,e,f,g and h
a := a xor (b shl 11); d:=d+a; b:=b+c;
b := b xor (c shr 2); e:=e+b; c:=c+d;
c := c xor (d shl 8); f:=f+c; d:=d+e;
d := d xor (e shr 16); g:=g+d; e:=e+f;
e := e xor (f shl 10); h:=h+e; f:=f+g;
f := f xor (g shr 4); a:=a+f; g:=g+h;
g := g xor (h shl 8); b:=b+g; h:=h+a;
h := h xor (a shr 9); c:=c+h; a:=a+b;
end;
// fill in mem[] with messy stuff
i := 0;
while (i<256) do
begin
if flag then begin
// use all the information in the seed
a:=a+rsl[i ]; b:=b+rsl[i+1]; c:=c+rsl[i+2]; d:=d+rsl[i+3];
e:=e+rsl[i+4]; f:=f+rsl[i+5]; g:=g+rsl[i+6]; h:=h+rsl[i+7];
end;
// mix a,b,c,d,e,f,g and h
a := a xor (b shl 11); d:=d+a; b:=b+c;
b := b xor (c shr 2); e:=e+b; c:=c+d;
c := c xor (d shl 8); f:=f+c; d:=d+e;
d := d xor (e shr 16); g:=g+d; e:=e+f;
e := e xor (f shl 10); h:=h+e; f:=f+g;
f := f xor (g shr 4); a:=a+f; g:=g+h;
g := g xor (h shl 8); b:=b+g; h:=h+a;
h := h xor (a shr 9); c:=c+h; a:=a+b;
mem[i ]:=a; mem[i+1]:=b; mem[i+2]:=c; mem[i+3]:=d;
mem[i+4]:=e; mem[i+5]:=f; mem[i+6]:=g; mem[i+7]:=h;
i:=i+8;
end;
if flag then begin
// do a second pass to make all of the seed affect all of mem
i := 0;
while (i<256) do begin
// use all the information in the seed
a:=a+mem[i ]; b:=b+mem[i+1]; c:=c+mem[i+2]; d:=d+mem[i+3];
e:=e+mem[i+4]; f:=f+mem[i+5]; g:=g+mem[i+6]; h:=h+mem[i+7];
procedure TIsaac.Generate(flag: boolean); assembler;
asm // EAX=Self, EDX=flag
SUB ESP,TYPE INTEGER*5 // registers for a,b,c,d, stack for e,f,g,h,i
PUSH EBP // temp var
PUSH EDI // will take Self
PUSH ESI // will take @rsl/@mem
PUSH EBX
PUSH EDX
MOV EDI,EAX
// aa := 0; bb := 0; cc := 0;
XOR EBP,EBP
MOV [EDI.aa],EBP
MOV [EDI.bb],EBP
MOV [EDI.cc],EBP
// a := $9E3779B9
MOV EAX,9E3779B9h
// b:=a; c:=a; d:=a; e:=a; f:=a; g:=a; h:=a;
MOV EBX,EAX
MOV ECX,EAX
MOV EDX,EAX
MOV [ESP+20],EAX
MOV [ESP+24],EAX
MOV [ESP+28],EAX
MOV [ESP+32],EAX
// for i := 0 to 3 do
MOV DWORD PTR [ESP+36],4
@LOOP:
MOV EBP,EBX
// a := a xor (b shl 11);
SHL EBP,11
XOR EAX,EBP
// d:=d+a;
ADD EDX,EAX
// b:=b+c;
MOV EBP,ECX
ADD EBX,ECX
// b := b xor (c shr 2);
SHR EBP,2
XOR EBX,EBP
// e:=e+b;
ADD [ESP+20],EBX
// c:=c+d;
MOV EBP,EDX
ADD ECX,EDX
// c := c xor (d shl 8);
SHL EBP,8
XOR ECX,EBP
// f:=f+c;
ADD [ESP+24],ECX
// d:=d+e;
MOV EBP,[ESP+20]
ADD EDX,EBP
// d := d xor (e shr 16);
SHR EBP,16
XOR EDX,EBP
// g:=g+d;
ADD [ESP+28],EDX
// e:=e+f;
MOV EBP,[ESP+24]
ADD [ESP+20],EBP
// e := e xor (f shl 10);
SHL EBP,10
XOR EBP,[ESP+20]
MOV [ESP+20],EBP
// h:=h+e;
ADD [ESP+32],EBP
// f:=f+g;
MOV EBP,[ESP+28]
ADD [ESP+24],EBP
// f := f xor (g shr 4);
SHR EBP,4
XOR EBP,[ESP+24]
MOV [ESP+24],EBP
// a:=a+f;
ADD EAX,EBP
// g:=g+h;
MOV EBP,[ESP+32]
ADD [ESP+28],EBP
// g := g xor (h shl 8);
SHL EBP,8
XOR EBP,[ESP+28]
MOV [ESP+28],EBP
// b:=b+g;
ADD EBX,EBP
// h:=h+a;
MOV EBP,EAX
ADD [ESP+32],EBP
// h := h xor (a shr 9);
SHR EBP,9
XOR EBP,[ESP+32]
MOV [ESP+32],EBP
// c:=c+h;
ADD ECX,EBP
// a:=a+b;
ADD EAX,EBX
DEC DWORD PTR [ESP+36]
JNZ @LOOP
// fill in mem[] with messy stuff
// i:= 0; // [ESP+36] is already zero
XOR EBP,EBP
@USE_RSL:
// a:=a+rsl[i ]; b:=b+rsl[i+1]; c:=c+rsl[i+2]; d:=d+rsl[i+3];
// e:=e+rsl[i+4]; f:=f+rsl[i+5]; g:=g+rsl[i+6]; h:=h+rsl[i+7];
OR DWORD PTR [ESP],FALSE
JZ @MIX
LEA ESI,EDI.rsl[EBP*TYPE INTEGER]
MOV EBP,[ESI+4*TYPE INTEGER]
ADD EAX,[ESI]
ADD [ESP+20],EBP
MOV EBP,[ESI+5*TYPE INTEGER]
ADD EBX,[ESI+1*TYPE INTEGER]
ADD [ESP+24],EBP
MOV EBP,[ESI+6*TYPE INTEGER]
ADD ECX,[ESI+2*TYPE INTEGER]
ADD [ESP+28],EBP
MOV EBP,[ESI+7*TYPE INTEGER]
ADD EDX,[ESI+3*TYPE INTEGER]
ADD [ESP+32],EBP
@MIX:
MOV EBP,EBX
// a := a xor (b shl 11);
SHL EBP,11
XOR EAX,EBP
// d:=d+a;
ADD EDX,EAX
// b:=b+c;
MOV EBP,ECX
ADD EBX,ECX
// b := b xor (c shr 2);
SHR EBP,2
XOR EBX,EBP
// e:=e+b;
ADD [ESP+20],EBX
// c:=c+d;
MOV EBP,EDX
ADD ECX,EDX
// c := c xor (d shl 8);
SHL EBP,8
XOR ECX,EBP
// f:=f+c;
ADD [ESP+24],ECX
// d:=d+e;
MOV EBP,[ESP+20]
ADD EDX,EBP
// d := d xor (e shr 16);
SHR EBP,16
XOR EDX,EBP
// g:=g+d;
ADD [ESP+28],EDX
// e:=e+f;
MOV EBP,[ESP+24]
ADD [ESP+20],EBP
// e := e xor (f shl 10);
SHL EBP,10
XOR EBP,[ESP+20]
MOV [ESP+20],EBP
// h:=h+e;
ADD [ESP+32],EBP
// f:=f+g;
MOV EBP,[ESP+28]
ADD [ESP+24],EBP
// f := f xor (g shr 4);
SHR EBP,4
XOR EBP,[ESP+24]
MOV [ESP+24],EBP
// a:=a+f;
ADD EAX,EBP
// g:=g+h;
MOV EBP,[ESP+32]
ADD [ESP+28],EBP
// g := g xor (h shl 8);
SHL EBP,8
XOR EBP,[ESP+28]
MOV [ESP+28],EBP
// b:=b+g;
ADD EBX,EBP
// h:=h+a;
MOV EBP,EAX
ADD [ESP+32],EBP
// h := h xor (a shr 9);
SHR EBP,9
XOR EBP,[ESP+32]
MOV [ESP+32],EBP
// c:=c+h;
ADD ECX,EBP
// a:=a+b;
ADD EAX,EBX
// mem[i ]:=a; mem[i+1]:=b; mem[i+2]:=c; mem[i+3]:=d;
// mem[i+4]:=e; mem[i+5]:=f; mem[i+6]:=g; mem[i+7]:=h;
MOV EBP,[ESP+36]
LEA ESI,EDI.mem[EBP*TYPE INTEGER]
MOV EBP,[ESP+20]
MOV [ESI],EAX
MOV [ESI+4*TYPE INTEGER],EBP
MOV EBP,[ESP+24]
MOV [ESI+1*TYPE INTEGER],EBX
MOV [ESI+5*TYPE INTEGER],EBP
MOV EBP,[ESP+28]
MOV [ESI+2*TYPE INTEGER],ECX
MOV [ESI+6*TYPE INTEGER],EBP
MOV EBP,[ESP+32]
MOV [ESI+3*TYPE INTEGER],EDX
MOV [ESI+7*TYPE INTEGER],EBP
MOV EBP,[ESP+36]
ADD EBP,8
MOV [ESP+36],EBP
CMP EBP,256
JNZ @USE_RSL
OR DWORD PTR [ESP],FALSE
JZ @END
// i := 0;
XOR EBP,EBP
MOV [ESP+36],EBP // [ESP+36] has be set to zero here
// do a second pass to make all of the seed affect all of mem
@USE_MEM:
// a:=a+mem[i ]; b:=b+mem[i+1]; c:=c+mem[i+2]; d:=d+mem[i+3];
// e:=e+mem[i+4]; f:=f+mem[i+5]; g:=g+mem[i+6]; h:=h+mem[i+7];
LEA ESI,EDI.mem[EBP*TYPE INTEGER]
MOV EBP,[ESI+4*TYPE INTEGER]
ADD EAX,[ESI]
ADD [ESP+20],EBP
MOV EBP,[ESI+5*TYPE INTEGER]
ADD EBX,[ESI+1*TYPE INTEGER]
ADD [ESP+24],EBP
MOV EBP,[ESI+6*TYPE INTEGER]
ADD ECX,[ESI+2*TYPE INTEGER]
ADD [ESP+28],EBP
MOV EBP,[ESI+7*TYPE INTEGER]
ADD EDX,[ESI+3*TYPE INTEGER]
ADD [ESP+32],EBP
MOV EBP,EBX
// a := a xor (b shl 11);
SHL EBP,11
XOR EAX,EBP
// d:=d+a;
ADD EDX,EAX
// b:=b+c;
MOV EBP,ECX
ADD EBX,ECX
// b := b xor (c shr 2);
SHR EBP,2
XOR EBX,EBP
// e:=e+b;
ADD [ESP+20],EBX
// c:=c+d;
MOV EBP,EDX
ADD ECX,EDX
// c := c xor (d shl 8);
SHL EBP,8
XOR ECX,EBP
// f:=f+c;
ADD [ESP+24],ECX
// d:=d+e;
MOV EBP,[ESP+20]
ADD EDX,EBP
// d := d xor (e shr 16);
SHR EBP,16
XOR EDX,EBP
// g:=g+d;
ADD [ESP+28],EDX
// e:=e+f;
MOV EBP,[ESP+24]
ADD [ESP+20],EBP
// e := e xor (f shl 10);
SHL EBP,10
XOR EBP,[ESP+20]
MOV [ESP+20],EBP
// h:=h+e;
ADD [ESP+32],EBP
// f:=f+g;
MOV EBP,[ESP+28]
ADD [ESP+24],EBP
// f := f xor (g shr 4);
SHR EBP,4
XOR EBP,[ESP+24]
MOV [ESP+24],EBP
// a:=a+f;
ADD EAX,EBP
// g:=g+h;
MOV EBP,[ESP+32]
ADD [ESP+28],EBP
// g := g xor (h shl 8);
SHL EBP,8
XOR EBP,[ESP+28]
MOV [ESP+28],EBP
// b:=b+g;
ADD EBX,EBP
// h:=h+a;
MOV EBP,EAX
ADD [ESP+32],EBP
// h := h xor (a shr 9);
SHR EBP,9
XOR EBP,[ESP+32]
MOV [ESP+32],EBP
// c:=c+h;
ADD ECX,EBP
// a:=a+b;
ADD EAX,EBX
// mem[i ]:=a; mem[i+1]:=b; mem[i+2]:=c; mem[i+3]:=d;
// mem[i+4]:=e; mem[i+5]:=f; mem[i+6]:=g; mem[i+7]:=h;
MOV EBP,[ESP+36]
LEA ESI,EDI.mem[EBP*TYPE INTEGER]
MOV EBP,[ESP+20]
MOV [ESI],EAX
MOV [ESI+4*TYPE INTEGER],EBP
MOV EBP,[ESP+24]
MOV [ESI+1*TYPE INTEGER],EBX
MOV [ESI+5*TYPE INTEGER],EBP
MOV EBP,[ESP+28]
MOV [ESI+2*TYPE INTEGER],ECX
MOV [ESI+6*TYPE INTEGER],EBP
MOV EBP,[ESP+32]
MOV [ESI+3*TYPE INTEGER],EDX
MOV [ESI+7*TYPE INTEGER],EBP
MOV EBP,[ESP+36]
ADD EBP,8
MOV [ESP+36],EBP
CMP EBP,256
JNZ @USE_MEM
@END:
MOV EAX,EDI
POP EDX
POP EBX
POP ESI
POP EDI
POP EBP
ADD ESP,TYPE INTEGER*5
end; // EAX=Self, EDX=flag
{
procedure TIsaac.Isaac;
var
i,x,y : integer;
begin
inc(cc);
bb := bb + cc;
for i := 0 to 255 do
begin
x := mem[i];
case (i and 3) of
0: aa := aa xor (aa shl 13);
1: aa := aa xor (aa shr 6);
2: aa := aa xor (aa shl 2);
3: aa := aa xor (aa shr 16);
end;
aa := aa + mem[(i+128) and 255];
y := mem[(x shr 2) and 255] + aa + bb;
mem[i] := y;
bb := mem[(y shr 10) and 255] + x;
rsl[i] := bb;
end;
count := 0;
end;
}
procedure TIsaac.Isaac; assembler;
asm // EAX=Self
PUSH EBX // temp aa
PUSH EBP // temp bb
PUSH EDI // will take x
PUSH ESI // will take y
// inc(cc)
INC [Self.cc]
// bb := bb + cc;
MOV EBP,[Self.bb]
ADD EBP,[Self.cc]
// i := 0;
XOR ECX,ECX
@LOOP:
MOV EBX,[Self.aa]
// case (i and 3) of
MOV EDX,ECX
AND EDX,3
SUB EDX,1
JC @00
JZ @01
DEC EDX
JZ @02
DEC EDX
JZ @03
@00:
// aa := aa xor (aa shl 13);
MOV EDX,EBX
SHL EDX,13
XOR EBX,EDX
JMP @END
@01:
// aa := aa xor (aa shr 6);
MOV EDX,EBX
SHR EDX,6
XOR EBX,EDX
JMP @END
@02:
// aa := aa xor (aa shl 2);
MOV EDX,EBX
SHL EDX,2
XOR EBX,EDX
JMP @END
@03:
// aa := aa xor (aa shr 16);
MOV EDX,EBX
SHR EDX,16
XOR EBX,EDX
@END:
// aa := aa + mem[(i+128) and 255];
MOV EDX,ECX
ADD EDX,128
AND EDX,255
ADD EBX,DWORD PTR [Self.mem + EDX*TYPE INTEGER]
MOV [Self.aa],EBX
// x := mem[i];
MOV EDI,DWORD PTR [Self.mem + ECX*TYPE INTEGER]
// y := mem[(x shr 2) and 255] + aa + bb;
MOV EDX,EDI
SHR EDX,2
AND EDX,255
MOV ESI,DWORD PTR [Self.mem + EDX*TYPE INTEGER]
ADD ESI,EBX
ADD ESI,EBP
// mem[i] := y;
MOV DWORD PTR [Self.mem + ECX*TYPE INTEGER],ESI
// bb := mem[(y shr 10) and 255] + x;
SHR ESI,10
AND ESI,255
MOV EBP,DWORD PTR [Self.mem + ESI*TYPE INTEGER]
ADD EBP,EDI
// rsl[i] := bb;
MOV DWORD PTR [Self.rsl + ECX*TYPE INTEGER],EBP
// inc(i);
INC ECX
CMP ECX,256
JNZ @LOOP
MOV [Self.bb],EBP
// count := 0;
MOV Self.count,0
POP ESI
POP EDI
POP EBP
POP EBX
end; // EAX=Self
// Call Val to get a random value (32 bits).
{
function TIsaac.Val : integer;
begin
Result := rsl[count];
inc(count);
if (count=256) then Isaac;
end;
}
function TIsaac.Val: integer; assembler;
asm // EAX=Self
// Result := rsl[count];
MOV EDX,[Self.count]
MOV ECX,DWORD PTR [Self.rsl + EDX*TYPE INTEGER]
// inc(count);
INC EDX
MOV [Self.count],EDX
// if (count=256)
CMP EDX,256
JNZ @EXIT
// then get next set of results;
PUSH ECX // store Result
CALL Isaac
POP ECX // restore Result
@EXIT:
MOV EAX,ECX
end; // EAX=Result
{Added by Wuul - so we can limit the size of the number}
function TIsaac.val(max: integer): integer;
begin
result := abs(Val mod max);
end;
initialization
{initialization code goes here}
Isaac := TIsaac.Create;
Isaac.Seed([GetTickCount], true);