Slow Anagram Algorithm - delphi

I have been working on an algorithm to rearranging the letters of a word, but it takes much time to find the correct word.
var
Form1: TForm1;
DictionaryArray : array[0..2000] of string;
const Numbrs : string = '123456789';
implementation
{$R *.dfm}
function GenerateSequence(CPoint : String; L : Integer): String;
var
Increaser : array[1..8] of Integer;
i : Integer;
AnagramSequence : String;
begin
FillChar(Increaser, SizeOf(Increaser), 0);
for i := 1 to Length(CPoint) do
Increaser[9 - i] := StrToInt(CPoint[L + 1 - i]);
//==========================================//
if Increaser[8] <= L then
Increaser[8] := Increaser[8] + 1;
if Increaser[8] > L then
begin
Increaser[8] := 1;
Increaser[7] := Increaser[7] + 1;
end;
if (Increaser[7] > L - 1) and (L > 3) then
begin
Increaser[8] := 1;
Increaser[7] := 1;
Increaser[6] := Increaser[6] + 1;
end;
if (Increaser[6] > L - 2) and (L > 4) then
begin
Increaser[8] := 1;
Increaser[7] := 1;
Increaser[6] := 1;
Increaser[5] := Increaser[5] + 1;
end;
if (Increaser[5] > L - 3) and (L > 5) then
begin
Increaser[8] := 1;
Increaser[7] := 1;
Increaser[6] := 1;
Increaser[5] := 1;
Increaser[4] := Increaser[4] + 1;
end;
if (Increaser[4] > L - 4) and (L > 6) then
begin
Increaser[8] := 1;
Increaser[7] := 1;
Increaser[6] := 1;
Increaser[5] := 1;
Increaser[4] := 1;
Increaser[3] := Increaser[3] + 1;
end;
if (Increaser[3] > L - 5) and (L > 7) then
begin
Increaser[8] := 1;
Increaser[7] := 1;
Increaser[6] := 1;
Increaser[5] := 1;
Increaser[4] := 1;
Increaser[3] := 1;
Increaser[2] := Increaser[2] + 1;
end;
//==========================================//
AnagramSequence := IntToStr(Increaser[1]) + IntToStr(Increaser[2]) + IntToStr(Increaser[3]) + IntToStr(Increaser[4]) + IntToStr(Increaser[5]) + IntToStr(Increaser[6]) + IntToStr(Increaser[7]) + IntToStr(Increaser[8]);
Result := AnsiReplaceStr(AnagramSequence, '0', '')
end;
procedure LoadDictionary(DictionaryPath : String);
var
F : TextFile;
i : Integer;
begin
i := 0;
AssignFile(F, DictionaryPath);
Reset(F);
while not Eof(F) do
begin
Readln(F, DictionaryArray[i]);
Inc(i);
end;
CloseFile(F);
end;
function CheckInDictionary(RandedWord : String): Boolean;
begin
if (AnsiIndexText(RandedWord, DictionaryArray) = -1) then
Result := False
else
Result := True;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
LoadDictionary('wordlist.txt');
Label1.Caption := 'Dictionary: Loaded.';
Label1.Font.Color := clGreen;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
FRand, MRand, RandedWord, AnagramSequence : String;
RandedIndex, i : Integer;
begin
FRand := Edit1.Text;
MRand := FRand;
RandedWord := MRand;
AnagramSequence := StringOfChar('1', Length(FRand));
while CheckInDictionary(RandedWord) = False do
begin
MRand := FRand;
RandedWord := '';
AnagramSequence := GenerateSequence(AnagramSequence, Length(FRand));
for i := Length(AnagramSequence) downto 1 do
begin
Application.ProcessMessages;
RandedIndex := StrToInt(AnagramSequence[i]);
RandedWord := RandedWord + MRand[RandedIndex];
Delete(MRand, RandedIndex, 1);
end;
end;
Edit2.Text := RandedWord;
end;
How can i improve this algorithm?

If what you are doing is checking if an anagram of the letters given is in the dictionairy you might do the following:
(this can be precomputed) for each word in the dictionary sort the letters eg store (aht=hat). and sort the dictionairy on the name (TStringlist can do this with name value pairs)
sort the letters in the string (eg hello -> ehllo)
in the dictionairy search for the items that have the name equal to the sorted letter string.

Related

How can i run a loop procedure in background?

I created a procedure to update an SQLite DB. The procedure runs in a loop until the list is finished. The problem is, when I run the procedure, the program stops responding
How can I run this procedure in the background, without crashing the program?
procedure TForm1.domainupdate;
var
I, J, K, svr: integer ;
domain1, domain2: string ;
expiry: string;
sl: TStringList;
fs: TFormatSettings;
s: string;
dt: TDatetime;
ds : TFormatSettings;
memo : tmemo;
begin
DM.Qdomains.First;
while not DM.Qdomains.Eof do begin
for J := Length (DM.Qdomains.FieldByName('domain').AsString) downto 2 do begin
if DM.Qdomains.FieldByName('domain').AsString [J] = '.' then begin // search host.co.uk
if domain1 = '' then
domain1 := Copy (DM.Qdomains.FieldByName('domain').AsString, J + 1, 99) + IcsSpace
// found uk
else begin
domain2 := Copy (DM.Qdomains.FieldByName('domain').AsString, J + 1, 99) + IcsSpace ;
// found co.uk
Break ;
end;
end;
end;
FWhoisServers := TStringList.Create;
for I := 0 to Length(WhoisNames) - 1 do
FWhoisServers.add(WhoisNames[I]);
FHost := 'whois.ripe.net' ;
K := -1 ;
if FWhoisServers.Count > 0 then begin
for I := 0 to FWhoisServers.Count - 1 do
begin
if (Pos (domain1, FWhoisServers [I]) = 1) then K := I ;
if (Pos (domain2, FWhoisServers [I]) = 1) then
begin
K := I ;
break ;
end ;
end;
if K >= 0 then begin
J := Pos (IcsSpace, FWhoisServers [K]) ;
end;
end;
if K < 0 then begin
end;
IdWhois1.host := Copy (FWhoisServers [K], J + 1, 99) ;
Memo:=TMemo.Create(nil);
Memo.Visible:=false;
memo.Lines.text := IdWhois1.WhoIs(DM.Qdomains.FieldByName('domain').AsString);
begin
sl := TStringList.Create;
try
sl.Assign(Memo.Lines);
for I := 0 to sl.Count-1 do begin
sl[I] := TrimLeft(sl[I]);
end;
sl.NameValueSeparator := ':';
for I := Low(FieldNames) to High(FieldNames) do begin
expiry := Trim(sl.Values[FieldNames[I]]);
if expiry <> '' then
Break;
end;
finally
sl.Free;
end;
if expiry = '' then
exit
else
s := expiry;
fs := TFormatSettings.Create;
fs.DateSeparator := '-';
fs.TimeSeparator := ':';
fs.shortdateformat := 'yyyy-mm-dd';
fs.ShortTimeFormat := 'hh:nn:ss';
dt := StrToDatetime(s, fs);
ds.DateSeparator := '/';
ds.TimeSeparator := ':';
ds.ShortDateFormat := 'dd/mm/yyyy';
ds.longtimeFormat := 'hh:mm:ss';
end;
end;
//********************************************************
//********************************************************
//if edit1.text <> '' then DM.Qdomains.Open;
DM.Qdomains.Edit;
DM.Qdomains.FieldByName('domain').AsString :=
DM.Qdomains.FieldByName('domain').AsString;
DM.Qdomains.FieldByName('expiry').AsString := datetimetostr(dt, ds);
DM.Qdomains.FieldByName('whois').AsString :=
IdWhois1.WhoIs(DM.Qdomains.FieldByName('domain').AsString);
DM.Qdomains.FieldByName('update').AsString := DatetimeToStr(now);
DM.Qdomains.Post;
DM.Qdomains.Next;
end;
Move the logic into a separate worker thread, synchronizing with the main UI thread only when absolutely needed (ie, to show the results). You need to do this anyway if you ever plan on running this code on Android, since you can't perform network operations on the main UI thread.
Also, get rid of the TMemo that the code is creating, it is not needed at all. All you are using it for is to parse the Whois result into a TStringList, which you can do directly. And, you are leaking the TMemo and never showing it to the user anyway.
Try something more like this:
procedure TForm1.DomainUpdate;
var
I, J, K: Integer;
domain, domain1, domain2, host, whois, expiry: string;
sl: TStringList;
fs, ds: TFormatSettings;
dt: TDatetime;
begin
// TODO: perform the DB query here instead of in the main thread...
DM.Qdomains.First;
while not DM.Qdomains.Eof do begin
domain := DM.Qdomains.FieldByName('domain').AsString;
domain1 := '';
domain2 := '';
for J := Length(domain) downto 2 do begin
if domain[J] = '.' then begin // search host.co.uk
if domain1 = '' then
domain1 := Copy(domain, J + 1, MaxInt) + IcsSpace
// found uk
else begin
domain2 := Copy(domain, J + 1, MaxInt) + IcsSpace;
// found co.uk
Break;
end;
end;
end;
FWhoisServers := TStringList.Create;
try
for I := 0 to Length(WhoisNames) - 1 do
FWhoisServers.Add(WhoisNames[I]);
host := 'whois.ripe.net';
K := -1;
if FWhoisServers.Count > 0 then begin
for I := 0 to FWhoisServers.Count - 1 do
begin
if (Pos(domain1, FWhoisServers[I]) = 1) then K := I;
if (Pos(domain2, FWhoisServers[I]) = 1) then
begin
K := I;
Break;
end;
end;
if K >= 0 then begin
J := Pos(IcsSpace, FWhoisServers[K]);
host := Copy(FWhoisServers[K], J + 1, MaxInt);
end;
end;
IdWhois1.Host := host;
finally
FWhoisServers.Free;
end;
expiry := '';
sl := TStringList.Create;
try
whois := IdWhois1.WhoIs(domain);
sl.Text := whois;
for I := 0 to sl.Count-1 do begin
sl[I] := TrimLeft(sl[I]);
end;
sl.NameValueSeparator := ':';
for I := Low(FieldNames) to High(FieldNames) do begin
expiry := Trim(sl.Values[FieldNames[I]]);
if expiry <> '' then
Break;
end;
finally
sl.Free;
end;
if expiry <> '' then begin
fs := TFormatSettings.Create;
fs.DateSeparator := '-';
fs.TimeSeparator := ':';
fs.ShortDateFormat := 'yyyy-mm-dd';
fs.ShortTimeFormat := 'hh:nn:ss';
dt := StrToDateTime(expiry, fs);
ds := TFormatSettings.Create;
ds.DateSeparator := '/';
ds.TimeSeparator := ':';
ds.ShortDateFormat := 'dd/mm/yyyy';
ds.LongTimeFormat := 'hh:mm:ss';
DM.Qdomains.Edit;
try
DM.Qdomains.FieldByName('domain').AsString := domain;
DM.Qdomains.FieldByName('expiry').AsString := DateTimeToStr(dt, ds);
DM.Qdomains.FieldByName('whois').AsString := whois;
DM.Qdomains.FieldByName('update').AsString := DateTimeToStr(Now);
DM.Qdomains.Post;
except
DM.Qdomains.Cancel;
raise;
end;
end;
DM.Qdomains.Next;
end;
end;
...
TThread.CreateAnonymousThread(DomainUpdate).Start;

From TcxCheckListBox to TcxCheckGroupBox (Load States from TStringStream)

Anyone can help how can I transfrom this to work with TcxCheckGroup? My procedure can be load checked Items states to cxCheckListBox.
Working example with TcxCheckListBox...
procedure Tfrm.LoadStatesFromStream(SS: TStringStream);
var
i : integer;
S2 : String;
begin
SS.Position := 0;
i := 0;
while (i <= cxCheckListBox1.Items.Count - 1) and (SS.Position < SS.Size) do
begin
S2 := SS.ReadString(1);
cxCheckListBox1.Items[i].Checked := S2 = '+';
Inc(i);
end;
end;
I need a help with...
procedure Tfrm.LoadStatesFromStream(SS: TStringStream);
var
i : integer;
S2 : String;
begin
SS.Position := 0;
i := 0;
while (i <= cxCheckGroup1.Properties.Items.Count - 1) and (SS.Position < SS.Size) do
begin
S2 := SS.ReadString(1);
(cxCheckGroup1.States[i] = cbschecked ):= S2 = '+'; //I have a problem here
Inc(i);
end;
end;
Thanks for the help!
See the code below; I assumed that you want to include the possibility that a checkbox's state might be cbsGrayed (which I've represented by a space character in the StringStream.
function CheckBoxStateToString(CheckBoxState : TcxCheckBoxState ) : String;
begin
Result := '';
case CheckBoxState of
cbsChecked : Result := '+';
cbsUnChecked : Result := '-';
cbsGrayed : Result := ' ';
end;
end;
function StringToCheckBoxState(Input : String) : TcxCheckBoxState;
begin
Result := cbsGrayed;
if Input = '+' then
Result := cbsChecked
else
if Input = '-' then
Result := cbsUnChecked
end;
procedure TForm1.SaveCheckGroupStatesToStream(SS : TStringStream);
var
i : integer;
begin
SS.Clear;
SS.Position := 0;
for i := 0 to cxCheckGroup1.Properties.Items.Count - 1 do begin
SS.WriteString(CheckBoxStateToString(cxCheckGroup1.States[i]));
end;
Memo1.Lines.Add('>' + SS.DataString + '<');
end;
procedure TForm1.LoadCheckGroupStatesFromStream(SS : TStringStream);
var
i : integer;
S : String;
begin
CheckBoxList.ClearCheckmarks;
SS.Position := 0;
i := 0;
while (i <= cxCheckGroup1.Properties.Items.Count - 1) and (SS.Position < SS.Size) do begin
S := SS.ReadString(1);
cxCheckGroup1.States[i] := StringToCheckBoxState(S);
Inc(i);
end;
end;

Adjust Column width DBGrid

I have a TDBGrid. It works, but the columns shown are very large.
How can I set an "auto-fix column width"?
The needed Columnwidth is depended of the settings of the Grids canvas and the mamimum length of the displaytext of each field.
procedure FitGrid(Grid: TDBGrid);
const
C_Add=3;
var
ds: TDataSet;
bm: TBookmark;
i: Integer;
w: Integer;
a: Array of Integer;
begin
ds := Grid.DataSource.DataSet;
if Assigned(ds) then
begin
ds.DisableControls;
bm := ds.GetBookmark;
try
ds.First;
SetLength(a, Grid.Columns.Count);
while not ds.Eof do
begin
for I := 0 to Grid.Columns.Count - 1 do
begin
if Assigned(Grid.Columns[i].Field) then
begin
w := Grid.Canvas.TextWidth(ds.FieldByName(Grid.Columns[i].Field.FieldName).DisplayText);
if a[i] < w then
a[i] := w ;
end;
end;
ds.Next;
end;
for I := 0 to Grid.Columns.Count - 1 do
Grid.Columns[i].Width := a[i] + C_Add;
ds.GotoBookmark(bm);
finally
ds.FreeBookmark(bm);
ds.EnableControls;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
FitGrid(DBgrid1)
end;
Minor modification of bummi's answer to insure that Title Row (Row 0) is not truncated, and excess space will be allocated on each column
procedure FitGrid(Grid: TDBGrid);
const
C_Add = 3;
var
ds: TDataSet;
bm: TBookmark;
i: Integer;
w: Integer;
a: array of Integer;
begin
ds := Grid.DataSource.DataSet;
if not Assigned(ds) then
exit;
if Grid.Columns.Count = 0 then
exit;
ds.DisableControls;
bm := ds.GetBookmark;
try
ds.First;
SetLength(a, Grid.Columns.Count);
for i := 0 to Grid.Columns.Count - 1 do
if Assigned(Grid.Columns[i].Field) then
a[i] := Grid.Canvas.TextWidth(Grid.Columns[i].FieldName);
while not ds.Eof do
begin
for i := 0 to Grid.Columns.Count - 1 do
begin
if not Assigned(Grid.Columns[i].Field) then
continue;
w := Grid.Canvas.TextWidth(ds.FieldByName(Grid.Columns[i].Field.FieldName).DisplayText);
if a[i] < w then
a[i] := w;
end;
ds.Next;
end;
w := 0;
for i := 0 to Grid.Columns.Count - 1 do
begin
Grid.Columns[i].Width := a[i] + C_Add;
inc(w, a[i] + C_Add);
end;
w := (Grid.ClientWidth - w - 20) div (Grid.Columns.Count);
if w > 0 then
for i := 0 to Grid.Columns.Count - 1 do
Grid.Columns[i].Width := Grid.Columns[i].Width + w;
ds.GotoBookmark(bm);
finally
ds.FreeBookmark(bm);
ds.EnableControls;
end;
end;
Minor modification of bummi's answer to insure that Title Row (Row 0) is not truncated
procedure FitGrid(Grid: TDBGrid);
const
C_Add=3;
var
ds: TDataSet;
bm: TBookmark;
i: Integer;
w: Integer;
a: Array of Integer;
begin
ds := Grid.DataSource.DataSet;
if Assigned(ds) then
begin
ds.DisableControls;
bm := ds.GetBookmark;
try
ds.First;
SetLength(a, Grid.Columns.Count);
while not ds.Eof do
begin
for I := 0 to Grid.Columns.Count - 1 do
begin
if Assigned(Grid.Columns[i].Field) then
begin
w := Grid.Canvas.TextWidth(ds.FieldByName(Grid.Columns[i].Field.FieldName.).DisplayText);
if a[i] < w then
a[i] := w ;
end;
end;
ds.Next;
end;
//if fieldwidth is smaller than Row 0 (field names) fix
for I := 0 to Grid.Columns.Count - 1 do
begin
w := Grid.Canvas.TextWidth(Grid.Columns[i].Field.FieldName);
if a[i] < w then
a[i] := w ;
end;
for I := 0 to Grid.Columns.Count - 1 do
Grid.Columns[i].Width := a[i] + C_Add;
ds.GotoBookmark(bm);
finally
ds.FreeBookmark(bm);
ds.EnableControls;
end;
end;
end;
Minor modification of bummi's, TheSteven's and Jens' answers to insure that Title Row (Row 0) is not truncated, and excess space will be allocated on each column, and take visibility of columns into account.
procedure FitGrid(const Grid: TDBGrid; const CoverWhiteSpace: Boolean = True);
const
C_Add=3;
var
DS: TDataSet;
BM: TBookmark;
I, W, VisibleColumnsCount: Integer;
A: array of Integer;
VisibleColumns: array of TColumn;
begin
DS := Grid.DataSource.DataSet;
if Assigned(DS) then
begin
VisibleColumnsCount := 0;
SetLength(VisibleColumns, Grid.Columns.Count);
for I := 0 to Grid.Columns.Count - 1 do
if Assigned(Grid.Columns[I].Field) and (Grid.Columns[I].Visible) then
begin
VisibleColumns[VisibleColumnsCount] := Grid.Columns[I];
Inc(VisibleColumnsCount);
end;
SetLength(VisibleColumns, VisibleColumnsCount);
DS.DisableControls;
BM := DS.GetBookmark;
try
DS.First;
SetLength(A, VisibleColumnsCount);
while not DS.Eof do
begin
for I := 0 to VisibleColumnsCount - 1 do
begin
W := Grid.Canvas.TextWidth(DS.FieldByName(VisibleColumns[I].Field.FieldName).DisplayText);
if A[I] < W then
A[I] := W;
end;
DS.Next;
end;
//if fieldwidth is smaller than Row 0 (field names) fix
for I := 0 to VisibleColumnsCount - 1 do
begin
W := Grid.Canvas.TextWidth(VisibleColumns[I].Field.FieldName);
if A[I] < W then
A[I] := W;
end;
W := 0;
if CoverWhiteSpace then
begin
for I := 0 to VisibleColumnsCount - 1 do
Inc(W, A[I] + C_Add);
W := (Grid.ClientWidth - W - 20) div VisibleColumnsCount;
if W < 0 then
W := 0;
end;
for I := 0 to VisibleColumnsCount - 1 do
VisibleColumns[I].Width := A[I] + C_Add + W;
DS.GotoBookmark(BM);
finally
DS.FreeBookmark(BM);
DS.EnableControls;
end;
end;
end;
I found 'Columns' in the properties of my TDBGrid and new window is opened. In that window I add new FieldNames - you can choose columnNames only from the result of your SQL string of your TADOQuery and then when you click to the exact column you can find 'Width' in the properties of selected column so change it whatever you like. It works for me.
I'm afraid the last adaptation of the code is no correct.
I would rather write something like :
const
C_Add=20;
//.....
Sup := 0;
if CoverWhiteSpace then
sup :=C_Add;
for I := 0 to VisibleColumnsCount - 1 do
VisibleColumns[I].Width := A[I] + sup;
DS.GotoBookmark(BM);

Search in TcxGrid

I have this code to search through a DevExpress TcxGrid:
function SearchIncxGrid(AView: TcxGridTableView; AText: string; AFromBeginning: boolean): boolean;
function Compare(const ARecIndex, AColIndex: integer): boolean;
begin
Result := AnsiContainsText(AView.DataController.DisplayTexts[ARecIndex, AView.VisibleColumns[AColIndex].Index], AText);
end;
var
GroupsIndex: integer;
GroupsCount: integer;
ChildCount: integer;
ColIndex: integer;
RowIndex: integer;
RecIndex: integer;
CurIndex: integer;
i, j, k: integer;
begin
Result := false;
AView.DataController.ClearSelection;
if AFromBeginning then
begin
// поиск с начала
// строка - первая
// столбец - первый
AView.DataController.GotoFirst;
RowIndex := 0;
ColIndex := 0;
end
else
begin
// поиск с текущей позиции
// строка - текущая
// столбец - текущий
// если текущий столбец - последний, то переходим к след. столбцу
RowIndex := AView.Controller.FocusedRowIndex;
ColIndex := AView.Controller.FocusedColumnIndex;
if AView.Controller.FocusedColumn.IsLast then
begin
ColIndex := 0;
Inc(RowIndex);
end
else
begin
Inc(ColIndex)
end;
end;
if AView.DataController.Groups.GroupingItemCount = 0 then
begin
// поиск в несгруппированном представлении
for i := RowIndex to AView.ViewData.RowCount - 1 do
begin
RecIndex := AView.ViewData.Rows[i].RecordIndex;
if RecIndex = -1 then
Continue;
for j := ColIndex to AView.VisibleColumnCount - 1 do
begin
Result := Compare(RecIndex, j);
if Result then
begin
AView.Controller.FocusedRecordIndex := RecIndex;
AView.Controller.FocusedColumnIndex := j;
Break;
end;
end;
ColIndex := 0;
if Result then
Break;
end;
end
else
begin
// поиск в сгруппированном представлении
GroupsCount := TcxDataControllerGroupsProtected(AView.DataController.Groups).DataGroups.Count;
GroupsIndex := AView.DataController.Groups.DataGroupIndexByRowIndex[RowIndex];
for i := GroupsIndex to GroupsCount - 1 do
begin
ChildCount := AView.DataController.Groups.ChildCount[i];
for j := 0 to ChildCount - 1 do
begin
RecIndex := AView.DataController.Groups.ChildRecordIndex[i, j];
if RecIndex = -1 then
Continue;
CurIndex := AView.DataController.GetRowIndexByRecordIndex(RecIndex, false);
if (CurIndex > -1) and (CurIndex < RowIndex) then
Continue;
for k := ColIndex to AView.VisibleColumnCount - 1 do
begin
Result := Compare(RecIndex, k);
if Result then
begin
AView.Controller.FocusedRowIndex := AView.DataController.GetRowIndexByRecordIndex(RecIndex, true);
AView.Controller.FocusedColumnIndex := k;
Break;
end;
end;
ColIndex := 0;
if Result then
Break;
end;
if Result then Break;
end;
end;
// if Result then
// begin
// AView.DataController.ClearSelection;
// AView.Controller.FocusedRecord.Selected := true;
// end;
end;
Search works well as long as the grid is not sorted.
When the cxGrid is sorted, there is an incorrect positioning of the cursor after search.
Is there a universal and correct decision to search in cxGrid?

programatically extract the file name from a Download Link using delphi

How i can extract the file name from a Download Link using Delphi
Example
http://pj-mirror01.mozilla.org/pub/mozilla.org/firefox/releases/3.6/win32/es-CL/Firefox%20Setup%203.6.exe
The result must be
Firefox Setup 3.6.exe
Try this
function GetURLFilename(const FilePath:String;Const Delimiter:String='/'):String;
var I: Integer;
begin
I := LastDelimiter(Delimiter, FILEPATH);
Result := Copy(FILEPATH, I + 1, MaxInt);
Result := UrlDecode(Result);
end;
URlDecode was copied from http://www.torry.net/dpfl/dzurl.html and looks like
function UrlDecode(const EncodedStr: String): String;
var
I: Integer;
begin
Result := '';
if Length(EncodedStr) > 0 then
begin
I := 1;
while I <= Length(EncodedStr) do
begin
if EncodedStr[I] = '%' then
begin
Result := Result + Chr(HexToInt(EncodedStr[I+1]
+ EncodedStr[I+2]));
I := Succ(Succ(I));
end
else if EncodedStr[I] = '+' then
Result := Result + ' '
else
Result := Result + EncodedStr[I];
I := Succ(I);
end;
end;
end;
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;

Resources