unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,registry;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

type

  //Pass parts graphical structure:
  //|XX XX XX XX|XX XX XX XX|XX XX XX XX|XX XX XX XX|XX XX XX XX|XX XX 3D 3D|00
  //Each group is named consecutively |GI FC SC TC|
  //A 00 means the end of the encoded password. A 3D means a null encoded character.

  PassParts = array [0..6,0..3] of byte; //Parts of the password, it devides into groups of 4 encoded characters which is equivalent to 3 decoded characters. There can be a maximum of 6 groups (16 decoded characters, 25 encoded)
  DecPassArray = array [0..24] of byte;  //Array got directly from the registry. It can be 25 characters maximum
var
  PassSize:integer;  //Size in characters (including the ending) of encoded password

{This function makes a table of equivalence of the set of values.
 The set consists 41..$5A,$61..$7A,$30..$39,$2B,$2F which are in order,
 corresponding a 0 to 41 and a 3F to 2F}
function EquivalentPositions(EncByte:byte):byte;
var
  DecByte:byte;      //Semi-decoded byte, which will be the return value of the function
begin

  Case EncByte of
    $41..$5A:DecByte:=EncByte-$41;
    $61..$7A:DecByte:=(EncByte-$61)+$1A;
    $30..$39:DecByte:=(EncByte-$30)+$34;
    $2B:DecByte:=$3E;
    $2F:DecByte:=$3F;
    $3D:DecByte:=$40;
  else
    DecByte:=$FF;
  end;
  EquivalentPositions:=DecByte;
end;


{This function gets the encrypted pasword from de registry}
function GetRegPassword():DecPassArray;
const
  {These constants can be changed, depending on wher MSN Messanger stores saved passwords}
  PassKey='\Software\Microsoft\MessengerService'; //Key in which the password is stored (Ver. 4.5)
  PassVal='Password.NET Messenger Service';       //Value in which the password is stored (Ver. 4.5)
var
  MyRegistry:TRegistry;    //Registry object
  RegDatum:DecPassArray;   //Datum obtained from the registry containing the encrypted password string
begin
  MyRegistry:=TRegistry.Create;
  MyRegistry.OpenKey(PassKey,False);
  PassSize:=MyRegistry.GetDataSize(PassVal);      //This value is used globally
  MyRegistry.ReadBinaryData(PassVal,RegDatum,PassSize);
  GetRegPassword:=RegDatum;
end;

{This function converts the data type DecPassArray in PassParts type.
It does so by grouping the characters got from the registry in a more organized way
explained earlier}
function SortPassBytes(Pass:DecPassArray):PassParts;
var
  Temp:PassParts;   //Temporary return value
  i,i2:integer;     //Counters of the two nested FOR-loops
begin
  {Will repeat the loop as many times as groups can be in the array of characters got from the registry (PassSize minus the nulltermination char (00) divided by the four characters in each group).}
  For i:=0 to (PassSize-1) div 4 do
    {In each group, store 4 characters}
    For i2:=0 to 3 do
      Temp[i,i2]:=Pass[i*4+i2];
  {Store the last (null termination) character}
  SortPassBytes:=Temp;
end;

{Main function in which the full decoding takes place}
function DecodePassword():string;
var
  PassPart: PassParts;              //Variable in which the encrypted password (already organized) is stored
  iPart: integer;                   //Loop that repeats for each group to decode it
  GI, FC, SC, TC: byte;             //Semi-decoded byte is stored in each of this for every element of every group in turn in the loop
  FCValInSet, FCPosInSet: integer;  //Every semidecoded character has two meanings. Each meaning is stored in each of these two variables. In this case, these variables are for the first semi-decoded variable, FC.
  SCValInSet, SCPosInSet: integer;  //These variables are for the second semi-decoded variable, SC.
  TCPosInSet: integer;              //These variables are for the third semi-decoded variable, TC.
  C1, C2, C3: char;                 //Decoded character for GI, FC (C1), SC (C2), TC (C3)
  Password: DecPassArray;           //Password from the registry
  Temp: string;                     //Temporary return value
begin
  Password:=GetRegPassword; {Get password from registry}
  PassPart:=SortPassBytes(GetRegPassword); {Organize encoded password from registry}

  {Main loop for decodification. It repeats for every group in the encoded password}
  for iPart:=0 to (PassSize div 4)-1 do
   begin
     {Semi-decode each element of the group}
     GI:=EquivalentPositions(PassPart[iPart,0]);
     FC:=EquivalentPositions(PassPart[ipart,1]);
     SC:=EquivalentPositions(PassPart[ipart,2]);
     TC:=EquivalentPositions(PassPart[ipart,3]);

     {Reset decoded characters containers}
     C2:=#0;
     C3:=#0;

     {Decoding of FC begins.
     This semi-decoded value is fully decoded by determining the GI group,
     which has 4 elements each, and add the member number which can be from 0 to 3}
     FCPosInSet:=FC div $10;  {this determines the member number}
     FCValInSet:=FC mod $10;  {this is used for full-decode SC}
     C1:=Char(GI*$4+FCPosInSet); {fully decoded FC}

     {Decoding of SC begins.
     This semi-decoded value is fully decoded by determining the FCValInSet group,
     which has h10 elements each, and add the member number which can be from 0 to h1F}
     If SC < $40 then
      begin
        SCPosInSet:=SC div $4;   {this determines the member nunmber}
        SCValInSet:=SC mod $4;   {this is used for full-deoode TC}
        C2:=Char(FCValInSet*$10+SCPosInSet); {fully decode SC}
      end;

     {Decoding of TC begins.
     This semi-decoded value is fully decoded by determining the SCValInSet group,
     which has h40 elements each, and add the member number which can be from 0 to h3F}
     If TC < $40 then
      begin
        TCPosInSet:=TC;   {this determines the member number}
        C3:=Char(SCValInSet*$40+TCPosInSet); {fully decode TC}
      end;

     Temp:=Temp+C1+C2+C3; {Decoded group of 3 characters}
   end;

   DecodePassword:=Temp;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit1.Text:=DecodePassword;
end;

end.