Delphi Source Decrypt Text.BMD

[mauka]

black write

was very easy.. made in minutes encryption is same only vice verse

Credits only me

unit uMainFrm;

interface

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

type
  TMainFrm = class(TForm)
    Open: TOpenDialog;
    Log: TListView;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  PLogList = ^TLogList;
  TLogList = packed record
   Buffer: array of Byte;
  end;

  PContent = ^TContent;
  TContent = packed record
   Block  : Cardinal;
   Buffer : array of TLogList;
  end;

var
  MainFrm: TMainFrm;

implementation

{$R *.dfm}

(*
 "Text.bmd"
  47 54
  2B 0C 00 00    <- Total Block count
  00 00 00 00    <- Block index
  05 00 00 00    <- Block size
  BD BD C2 9D A3 <- Content
  01 00 00 00    <- Block index
  53 00 00 00    <- Block size
  <-                Content                    ->
  AB AE D9 92 A6 C5 9B EE 8B BF A0 C5 88 A6 C5 89
  AA CF DC AE DF 88 AA C6 8C BB D8 DC AE DF DC A7
  CA 9F A4 C2 92 A8 8B 8B A6 C7 90 EF D9 99 BC DE
  90 BB 8B 95 A1 8B 9D EF DB 99 BD C6 9D A1 CE 92
  BB 8B 9D AC C8 93 BA C5 88 EF 83 D9 BC 82 DC AD
  CA 92 EE

 "Mix.bmd"
  B3  <- Block size
  <-     Content                                  ->
  CF AB FC CE AB FC CF AA FC CF AB FD CF AB FC CD AB
  FC CF A9 FC CF AB FD CF AB FC CE AB FC CF AF FC CF
  AB FD CF AB FC CE AB FC CF AA FC CF AB FE CF AB FC
  CE AB FC CF FC CF AB FC C9 AB FC CF CE FE CF AB FC
  CF AB FC CF AB FC CF C9 FE CF AB 9F CD AB FC CF AB
  FC CF AB FC CF AB FC CF AB FC CF AB FC CF AA FC CF
  AB FD CF AB FC C5 AB FC CF EA 00 00 00 3C 09 86 FC
  CE AB FC CF 8B FC CF AB FC CF AB FC BF A4 BA A3 B6
  F5 B5 E5 32

  <-      Name (Nav shifreta)                     ->
  00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
  00 00 00 00 00 00 45 6C 62 65 6C 61 6E 64 32 00 00
  00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
  00 00 00 00

zajebala xD
  0A 00 00 00 90 01 00 00 C4 09 00 00 0C 01 00 00 2B
  00 00 00 BF A4 BA A3 B6 F5 B5 E5 33 00 00 00 00 00
  00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
  00
*)

procedure Decrypt(Ms: TStream; List: PContent);
const
 XorKey : array [0 .. 2] of Byte = ($FC, $CF, $AB);
var
 i,e: Integer;
 ReadBuffer: Cardinal;
 WriteBuffer: Byte;
begin
SetLength(List.Buffer,List.Block);
 for i := 0 to List.Block -1 do
  begin
   Ms.Read(ReadBuffer,4);
   SetLength(List.Buffer[i].Buffer,ReadBuffer);
   for e := 0 to ReadBuffer -1 do
    begin
     Ms.Read(WriteBuffer,1);
     List.Buffer[i].Buffer[e] := WriteBuffer xor XorKey[e mod 3];
    end;
   Ms.Position := Ms.Position + 4;
  end;
end;


procedure TMainFrm.Button1Click(Sender: TObject);
var
 Buffer: TContent;
 Fs, Ms: TStream;
 i,e: Integer;  // testam
 s: string;     // testam
begin
 if Open.Execute then
  begin
   ZeroMemory(@Buffer,SizeOf(Buffer));
   try
    Fs := TFileStream.Create(Open.FileName, fmOpenRead);
    try
     Ms := TMemoryStream.Create;
     try
      Ms.CopyFrom(Fs, Fs.Size);
      Ms.Position := 2;
      Ms.Read(Buffer.Block,4);
      Ms.Position := 10;
      Decrypt(Ms,@Buffer);
     finally
      Ms.Free;
     end;
    finally
     Fs.Free;
    end;
   except
    on E: EFOpenError do
     Exit;
   end;
    {Testejam sho meslu xD}
   for i := low(Buffer.Buffer) to high(Buffer.Buffer) do
    begin
     s := ''; // Buffera chuckchukbaanis  xD
      for e := low(Buffer.Buffer[i].Buffer) to high(Buffer.Buffer[i].Buffer) do
       begin
        s := s + Chr(Buffer.Buffer[i].Buffer[e]);
       end;
      with Log.Items.Add do
       begin
        Caption := IntToStr(Log.Items.Count);
        SubItems.Add(s);
       end;
    end;
  end;
end;

procedure TMainFrm.FormCreate(Sender: TObject);
begin
 Open.InitialDir := GetCurrentDir;
end;

(*
  procedure TMainFrm.Button1Click(Sender: TObject);
  const
   XorKey : array [0 .. 2] of Byte = ($FC, $CF, $AB);
  var
   Fs, Ms: TStream;
   ReadByte: Cardinal;
   WriteByte: Byte;
   MaxBlocks: Cardinal;
   i,e: Integer;
   Content: array of TLogList;
   s: string;
  begin
   if Open.Execute then
    begin
      Fs := TFileStream.Create(Open.FileName,fmOpenRead);
       try
        Ms := TMemoryStream.Create;
         try
          Ms.CopyFrom(Fs,Fs.Size);
          Ms.Position := 2;
          Ms.Read(MaxBlocks,4);
          Ms.Position := $0A;

          SetLength(Content,MaxBlocks);

          for i := 0 to MaxBlocks -1 do
           begin
            Ms.Read(ReadByte,4);

            SetLength(Content[i].Buffer,ReadByte);
             for e := 0 to ReadByte -1 do
              begin
               Ms.Read(WriteByte,1);
               Content[i].Buffer[e] := (WriteByte xor XorKey[e mod 3]);
              end;
            Ms.Position := Ms.Position + 4;
           end;
         finally
          Ms.Free;
         end;
       finally
        Fs.Free;
       end;
      for i := low(Content) to high(Content) do
       begin
        s := '';
        for e := low(Content[i].Buffer) to high(Content[i].Buffer) do
         begin
          s := s + Chr(Content[i].Buffer[e]);
         end;
          with Log.Items.Add do
           begin
            Caption := IntToStr(i);
            SubItems.Add(s);
           end;
       end;
    end;
  end;
*)


end.

In atachament Project source code

[MentaL]

[KarLi]

approved

[Phant0m]

Supports all versions?

[mauka]

have no idea.. xD i did it on season5 client while i was without internet

[Bl4ck I0t4]

thx bro this is what exactly i need great job on it :P

[mauka]

Thanks for your replay, but this programm was coded only coz of nothing to do xD
and released as is (Open source)

[goldenfox]

Thanks for your replay, but this programm was coded only coz of nothing to do xD
and released as is (Open source)

Thanks. Tried opening 97d bmd but doesn't work. Anyway, I'll just edit the code to support 97d. =)

Good job for posting this useful code. 10 globes. :-)

PS: Do you have 97D researches by other coders here? I badly need some 97D info's.


-goldenfox