⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 win8139.pas

📁 软件功能:32位图形界面程序
💻 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 + -