mirror of
https://github.com/HeidiSQL/HeidiSQL.git
synced 2025-08-06 18:24:26 +08:00
420 lines
10 KiB
ObjectPascal
420 lines
10 KiB
ObjectPascal
unit HashTableGen;
|
|
|
|
{$I SynEdit.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
|
|
Dialogs, StdCtrls, ComCtrls;
|
|
|
|
type
|
|
TFrmHashTableGen = class(TForm)
|
|
LabelParams: TLabel;
|
|
LabelD: TLabel;
|
|
LabelC: TLabel;
|
|
LabelM: TLabel;
|
|
Label1: TLabel;
|
|
Label2: TLabel;
|
|
LabelPercentage: TLabel;
|
|
ProgressBar1: TProgressBar;
|
|
EditD: TMemo;
|
|
EditC: TMemo;
|
|
EditM: TMemo;
|
|
ButtonFindHash: TButton;
|
|
procedure ButtonFindHashClick(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
|
private
|
|
FKeyList: TList;
|
|
FCaseSensitive: Boolean;
|
|
public
|
|
procedure AssignKeyWords(KeyList: TList; CaseSensitive: Boolean);
|
|
function GetHashKeyFunctionSource(ClassName: string): string;
|
|
function GetKeyWordConstantsSource(CaseSensitive: Boolean): string;
|
|
function KeyIndicesCount: Integer;
|
|
end;
|
|
|
|
const
|
|
MaxTableSize = 100000;
|
|
|
|
type
|
|
THashKeyList = class
|
|
private
|
|
FMaxHashKey: Integer;
|
|
FHashKeys: array[0..MaxTableSize - 1] of Boolean;
|
|
public
|
|
function Add(HashKey: Integer): Boolean;
|
|
procedure Clear;
|
|
end;
|
|
|
|
var
|
|
FrmHashTableGen: TFrmHashTableGen;
|
|
|
|
implementation
|
|
|
|
{$R *.dfm}
|
|
|
|
uses
|
|
{$IFDEF SYN_COMPILER_6_UP}
|
|
StrUtils,
|
|
{$ENDIF}
|
|
SynGenUnit,
|
|
SynUnicode;
|
|
|
|
{$I primenumbers.inc}
|
|
|
|
var
|
|
c, d, m: Cardinal;
|
|
FinalC, FinalD, FinalM: Cardinal;
|
|
searching: Boolean;
|
|
KeyWords: array of UnicodeString;
|
|
HashKeyList: THashKeyList;
|
|
|
|
{$Q-}
|
|
function HashKey(const S: UnicodeString): Cardinal;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := 0;
|
|
for i := 1 to Length(S) do
|
|
Result := Result * c + Ord(S[i]) * d;
|
|
Result := Result mod m;
|
|
end;
|
|
{$Q+}
|
|
|
|
{$Q-}
|
|
function FinalHashKey(const S: UnicodeString): Cardinal;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := 0;
|
|
for i := 1 to Length(S) do
|
|
Result := Result * FinalC + Ord(S[i]) * FinalD;
|
|
Result := Result mod FinalM;
|
|
end;
|
|
{$Q+}
|
|
|
|
procedure WordWrapAtCol80(Words, Result: TStrings; Indentation: Integer);
|
|
var
|
|
WrappedLines: TStringList;
|
|
i: Integer;
|
|
Line: string;
|
|
begin
|
|
WrappedLines := TStringList.Create;
|
|
try
|
|
i := 0;
|
|
|
|
while i < Words.Count do
|
|
begin
|
|
Line := StringOfChar(' ', Indentation);
|
|
while (i < Words.Count) and (Length(Line) + Length(Words[i]) <= 80) do
|
|
begin
|
|
Line := Line + Words[i] + ' ';
|
|
inc(i);
|
|
end;
|
|
WrappedLines.Add(Line);
|
|
end;
|
|
|
|
Result.Assign(WrappedLines);
|
|
finally
|
|
WrappedLines.Free;
|
|
end;
|
|
end;
|
|
|
|
{ TFrmHashTableGen }
|
|
|
|
procedure TFrmHashTableGen.FormCreate(Sender: TObject);
|
|
begin
|
|
HashKeyList := THashKeyList.Create;
|
|
ProgressBar1.Max := 1000;
|
|
end;
|
|
|
|
procedure TFrmHashTableGen.FormDestroy(Sender: TObject);
|
|
begin
|
|
HashKeyList.Free;
|
|
end;
|
|
|
|
procedure TFrmHashTableGen.AssignKeyWords(KeyList: TList; CaseSensitive: Boolean);
|
|
var
|
|
i: Integer;
|
|
KeyWordsList: TStringList;
|
|
begin
|
|
FKeyList := nil;
|
|
FCaseSensitive := CaseSensitive;
|
|
SetLength(KeyWords, 0);
|
|
HashKeyList.Clear;
|
|
|
|
KeyWordsList := TStringList.Create;
|
|
try
|
|
KeyWordsList.Sorted := True;
|
|
KeyWordsList.Duplicates := dupIgnore;
|
|
for i := 0 to KeyList.Count - 1 do
|
|
KeyWordsList.Add(TLexKeys(KeyList[i]).KeyName);
|
|
|
|
SetLength(KeyWords, KeyWordsList.Count);
|
|
if CaseSensitive then
|
|
for i := 0 to KeyWordsList.Count - 1 do
|
|
KeyWords[i] := KeyWordsList[i]
|
|
else
|
|
for i := 0 to KeyWordsList.Count - 1 do
|
|
KeyWords[i] := SynWideLowerCase(KeyWordsList[i]);
|
|
|
|
FKeyList := KeyList;
|
|
finally
|
|
KeyWordsList.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TFrmHashTableGen.FormShow(Sender: TObject);
|
|
begin
|
|
c := 0;
|
|
d := 0;
|
|
m := 0;
|
|
FinalC := 0;
|
|
FinalD := 0;
|
|
FinalM := 0;
|
|
ProgressBar1.Position := 0;
|
|
EditD.Lines.Text := '0';
|
|
EditC.Lines.Text := '0';
|
|
EditM.Lines.Text := '0';
|
|
LabelPercentage.Caption := '0%';
|
|
ButtonFindHash.SetFocus;
|
|
ButtonFindHash.Caption := 'Find Hash Params';
|
|
end;
|
|
|
|
procedure TFrmHashTableGen.FormClose(Sender: TObject;
|
|
var Action: TCloseAction);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if Assigned(FKeyList) then
|
|
begin
|
|
for i := 0 to FKeyList.Count - 1 do
|
|
with TLexKeys(FKeyList[i]) do
|
|
begin
|
|
if FCaseSensitive then
|
|
key := FinalHashKey(KeyName)
|
|
else
|
|
Key := FinalHashKey(SynWideLowerCase(KeyName));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TFrmHashTableGen.ButtonFindHashClick(Sender: TObject);
|
|
var
|
|
i, j: Integer;
|
|
collided: Boolean;
|
|
Key, smallestM: Cardinal;
|
|
|
|
procedure SearchStop;
|
|
begin
|
|
ButtonFindHash.Caption := 'Find Hash Params';
|
|
searching := False;
|
|
Close;
|
|
if FinalM = 0 then
|
|
raise Exception.Create('Cannot build the hashtable as no working hash parameters were found');
|
|
end;
|
|
|
|
begin
|
|
collided := False;
|
|
|
|
if searching then
|
|
begin
|
|
SearchStop;
|
|
Exit;
|
|
end
|
|
else
|
|
begin
|
|
ProgressBar1.Position := 0;
|
|
LabelPercentage.Caption := '0%';
|
|
Application.ProcessMessages;
|
|
|
|
if Length(KeyWords) = 0 then exit;
|
|
|
|
searching := True;
|
|
ButtonFindHash.Caption := 'Stop Search';
|
|
end;
|
|
|
|
smallestM := MaxTableSize + 1;
|
|
|
|
for d := 1 to 1000 do
|
|
begin
|
|
for c := 1 to 1000 do
|
|
for j := 0 to High(PrimeNumbers) do
|
|
begin
|
|
m := PrimeNumbers[j];
|
|
if m >= smallestM then
|
|
begin
|
|
m := smallestM;
|
|
Break;
|
|
end;
|
|
for i := Low(KeyWords) to High(KeyWords) do
|
|
begin
|
|
Key := HashKey(KeyWords[i]);
|
|
collided := HashKeyList.Add(Key);
|
|
if collided then
|
|
begin
|
|
HashKeyList.Clear;
|
|
break;
|
|
end;
|
|
end;
|
|
if not collided then
|
|
begin
|
|
smallestM := m;
|
|
EditD.Lines.Text := IntToStr(d);
|
|
EditC.Lines.Text := IntToStr(c);
|
|
EditM.Lines.Text := IntToStr(m);
|
|
FinalD := d;
|
|
FinalC := c;
|
|
FinalM := m;
|
|
if m = Cardinal(Length(KeyWords)) then
|
|
begin
|
|
ProgressBar1.Position := ProgressBar1.Max;
|
|
LabelPercentage.Caption := '100%';
|
|
SearchStop;
|
|
Exit;
|
|
end;
|
|
break; // all the following solutions will only have a bigger array
|
|
end;
|
|
Application.ProcessMessages;
|
|
if not searching then
|
|
begin
|
|
SearchStop;
|
|
Exit;
|
|
end;
|
|
end;
|
|
ProgressBar1.Position := d;
|
|
LabelPercentage.Caption := FloatToStr(d / 10) + '%';
|
|
Application.ProcessMessages;
|
|
end;
|
|
|
|
SearchStop;
|
|
end;
|
|
|
|
function TFrmHashTableGen.GetHashKeyFunctionSource(ClassName: string): string;
|
|
begin
|
|
Result := '{$Q-}'#13#10;
|
|
Result := Result + Format('function %s.HashKey(Str: PWideChar): Cardinal;', [ClassName]) + #13#10;
|
|
Result := Result + 'begin'#13#10;
|
|
Result := Result + ' Result := 0;'#13#10;
|
|
Result := Result + ' while IsIdentChar(Str^) do'#13#10;
|
|
Result := Result + ' begin'#13#10;
|
|
if (FinalC = 1) and (FinalD = 1) then
|
|
Result := Result + ' Result := Result + Ord(Str^);'#13#10
|
|
else if FinalC = 1 then
|
|
Result := Result + Format(' Result := Result + Ord(Str^) * %d;', [FinalD]) + #13#10
|
|
else if FinalD = 1 then
|
|
Result := Result + Format(' Result := Result * %d + Ord(Str^);', [FinalC]) + #13#10
|
|
else
|
|
Result := Result + Format(' Result := Result * %d + Ord(Str^) * %d;', [FinalC, FinalD]) + #13#10;
|
|
Result := Result + ' inc(Str);'#13#10;
|
|
Result := Result + ' end;'#13#10;
|
|
Result := Result + ' Result := Result mod ' + IntToStr(FinalM) + ';'#13#10;
|
|
Result := Result + ' fStringLen := Str - fToIdent;'#13#10;
|
|
Result := Result + 'end;'#13#10;
|
|
Result := Result + '{$Q+}'#13#10;
|
|
end;
|
|
|
|
{$IFNDEF SYN_COMPILER_6_UP}
|
|
function DupeString(const AText: string; ACount: Integer): string;
|
|
var
|
|
P: PChar;
|
|
C: Integer;
|
|
begin
|
|
C := Length(AText);
|
|
SetLength(Result, C * ACount);
|
|
P := Pointer(Result);
|
|
if P = nil then Exit;
|
|
while ACount > 0 do
|
|
begin
|
|
Move(Pointer(AText)^, P^, C);
|
|
Inc(P, C);
|
|
Dec(ACount);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TFrmHashTableGen.GetKeyWordConstantsSource(CaseSensitive: Boolean): string;
|
|
var
|
|
i: Integer;
|
|
sl: TStringList;
|
|
LastItem: string;
|
|
begin
|
|
// write KeyWords
|
|
if not CaseSensitive then
|
|
Result := Result + ' // as this language is case-insensitive keywords *must* be in lowercase'#13#10;
|
|
Result := Result + Format(' KeyWords: array[0..%d] of UnicodeString = (', [High(KeyWords)]) + #13#10;
|
|
sl := TStringList.Create;
|
|
try
|
|
for i := Low(KeyWords) to High(KeyWords) do
|
|
sl.Add(#39 + KeyWords[i] + #39 + ',');
|
|
|
|
if sl.Count > 0 then
|
|
begin
|
|
// remove comma from last line
|
|
LastItem := sl[sl.Count - 1];
|
|
Delete(LastItem, Length(LastItem), 1);
|
|
sl[sl.Count - 1] := LastItem;
|
|
|
|
WordWrapAtCol80(sl, sl, 4);
|
|
|
|
Result := Result + sl.Text;
|
|
end;
|
|
finally
|
|
sl.Free;
|
|
end;
|
|
Result := Result + ' );'#13#10;
|
|
|
|
Result := Result + #13#10;
|
|
|
|
// write KeyIndices
|
|
Result := Result + Format(' KeyIndices: array[0..%d] of Integer = (', [FinalM - 1]) + #13#10;
|
|
sl := TStringList.Create;
|
|
try
|
|
sl.Text := DupeString('-1,'#13#10, FinalM);
|
|
for i := Low(KeyWords) to High(KeyWords) do
|
|
sl[FinalHashKey(KeyWords[i])] := IntToStr(i) + ',';
|
|
|
|
if sl.Count > 0 then
|
|
begin
|
|
// remove comma from last line
|
|
LastItem := Trim(sl[sl.Count - 1]);
|
|
Delete(LastItem, Length(LastItem), 1);
|
|
sl[sl.Count - 1] := LastItem;
|
|
|
|
WordWrapAtCol80(sl, sl, 4);
|
|
|
|
Result := Result + sl.Text;
|
|
end;
|
|
finally
|
|
sl.Free;
|
|
end;
|
|
Result := Result + ' );'#13#10;
|
|
end;
|
|
|
|
function TFrmHashTableGen.KeyIndicesCount: Integer;
|
|
begin
|
|
Result := FinalM;
|
|
end;
|
|
|
|
{ THashKeyList }
|
|
|
|
function THashKeyList.Add(HashKey: Integer): Boolean;
|
|
begin
|
|
if HashKey > FMaxHashKey then
|
|
FMaxHashKey := HashKey;
|
|
Result := FHashKeys[HashKey];
|
|
FHashKeys[HashKey] := True;
|
|
end;
|
|
|
|
procedure THashKeyList.Clear;
|
|
begin
|
|
FillChar(FHashKeys, FMaxHashKey + 1, 0);
|
|
FMaxHashKey := 0;
|
|
end;
|
|
|
|
end.
|