公布blocks unlock v1.0的delphi源代码.txt

公布Blocks Unlock V1.0的Delphi源代码！ 此软件用于对西门子S7-300 加密逻辑块解密。

公布Blocks Unlock V1.0的Delphi源代码！

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, Dbf, LMDCustomScrollBox, LMDListBox,
  LMDWebURLLabel;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    GroupBox2: TGroupBox;
    LMDListBox1: TLMDListBox;
    Dbf1: TDbf;
    Dbf2: TDbf;
    GroupBox3: TGroupBox;
    LMDListBox2: TLMDListBox;
    GroupBox4: TGroupBox;
    GroupBox5: TGroupBox;
    Button3: TButton;
    Button4: TButton;
    GroupBox6: TGroupBox;
    Button5: TButton;
    Button6: TButton;
    GroupBox9: TGroupBox;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button2Click(Sender: TObject);
    procedure LMDListBox1Select(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure CheckBox3Click(Sender: TObject);
    procedure CheckBox4Click(Sender: TObject);
    procedure LMDListBox1KeyPress(Sender: TObject; var Key: Char);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

procedure MySub;
var
I: integer;
BlocksType, BlocksNumber, Password, RD: string;
begin
if FileExists(Form1.LMDListBox1.ItemPart(Form1.LMDListBox1.ItemIndex, 6) + '\SUBBLK.DBF') then
begin
Form1.Dbf1.TableName := Form1.LMDListBox1.ItemPart(Form1.LMDListBox1.ItemIndex, 6) + '\SUBBLK.DBF';
Form1.Dbf1.Active := true;
Form1.Dbf1.First;
Form1.LMDListBox2.Clear;
Form1.Button3.Enabled:=false;
Form1.Button4.Enabled:=false;
Form1.Button5.Enabled := false;
Form1.Button6.Enabled:= false;
Form1.LMDListBox2.Enabled:=true;
Form1.CheckBox1.Enabled:=true;
Form1.CheckBox2.Enabled:=true;
Form1.CheckBox3.Enabled:=true;
Form1.CheckBox4.Enabled:=true;

if Form1.CheckBox1.Checked then
begin
for I := 1 to Form1.Dbf1.ExactRecordCount do
begin
BlocksType := Form1.Dbf1.FieldByName('SUBBLKTYP').Value;
BlocksNumber := Form1.Dbf1.FieldByName('BLKNUMBER').Value;
if Form1.Dbf1.FieldByName('PASSWORD').Value = 0 then
Password := 'No'
else
Password := 'Yes';
RD := inttostr(I);
if BlocksType = '00008' then
Form1.LMDListBox2.Items.Add('OB' + inttostr(strtoint(BlocksNumber)) + ';' + Password + ';;' + RD);
Form1.Dbf1.Next;
end;
end;
Form1.Dbf1.First;

if Form1.CheckBox2.Checked then
begin
for I := 1 to Form1.Dbf1.ExactRecordCount do
begin
BlocksType := Form1.Dbf1.FieldByName('SUBBLKTYP').Value;
BlocksNumber := Form1.Dbf1.FieldByName('BLKNUMBER').Value;
if Form1.Dbf1.FieldByName('PASSWORD').Value = 0 then
Password := 'No'
else
Password := 'Yes';
RD := inttostr(I);
if BlocksType = '00014' then
Form1.LMDListBox2.Items.Add('FB' + inttostr(strtoint(BlocksNumber)) + ';' + Password + ';;' + RD);
Form1.Dbf1.Next;
end;
end;
Form1.Dbf1.First;

if Form1.CheckBox3.Checked then
begin
for I := 1 to Form1.Dbf1.ExactRecordCount do
begin
BlocksType := Form1.Dbf1.FieldByName('SUBBLKTYP').Value;
BlocksNumber := Form1.Dbf1.FieldByName('BLKNUMBER').Value;
if Form1.Dbf1.FieldByName('PASSWORD').Value = 0 then
Password := 'No'
else
Password := 'Yes';
RD := inttostr(I);
if BlocksType = '00012' then
Form1.LMDListBox2.Items.Add('FC' + inttostr(strtoint(BlocksNumber)) + ';' + Password + ';;' + RD);
Form1.Dbf1.Next;
end;
end;
Form1.Dbf1.First;

if Form1.CheckBox4.Checked then
begin
for I := 1 to Form1.Dbf1.ExactRecordCount do
begin
BlocksType := Form1.Dbf1.FieldByName('SUBBLKTYP').Value;
BlocksNumber := Form1.Dbf1.FieldByName('BLKNUMBER').Value;
if Form1.Dbf1.FieldByName('PASSWORD').Value = 0 then
Password := 'No'
else
Password := 'Yes';
RD := inttostr(I);
if BlocksType = '00010' then
Form1.LMDListBox2.Items.Add('DB' + inttostr(strtoint(BlocksNumber)) + ';' + Password + ';;' + RD);
Form1.Dbf1.Next;
end;
end;
Form1.Dbf1.First;

Form1.Dbf1.Active := false;

if Form1.LMDListBox2.Count > 0 then
begin
Form1.Button3.Enabled := true;
Form1.Button4.Enabled:= true;
Form1.Button5.Enabled := true;
Form1.Button6.Enabled:= true;
Form1.LMDListBox2.ItemIndex := 0;
end;
end;
end;

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
var
I,ID: integer;
OBs, FBs, FCs, DBs, DirectoryName,FileName: string;
begin
if OpenDialog1.Execute then
begin
FileName:= OpenDialog1.FileName;
if (FileExists(ExtractFilePath(FileName) + 'OMBSTX\OFFLINE\BSTCNTOF.DBF')) and (FileExists(ExtractFilePath(FileName) + 'HRS\S7RESONL.DBF')) then
begin
Dbf1.TableName := ExtractFilePath(FileName) + 'OMBSTX\OFFLINE\BSTCNTOF.DBF';
Dbf2.TableName := ExtractFilePath(FileName) + 'HRS\S7RESONL.DBF';
Dbf1.Active := true;
Dbf2.Active := true;
Dbf1.First;
Dbf2.First;
LMDListBox1.Clear;
for I:= 1 to Dbf1.ExactRecordCount do
begin
OBs := Dbf1.FieldByName('ANZOB').Value;
FBs := Dbf1.FieldByName('ANZFB').Value;
FCs := Dbf1.FieldByName('ANZFC').Value;
DBs := Dbf1.FieldByName('ANZDB').Value;
ID := Dbf1.FieldByName('ID').Value;
DirectoryName := ExtractFilePath(FileName) + 'OMBSTX\OFFLINE\' + Format('%.8x', [ID]);
LMDListBox1.Items.Add(Dbf2.FieldByName('NAME').Value + ';' + OBs + ';' + FBs + ';' + FCs + ';' + DBs + ';;' + DirectoryName);
Dbf1.Next;
Dbf2.Next;
end;
Dbf1.Active := false;
Dbf2.Active := false;
end;
end;
end;


procedure TForm1.LMDListBox1Select(Sender: TObject);
begin
MySub;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
I, J: integer;
begin
Dbf1.Active := true;
Dbf1.First;
J := strtoint(LMDListBox2.ItemPart(LMDListBox2.ItemIndex, 3));
for I := 1 to J - 1 do
begin
Dbf1.Next;
end;
J := LMDListBox2.ItemIndex;
Dbf1.Edit;
Dbf1.FieldByName('PASSWORD').Value := 3;
Dbf1.Post;
Dbf1.Active := false;
MySub;
LMDListBox2.ItemIndex := J;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
I, J: integer;
begin
Dbf1.Active := true;
Dbf1.First;
J := strtoint(LMDListBox2.ItemPart(LMDListBox2.ItemIndex, 3));
for I := 1 to J - 1 do
begin
Dbf1.Next;
end;
J := LMDListBox2.ItemIndex;
Dbf1.Edit;
Dbf1.FieldByName('PASSWORD').Value := 0;
Dbf1.Post;
Dbf1.Active := false;
MySub;
LMDListBox2.ItemIndex := J;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
MySub;
end;

procedure TForm1.CheckBox2Click(Sender: TObject);
begin
MySub;
end;

procedure TForm1.CheckBox3Click(Sender: TObject);
begin
MySub;
end;

procedure TForm1.CheckBox4Click(Sender: TObject);
begin
MySub;
end;

procedure TForm1.LMDListBox1KeyPress(Sender: TObject; var Key: Char);
begin
MySub;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  I: integer;
begin
  Dbf1.Active := true;
  Dbf1.First;
  for I := 0 to Dbf1.ExactRecordCount - 1 do
  begin
    Dbf1.Edit;
    Dbf1.FieldByName('PASSWORD').Value := 3;
    Dbf1.Post;
    Dbf1.Next;
  end;
  Dbf1.Active := false;
  MySub;
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  I: integer;
begin
  Dbf1.Active := true;
  Dbf1.First;
  for I := 0 to Dbf1.ExactRecordCount - 1 do
  begin
    Dbf1.Edit;
    Dbf1.FieldByName('PASSWORD').Value := 0;
    Dbf1.Post;
    Dbf1.Next;
  end;
  Dbf1.Active := false;
  MySub;
end;

end.