SRL Archive - Help and Support

Chars!

Santa_Clause

2008-09-18 05:29:08

Just a quick request, I don't have time to make it.

I'd like a function/procedure called FindPossibleWords(WordLength : Integer);

Basically what it does it, it finds every possible combination of letters and numbers used to make a word with 'WordLength' characters.

For example, FindPossibleWords(3) would yield similar results:

  • aaa
  • aab
  • aac
  • aad

And so on. Anyone have enough time to write it up?

Daniel

2008-09-18 05:37:00

From: Santa_Clause
Just a quick request, I don't have time to make it.

I'd like a function/procedure called FindPossibleWords(WordLength : Integer);

Basically what it does it, it finds every possible combination of letters and numbers used to make a word with 'WordLength' characters.

For example, FindPossibleWords(3) would yield similar results:

  • aaa
  • aab
  • aac
  • aad

And so on. Anyone have enough time to write it up?

I tried to make one for a RAR Password Finder once (my own :p), but i failed. It's hard you know ;)

Markus

2008-09-18 11:40:57

Works with any key length

program New;
const
  CharSet = 'hotHOTabcdefgijklmnpqrsuvwxyzABCDEFGIJKLMNPQRSUVWXYZ';
  text = 'ÃÜ*âÙh×㼏ä©Ý軏æ½ÛÙhœ”ÁÐíhÕ㺏ç°Þ漏ç°Þæ¼â•';
var
  X, L : integer;
  cs : string;
function MORD(s : char) : integer;
begin
  result := pos(s, CharSet)-1;
end;
function reverse(s : string) : string;
var
  i : integer;
begin
  for i := length(s) downto 1 do
    result := result + s[i];
end;

function decryptit(txt, ky : string) : string;
var
  i : integer;
  localkey: string;
begin
  localkey := reverse(ky);
  result := txt;
  for i := 1 to length(result) do
    result[i] := chr ( ord(result[i]) - ord(localkey[(i-1) mod length(localkey)+1]));
end;

begin
  L := length(CharSet)-1;
  cs := 'a';
  X := 1;
  while (True) do
  begin
    if(MORD(CS[X]) > L-1) then
    begin
      cs[X] := CharSet[1];
      while(true) do
      begin
        inc(X);
        if(Length(CS) < X) then
        begin
          SetLength(CS, Length(CS)+1);
          cs[X-1] := CharSet[1];
        end;
        if (MORD(CS[X]) < l) then
        begin
          break;
        end else
          CS[X] := CharSet[1];
      end;
    end;
    CS[X] := CharSet[MORD(CS[X])+2];
    if (pos('pant', decryptit(text, cs)) <> 0) then
    begin
      writeln('KEY: '+reverse(cs)+', TEXT: '+decryptit(text, cs)+', took: '+inttostr(gettimerunning));
      terminatescript;
    end;
    X := 1;
  end;
end.

Santa_Clause

2008-09-18 22:06:50

Erm…that's not what I wanted?

bullzeye95

2008-09-18 22:40:35

If you want to write out every possible word for every length from 1 up, use this: 
program New;
const
  T = 'abcdefghijklmnopqrstuvwxyz';  //the characters to use
  chars = 1;

var
  I, curPos, maxPos, maxChar, L, Time: Integer;
  curChar: Array of Integer;
  msgOrds, tOrds, mods: Array of Byte;
  tmpMsg: String;

begin
  Time:= GetSystemTime;
  maxChar:= Length(T);
  maxPos:= chars;
  SetLength(curChar, 10);
  SetLength(tmpMsg, chars);
  SetLength(tOrds, Length(T) + 1);
  for I:= 1 to Length(T) do
    tOrds[i]:= ord(T[i]);
  SetLength(mods, L + 1);
  repeat
    if(curPos < maxPos)then
    begin
      inc(curPos);
      for I:= 1 to L do
        Mods[i]:= (I - 1) mod curPos + 1;
    end;
    if(curChar[curPos] < maxChar)then
      inc(curChar[curPos])
    else begin
      curChar[curPos]:= 0;
      if(curPos = 1)then
      begin
        SetLength(tmpMsg, Length(tmpMsg) + 1);
        inc(maxPos);
      end;
      curPos:= max(0, curPos - 2);
      continue;
    end;
    tmpMsg[curPos]:= chr(tOrds[curChar[curPos]]);
    writeln(tmpMsg);
  until(False);
end.

If you just want to set a length and get the words for that length, use this: 
program New;
const
  T = 'abcdefghijklmnopqrstuvwxyz';  //the characters to use
  chars = 3; //how many characters

var
  I, curPos, maxPos, maxChar, L, Time: Integer;
  curChar: Array of Integer;
  msgOrds, tOrds, mods: Array of Byte;
  tmpMsg: String;

begin
  Time:= GetSystemTime;
  maxChar:= Length(T);
  maxPos:= chars;
  SetLength(curChar, 10);
  SetLength(tmpMsg, chars);
  SetLength(tOrds, Length(T) + 1);
  for I:= 1 to Length(T) do
    tOrds[i]:= ord(T[i]);
  SetLength(mods, L + 1);
  repeat
    if(curPos < maxPos)then
    begin
      inc(curPos);
      for I:= 1 to L do
        Mods[i]:= (I - 1) mod curPos + 1;
    end;
    if(curChar[curPos] < maxChar)then
      inc(curChar[curPos])
    else begin
      for I:= 1 to maxPos do
        if(tmpMsg[I] <> T[Length(T)])then
          break;
      if(I = maxPos + 1)then exit;
      curChar[curPos]:= 0;
      curPos:= max(0, curPos - 2);
      continue;
    end;
    tmpMsg[curPos]:= chr(tOrds[curChar[curPos]]);
    writeln(tmpMsg);
  until(False);
end.

Please don't mind the actual code… I modified my bruteforcer for mixster's encryption competition.

Bobarkinator

2008-09-18 23:00:15

Does he want actual words or just all words like Bullzeye did?

bullzeye95

2008-09-18 23:04:17

From: Santa_Clause

For example, FindPossibleWords(3) would yield similar results:

  • aaa
  • aab
  • aac
  • aad


Apparently all.

Markus

2008-09-19 02:51:20

From: Santa_Clause
Erm…that's not what I wanted?

You can take the encryption/decryption out and stick with the string generation. And you can force it to start at a certain length and exit it at the other length.

Daniel

2008-09-19 02:56:43

From: bullzeye95
If you want to write out every possible word for every length from 1 up, use this: 
program New;
const
  T = 'abcdefghijklmnopqrstuvwxyz';  //the characters to use
  chars = 1;

var
  I, curPos, maxPos, maxChar, L, Time: Integer;
  curChar: Array of Integer;
  msgOrds, tOrds, mods: Array of Byte;
  tmpMsg: String;

begin
  Time:= GetSystemTime;
  maxChar:= Length(T);
  maxPos:= chars;
  SetLength(curChar, 10);
  SetLength(tmpMsg, chars);
  SetLength(tOrds, Length(T) + 1);
  for I:= 1 to Length(T) do
    tOrds[i]:= ord(T[i]);
  SetLength(mods, L + 1);
  repeat
    if(curPos < maxPos)then
    begin
      inc(curPos);
      for I:= 1 to L do
        Mods[i]:= (I - 1) mod curPos + 1;
    end;
    if(curChar[curPos] < maxChar)then
      inc(curChar[curPos])
    else begin
      curChar[curPos]:= 0;
      if(curPos = 1)then
      begin
        SetLength(tmpMsg, Length(tmpMsg) + 1);
        inc(maxPos);
      end;
      curPos:= max(0, curPos - 2);
      continue;
    end;
    tmpMsg[curPos]:= chr(tOrds[curChar[curPos]]);
    writeln(tmpMsg);
  until(False);
end.

If you just want to set a length and get the words for that length, use this: 
program New;
const
  T = 'abcdefghijklmnopqrstuvwxyz';  //the characters to use
  chars = 3; //how many characters

var
  I, curPos, maxPos, maxChar, L, Time: Integer;
  curChar: Array of Integer;
  msgOrds, tOrds, mods: Array of Byte;
  tmpMsg: String;

begin
  Time:= GetSystemTime;
  maxChar:= Length(T);
  maxPos:= chars;
  SetLength(curChar, 10);
  SetLength(tmpMsg, chars);
  SetLength(tOrds, Length(T) + 1);
  for I:= 1 to Length(T) do
    tOrds[i]:= ord(T[i]);
  SetLength(mods, L + 1);
  repeat
    if(curPos < maxPos)then
    begin
      inc(curPos);
      for I:= 1 to L do
        Mods[i]:= (I - 1) mod curPos + 1;
    end;
    if(curChar[curPos] < maxChar)then
      inc(curChar[curPos])
    else begin
      for I:= 1 to maxPos do
        if(tmpMsg[I] <> T[Length(T)])then
          break;
      if(I = maxPos + 1)then exit;
      curChar[curPos]:= 0;
      curPos:= max(0, curPos - 2);
      continue;
    end;
    tmpMsg[curPos]:= chr(tOrds[curChar[curPos]]);
    writeln(tmpMsg);
  until(False);
end.

Please don't mind the actual code… I modified my bruteforcer for mixster's encryption competition.

Have i ever told you that i love you?

Santa_Clause

2008-09-20 02:47:58

From: bullzeye95
If you want to write out every possible word for every length from 1 up, use this: 
program New;
const
  T = 'abcdefghijklmnopqrstuvwxyz';  //the characters to use
  chars = 1;

var
  I, curPos, maxPos, maxChar, L, Time: Integer;
  curChar: Array of Integer;
  msgOrds, tOrds, mods: Array of Byte;
  tmpMsg: String;

begin
  Time:= GetSystemTime;
  maxChar:= Length(T);
  maxPos:= chars;
  SetLength(curChar, 10);
  SetLength(tmpMsg, chars);
  SetLength(tOrds, Length(T) + 1);
  for I:= 1 to Length(T) do
    tOrds[i]:= ord(T[i]);
  SetLength(mods, L + 1);
  repeat
    if(curPos < maxPos)then
    begin
      inc(curPos);
      for I:= 1 to L do
        Mods[i]:= (I - 1) mod curPos + 1;
    end;
    if(curChar[curPos] < maxChar)then
      inc(curChar[curPos])
    else begin
      curChar[curPos]:= 0;
      if(curPos = 1)then
      begin
        SetLength(tmpMsg, Length(tmpMsg) + 1);
        inc(maxPos);
      end;
      curPos:= max(0, curPos - 2);
      continue;
    end;
    tmpMsg[curPos]:= chr(tOrds[curChar[curPos]]);
    writeln(tmpMsg);
  until(False);
end.

If you just want to set a length and get the words for that length, use this: 
program New;
const
  T = 'abcdefghijklmnopqrstuvwxyz';  //the characters to use
  chars = 3; //how many characters

var
  I, curPos, maxPos, maxChar, L, Time: Integer;
  curChar: Array of Integer;
  msgOrds, tOrds, mods: Array of Byte;
  tmpMsg: String;

begin
  Time:= GetSystemTime;
  maxChar:= Length(T);
  maxPos:= chars;
  SetLength(curChar, 10);
  SetLength(tmpMsg, chars);
  SetLength(tOrds, Length(T) + 1);
  for I:= 1 to Length(T) do
    tOrds[i]:= ord(T[i]);
  SetLength(mods, L + 1);
  repeat
    if(curPos < maxPos)then
    begin
      inc(curPos);
      for I:= 1 to L do
        Mods[i]:= (I - 1) mod curPos + 1;
    end;
    if(curChar[curPos] < maxChar)then
      inc(curChar[curPos])
    else begin
      for I:= 1 to maxPos do
        if(tmpMsg[I] <> T[Length(T)])then
          break;
      if(I = maxPos + 1)then exit;
      curChar[curPos]:= 0;
      curPos:= max(0, curPos - 2);
      continue;
    end;
    tmpMsg[curPos]:= chr(tOrds[curChar[curPos]]);
    writeln(tmpMsg);
  until(False);
end.

Please don't mind the actual code… I modified my bruteforcer for mixster's encryption competition.


From: Markus
Works with any key length

program New;
const
  CharSet = 'hotHOTabcdefgijklmnpqrsuvwxyzABCDEFGIJKLMNPQRSUVWXYZ';
  text = 'ÃÜ*âÙh×㼏ä©Ý軏æ½ÛÙhœ”ÁÐíhÕ㺏ç°Þ漏ç°Þæ¼â•';
var
  X, L : integer;
  cs : string;
function MORD(s : char) : integer;
begin
  result := pos(s, CharSet)-1;
end;
function reverse(s : string) : string;
var
  i : integer;
begin
  for i := length(s) downto 1 do
    result := result + s[i];
end;

function decryptit(txt, ky : string) : string;
var
  i : integer;
  localkey: string;
begin
  localkey := reverse(ky);
  result := txt;
  for i := 1 to length(result) do
    result[i] := chr ( ord(result[i]) - ord(localkey[(i-1) mod length(localkey)+1]));
end;

begin
  L := length(CharSet)-1;
  cs := 'a';
  X := 1;
  while (True) do
  begin
    if(MORD(CS[X]) > L-1) then
    begin
      cs[X] := CharSet[1];
      while(true) do
      begin
        inc(X);
        if(Length(CS) < X) then
        begin
          SetLength(CS, Length(CS)+1);
          cs[X-1] := CharSet[1];
        end;
        if (MORD(CS[X]) < l) then
        begin
          break;
        end else
          CS[X] := CharSet[1];
      end;
    end;
    CS[X] := CharSet[MORD(CS[X])+2];
    if (pos('pant', decryptit(text, cs)) <> 0) then
    begin
      writeln('KEY: '+reverse(cs)+', TEXT: '+decryptit(text, cs)+', took: '+inttostr(gettimerunning));
      terminatescript;
    end;
    X := 1;
  end;
end.


Love you both very muchly.

From: Bobarkinator
Does he want actual words or just all words like Bullzeye did?


All the words :)