25 мая 2012 г.

Вот пример программы для проверки сжатия от Bad_guy


Вот пример программы для проверки сжатия от Bad_guy


можете скачать с сайта или собрать из этой страницы




А это дерево ссылок (теория графов) из такой хорошей программы IDA самого лучшего дизассемблера и отладчика и вообще это целая лаборатория для исследователя и взломщика

Компоненты все известные вам,компонент xp manifest можно не ставить если не найдете его в делфи,да и вообще он ненужен это настройка визуальности,короче применение тем.

{SpectroByte IX
---
Автор: Bad_guy [CRACKL@B Team]
Сайты: www.cracklab.ru, www.clteam.net

О программе
---
Программа предназначена для построения "спектра" файла. То есть программа
считает количество каждого байта (от 0 до FFh) в файле и строит график
зависимости количества байт от их номинала. Это может быть полезно для
визуального анализа сжимаемости файла (его энтропии). Для файлов, имеющих много
одних байт и очень мало других, присутствует возможность отобразить график в
логарифмическом масштабе. Также программа вычисляет интеграл (площадь)
полученной функции. Исходники на Delphi прилагаются.}

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, math, XPMan;

type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
Opn: TOpenDialog;
Edit1: TEdit;
Edit2: TEdit;
CheckBox1: TCheckBox;
Shape1: TShape;
XPManifest1: TXPManifest;
Label1: TLabel;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure CheckBox1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
a, k: array [0..255] of longint;
r: trect;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var f: file of byte;
Buf: array[0..4095] of byte;
b, b1: byte;
c, ReadBytes, x: longint;
S: TFileStream;
begin
//Initialize
c := 0;
r.Left := 0;
r.Top := 0;
r.Bottom := Image1.Height;
r.Right := Image1.Width;
ZeroMemory(@a, SizeOf(a));
Image1.Canvas.Brush.Color := $A28A89;
Image1.Canvas.FillRect(r);
// Open file
if Opn.Execute then
begin
S := TFileStream.Create(Opn.Filename, fmOpenRead);
try
S.Seek(0, soFromBeginning);
repeat
ReadBytes := S.read(Buf, SizeOf(Buf));
for c := 0 to ReadBytes - 1 do
begin
b := Buf[c];
inc(a[b]);
end;
until ReadBytes <> SizeOf(Buf);
finally
S.Free;
end;

CheckBox1Click(Sender);

end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Edit1.Text := IntToStr(x);
Edit2.Text := IntToStr(Image1.height - y);
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
var
b, b1: byte;
c, x: longint;
begin
// Log
if CheckBox1.Checked then
for b := 0 to 255 do
k[b] := Round(Log10(a[b] + 1) * 100)
else
for b := 0 to 255 do
k[b] := a[b];

// Normzlize;
c := 0;
x := 0;
for b := 0 to 255 do
c := Max(c, k[b]);
if c = 0 then c := 1;

for b := 0 to 255 do
k[b] := Round(k[b] / c * 100);

for b := 0 to 255 do
x := x + k[b];
x := Round(x / 256);
Label2.Caption := IntToStr(x) + '%';

// Erase Picture
r.Left := 0;
r.Top := 0;
r.Bottom := Image1.Height;
r.Right := Image1.Width;
Image1.Canvas.Brush.Color := $A28A89;
Image1.Canvas.FillRect(r);

// Draw;
for b := 0 to 255 do
for b1 := 1 to k[b] do
begin
Image1.Canvas.Pixels[b, 101 - b1] := $052068;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
// Erase Picture
r.Left := 0;
r.Top := 0;
r.Bottom := Image1.Height;
r.Right := Image1.Width;
Image1.Canvas.Brush.Color := $A28A89;
Image1.Canvas.FillRect(r);
end;

end.

Комментариев нет:

Отправить комментарий