unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Edit6: TEdit;
Button1: TButton;
Label1: TLabel;
SaveDialog1: TSaveDialog;
Button2: TButton;
Edit7: TEdit;
Button3: TButton;
Label2: TLabel;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
DWordA =array [0..7] of DWord;
DWordP =^DWordA;
DWordB =array [0..7] of Byte;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button2Click(Sender: TObject);
begin
if SaveDialog1.Execute then
Edit7.Text := SaveDialog1.FileName ;
end;
function UpdateExe(N:string; ChkL:DWord; ChkH:DWord):boolean; // Write CRC to file
var
Hd,i:integer;
D,R:DWordB; // $1E
begin
Result:=False;
DWordP(@D[0])[0]:=ChkL; //20處開始由低位元塞CRC資料 若為DWordP(@D[3])[0] 則是從21處開始塞
DWordP(@D[4])[0]:=ChkH;
if FileExists(N) then
begin
Hd:=FileOpen(N,fmOpenReadWrite); //開啟N
FileSeek(Hd,$20,0);
FileWrite(Hd,D[0],8); //從20開始寫入8個byte值
FileSeek(Hd,$20,0);
FileRead(Hd,R[0],8);
//檢查
Result:=TRUE;
for i:=0 to SizeOf(D)-1 do
if D[i]<>R[i] then
begin
Result:=False;
end;
FileClose(Hd);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
m1 : DWord;
m2 : DWord;
begin
m1 := (strtoint('$'+Edit1.Text) + strtoint('$'+Edit2.Text+'00') + strtoint('$'+Edit3.Text+'0000') + strtoint('$'+Edit4.Text+'000000')) xor $AE5C2DDA;
m2 := (strtoint('$'+Edit5.Text) + strtoint('$'+Edit6.Text+'00')) xor $0000C1A3;
UpdateExe(Edit7.Text, m1, m2);
end;
function ReadFileHeader(N:string;var Chk:DWordB):boolean; // Write CRC to file
var
Hd : integer;
R : DWordB; // $1E
begin
Result:=False;
if FileExists(N) then
begin
Hd:=FileOpen(N,fmOpenRead); //開啟N
FileSeek(Hd,$20,0);
FileRead(Hd,R[0],8);
CHk := R;
Result:=True;
FileClose(Hd);
end;
end;
function MacAddress: string;
var
Lib: Cardinal;
Func: function(GUID: PGUID): Longint; stdcall;
GUID1, GUID2: TGUID;
begin
Result := '';
Lib := LoadLibrary('rpcrt4.dll');
if Lib <> 0 then
begin
if Win32Platform <>VER_PLATFORM_WIN32_NT then
@Func := GetProcAddress(Lib, 'UuidCreate')
else @Func := GetProcAddress(Lib, 'UuidCreateSequential');
if Assigned(Func) then
begin
if (Func(@GUID1) = 0) and
(Func(@GUID2) = 0) and
(GUID1.D4[2] = GUID2.D4[2]) and
(GUID1.D4[3] = GUID2.D4[3]) and
(GUID1.D4[4] = GUID2.D4[4]) and
(GUID1.D4[5] = GUID2.D4[5]) and
(GUID1.D4[6] = GUID2.D4[6]) and
(GUID1.D4[7] = GUID2.D4[7]) then
begin
Result :=
IntToHex(GUID1.D4[2] xor $DA, 2) + '-' +
IntToHex(GUID1.D4[3] xor $2D, 2) + '-' +
IntToHex(GUID1.D4[4] xor $5C, 2) + '-' +
IntToHex(GUID1.D4[5] xor $AE, 2) + '-' +
IntToHex(GUID1.D4[6] xor $A3, 2) + '-' +
IntToHex(GUID1.D4[7] xor $C1, 2);
end;
end;
FreeLibrary(Lib);
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
R1: DWordB; // $1E
begin
ReadFileHeader(Edit7.Text, R1);
Label1.Caption:=IntToHex(R1[0],2)+'-'+IntToHex(R1[1],2)+'-'+IntToHex(R1[2],2)+'-'+IntToHex(R1[3],2)+'-'+IntToHex(R1[4],2)+'-'+IntToHex(R1[5],2);
Label2.Caption:=MacAddress;
if not SameText(Label1.Caption, Label2.Caption) then
application.Terminate ;
end;
end.
星期三, 4月 30, 2008
寫網卡MAC到exe檔裡,並在程式開始時做判斷
訂閱:
張貼留言 (Atom)
沒有留言:
張貼留言