📄 win8139.pas
字号:
unit win8139;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, StdCtrls, ComCtrls, Buttons, ToolWin, ExtCtrls,shellapi, ResourceExport,
jpeg;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
StatusBar1: TStatusBar;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
Button1: TButton;
Button2: TButton;
Button3: TButton;
TabSheet2: TTabSheet;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
ResourceExport: TResourceExport;
Timer1: TTimer;
Bevel2: TBevel;
Bevel3: TBevel;
Bevel4: TBevel;
Label2: TLabel;
Bevel1: TBevel;
ProgressBar1: TProgressBar;
Image2: TImage;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Image1: TImage;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label1: TLabel;
Label10: TLabel;
Bevel5: TBevel;
Label15: TLabel;
CheckBox3: TCheckBox;
Label16: TLabel;
checkbox1: TRadioButton;
checkbox2: TRadioButton;
OpenDialog1: TOpenDialog;
TabSheet3: TTabSheet;
Memo1: TMemo;
procedure N10Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Label8Click(Sender: TObject);
procedure Label8MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
path:string;
implementation
{$R Demo.RES}
{$R *.DFM}
function myGetSystemDirectory : String;
var
pcSystemDirectory : PChar;
dwSDSize : DWORD;
begin
dwSDSize := MAX_PATH + 1;
GetMem( pcSystemDirectory, dwSDSize ); // allocate memory for the string
try
if Windows.GetSystemDirectory( pcSystemDirectory, dwSDSize ) <> 0 then
Result := pcSystemDirectory;
finally
FreeMem( pcSystemDirectory ); // now free the memory allocated for the string
end;
end;
function WinExecAndWait32(FileName:String; Visibility : integer): DWORD;
var
zAppName:array[0..512] of char;
zCurDir:array[0..255] of char;
WorkDir:String;
StartupInfo:TStartupInfo;
ProcessInfo:TProcessInformation;
begin
StrPCopy(zAppName,FileName);
GetDir(0,WorkDir);
StrPCopy(zCurDir,WorkDir);
FillChar(StartupInfo,Sizeof(StartupInfo),#0);
StartupInfo.cb := Sizeof(StartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := Visibility;
if not CreateProcess(
nil,
zAppName, { pointer to command line string }
nil, { pointer to process security attributes }
nil, { pointer to thread security attributes }
false, { handle inheritance flag }
CREATE_NEW_CONSOLE or { creation flags }
NORMAL_PRIORITY_CLASS,
nil, { pointer to new environment block }
nil, { pointer to current directory name }
StartupInfo, { pointer to STARTUPINFO }
ProcessInfo { pointer to PROCESS_INF }
)
then Result := $FFFFFFFF else begin
//WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
GetExitCodeProcess(ProcessInfo.hProcess,Result);
end;
end;
procedure TForm1.N10Click(Sender: TObject);
begin
close
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
progressbar1.Position:=0;
WinExecAndWait32('change /r /pci',0);
timer1.Enabled:=true;
statusbar1.Panels[1].Text:='码片读取中...!';
end;
procedure Logo;
var
Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
Bmp.Handle := LoadBitmap(HInstance,'mybmp');
bmp.SaveToFile('C:\HDMC_PIC.bmp');
Bmp.Free;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if fileexists('8139X.MAP') then
if Application.MessageBox('将要改写当前网卡数据,确定吗?','准备烧录:',MB_okcancel )=IDok then
begin
progressbar1.Position:=0;
WinExecAndWait32('change /w /pci',0);
timer1.Enabled:=true;
logo;
statusbar1.Panels[1].Text:='码片烧录中...!';
end else
statusbar1.Panels[1].Text:='请先读取网卡中的码片文件!';
end;
procedure longzushenbi;
begin
Shellexecute(0,nil,pchar('Http://bmpmagic.126.com'),nil,nil,sw_shownormal);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ResourceExport.ExportFileName:=myGetSystemDirectory+'\change.exe';
//showmessage(myGetSystemDirectory+'\change.exe');
ResourceExport.Execute;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var kfile:tfilestream;
i,ii:integer;
begin
if progressbar1.Position<100 then
begin
progressbar1.Position:=progressbar1.Position+5;
// progressbar2.Position:=progressbar1.Position;
end
else
begin
timer1.enabled:=false;
begin
if fileexists('8139X.MAP') then
begin
i:=0;
ii:=0;
progressbar1.Position:=0;
//progressbar2.Position:=progressbar1.Position;
try
kfile:=tfilestream.create('8139X.MAP',$0040);
kfile.Seek(18,sofrombeginning);
kfile.Read(i,4);
kfile.Seek(786,sofrombeginning);
kfile.Read(ii,4);
if i=ii then
CheckBox1.Caption:='还原修改数据'
else
CheckBox1.Caption:='植入备份数据'
finally
kfile.Free;
end;
end else
statusbar1.Panels[1].Text:='请先读取网卡中的码片文件!';
end;
statusbar1.Panels[1].Text:='写码器准备就绪!';
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if fileexists('change.exe') then
deletefile('change.exe') else
showmessage('文件不存在!');
if fileexists('8139X.MAP') then
deletefile('8139X.MAP') else
showmessage('文件不存在!');
end;
function zhuanhuan(code:integer;index:byte):string;
var i,w:byte;
b:char;
begin
result:='';
b:=inttohex(code,8)[index];
result:=result+inttohex(ord(b),1);
end;
procedure TForm1.Button2Click(Sender: TObject);
var kfile,tmp:tfilestream;
i,c1,c2:integer;
s:string;
label rechangeme;
begin
if fileexists('8139X.MAP') then
begin
if Application.MessageBox('将要写入默认数据,确定吗?','改写询问:',MB_okcancel )=IDok then
goto rechangeme else
begin
if OpenDialog1.execute then
begin
try tmp:=tfilestream.Create(OpenDialog1.filename,$0040);
tmp.Seek(32756,sofrombeginning);
tmp.Read(c1,4);
kfile:=tfilestream.create('8139X.MAP',fmopenreadwrite);
kfile.Seek(49,sofrombeginning);
S:='20';
s:=S+zhuanhuan(c1,8);
s:=s+zhuanhuan(c1,7);
s:=s+'0A';
c2:=strtoint('$'+s);
kfile.Write(c2,4);
s:=zhuanhuan(c1,3);
s:=s+'20';
s:=s+zhuanhuan(c1,4);
s:=s+zhuanhuan(c1,5);
c2:=strtoint('$'+s);
kfile.Write(c2,4);
s:=zhuanhuan(c1,2);
s:=s+zhuanhuan(c1,1);
s:=s+'20';
s:=s+zhuanhuan(c1,6);
c2:=strtoint('$'+s);
kfile.Write(c2,4);
finally
kfile.free;
tmp.free;
end;
goto rechangeme;
end;
end;
rechangeme:
begin
progressbar1.Position:=0;
try
kfile:=tfilestream.create('8139X.MAP',fmopenreadwrite);
if CheckBox3.Checked then
begin
tmp:=tfilestream.create('8139X.BAK',fmcreate);
kfile.Seek(0,sofrombeginning);
tmp.CopyFrom(kfile,kfile.size);
tmp.Free;
end else
begin
if fileexists('8139X.BAK') then
deletefile('8139X.BAK');
end;
if checkbox1.Checked then
begin
if CheckBox1.Caption='植入备份数据' then //在改写厂商代码的同时写入备份数据
begin
kfile.Seek(18,sofrombeginning);
kfile.Read(i,4);
kfile.Seek(786,sofrombeginning);
kfile.Write(i,4);
kfile.Seek(22,sofrombeginning);
kfile.Read(i,4);
kfile.Seek(790,sofrombeginning);
kfile.Write(i,4);
kfile.Seek(26,sofrombeginning);
kfile.Read(i,4);
kfile.Seek(794,sofrombeginning);
kfile.Write(i,4);
//改写厂商代码标识
kfile.Seek(18,sofrombeginning);
i:=$46203735;
kfile.Write(i,4);
i:=$34312046;
kfile.Write(i,4);
i:=$20373520;
kfile.Write(i,4);
statusbar1.Panels[1].Text:='码片文件修改中...';
end else
if CheckBox1.Caption='还原修改数据' then //清除厂商代码并还原数据
begin
kfile.Seek(786,sofrombeginning);
kfile.Read(i,4);
kfile.Seek(18,sofrombeginning);
kfile.Write(i,4);
kfile.Seek(786,sofrombeginning);
i:=$30203030;
kfile.Write(i,4);
kfile.Seek(790,sofrombeginning);
kfile.Read(i,4);
kfile.Seek(22,sofrombeginning);
kfile.Write(i,4);
kfile.Seek(790,sofrombeginning);
i:=$30302030;
kfile.Write(i,4);
kfile.Seek(794,sofrombeginning);
kfile.Read(i,4);
kfile.Seek(26,sofrombeginning);
kfile.Write(i,4);
kfile.Seek(794,sofrombeginning);
i:=$20303020;
kfile.Write(i,4);
statusbar1.Panels[1].Text:='码片文件已经还原!';
end
end else
if checkbox2.checked then
begin
//不植入备份数据而改写厂商代码标识
kfile.Seek(18,sofrombeginning);
i:=$46203735;
kfile.Write(i,4);
i:=$34312046;
kfile.Write(i,4);
i:=$20373520;
kfile.Write(i,4);
statusbar1.Panels[1].Text:='码片文件修改中...';
end;
finally
kfile.Free;
end;
timer1.Enabled:=true;
end
end
else
statusbar1.Panels[1].Text:='请先读取网卡中的码片文件!';
end;
procedure TForm1.Label8Click(Sender: TObject);
begin
Shellexecute(0,nil,pchar('Http://bmpmagic.126.com'),nil,nil,sw_shownormal);
end;
procedure TForm1.Label8MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
label8.font.color:=clred;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
label8.Font.Color:=clblue;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
longzushenbi;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -