unitconfigserver.pas

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

          application.ProcessMessages;
        end;
      if f_main.button6.Tag=1 then
        begin
          messagebox(f_main.handle,'下载被终止!','警告',0);
          exit;
        end;
      //sleep(1);
     until BufferLen = 0;
   finally
     CloseFile(f);
   end;
   Result:=True;
  finally
   InternetCloseHandle(hURL)
  end
 finally
  InternetCloseHandle(hSession)
 end
end;
procedure   DeleteIEHistory(url:string);
var i:integer;
  lpEntryInfo: PInternetCacheEntryInfo;
  hCacheDir: LongWord ;
  dwEntrySize, dwLastError: LongWord;
  s,s1:string;
  jsq:integer;
begin
  if trim(url)='' then exit;
try
   dwEntrySize := 0;
   FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize);
   GetMem(lpEntryInfo, dwEntrySize);

   hCacheDir := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize);
   if hCacheDir <> 0 then
      DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName);
   FreeMem(lpEntryInfo);
   //showmessage('ie-1');
   jsq:=0;
   repeat
     //sleep(1);
     application.ProcessMessages;
     dwEntrySize := 0;
     FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^),
       dwEntrySize);
     dwLastError := GetLastError();

     if dwLastError = ERROR_INSUFFICIENT_BUFFER then //如果成功
     begin
         jsq:=0;
         GetMem(lpEntryInfo, dwEntrySize); //分配dwEntrySize字节的内存
         try
           if FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize) then
            begin
              s:=trim(url);
              while true do
                begin
                  i:=pos(',',s);
                  if i<=0 then
                    begin
                      s1:=s;
                      s:='';
                    end
                  else
                    begin
                      s1:=copy(s,1,i-1);
                      s:=copy(s,i+1,length(s));
                    end;
                  s1:=trim(s1);
                  if s1='' then break;
                  if lpEntryInfo^.lpszSourceUrlName=s1 then
                    begin
                      //sleep(1);
                      application.ProcessMessages;
                      DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName);
                      break;
                    end;
                end;
            end;
         finally
           FreeMem(lpEntryInfo);
         end;
     end
   else
     jsq:=jsq+1;
   if jsq>100 then break;
   //sleep(1);
  until (dwLastError = ERROR_NO_MORE_ITEMS);
  //showmessage('ie-2');
except
  //on e:exception do
    //showmessage(e.Message);
end;

end;
function decodeStr(str: string): string; //解密串
var
  i,j,k: integer;
  tmp,key:string;
begin
  //字符串作反可视化
  tmp:='';
  for i:=1 to (length(str) div 2) do //把ascii码串转换为2进制串
    begin
      result:=copy(str,i*2-1,2);
      tmp:=tmp+chr(strToInt('$'+result));
    end;
  //二进制加密串解密
  //取随机密钥
  key:=copy(tmp,1,maxlen);
  tmp:=copy(tmp,maxlen+1,length(tmp));
  k:=0;
  result:='';
  for i:=1 to length(tmp) do
    begin
      k:=k+1;
      if k>maxlen then k:=1;
      j := ord(tmp[i]) xor strtoint(key[k]);
      result := result + chr(j);
    end;
  result:=trim(result);
end;
//编码
function formatHex(encData:string): string;
var
  i,pl: integer;
begin
  result:='';
  pl:=length(encdata);
  for i:=1 to pl do
    begin
      result:=result+IntToHex(ord(encData[i]),2);
      application.ProcessMessages;
    end;
end;
procedure SaveToFile(data,fn:string);
var f_regid,m,len:integer;
    tmp:string;
    buff:pchar;
begin
  try
    f_regid:=FileCreate(fn);
    try
      tmp:=data;
      len:=length(tmp);
      getmem(buff,len+2);
      try
        //showmessage(inttostr(length(tmp)));
        //StrPCopy(buff,tmp);
        SetLength(tmp, len+1);
        tmp[len+1]:= #0;
        buff:= @tmp[1];
        Filewrite(f_regid, buff^, len);
      finally
      end;
    finally
      FileClose(f_regid);
    end;
  except
  end;
end;
function CreateFuckCode:string;
var s:string;
    i,len,m,n:integer;
    cc:array[1..16] of char;
begin
    cc[1]:='0';
    cc[2]:='1';
    cc[3]:='2';
    cc[4]:='3';
    cc[5]:='4';
    cc[6]:='5';
    cc[7]:='6';
    cc[8]:='7';
    cc[9]:='8';
    cc[10]:='9';
    cc[11]:='A';
    cc[12]:='B';
    cc[13]:='C';
    cc[14]:='D';
    cc[15]:='E';
    cc[16]:='F';
    result:='';
    len:=length(fuck_code);
    while true do
      begin
        if length(result)>=len then break;
        m:=random(17);
        if m<1 then m:=1;
        if m>16 then m:=16;
        n:=random(17);
        if n<1 then n:=1;
        if n>16 then n:=16;
        s:='$'+cc[m]+cc[n];
        result:=result+chr(strtoint(s));
      end;
end;
function  CheckHosts:boolean;
var  st_tmp:tstringlist;
     cp:string;
begin
    //检查103h是否在host列表
  result:=true;
  st_tmp:=tstringlist.Create;
  if fileexists(GetSystemPath+'drivers\etc\hosts') then
  try
    st_tmp.LoadFromFile(GetSystemPath+'drivers\etc\hosts');
    st_tmp.Text:=lowercase(st_tmp.Text);
    cp:='www.5b6.cn';
    if pos(cp,st_tmp.Text)>0 then
      begin
        DeleteSelf(application.ExeName);
        halt;
        result:=false;
        exit;
      end;
  finally
    st_tmp.Free;
  end;
end;
function CheckUPX:boolean;
var s:string;
begin
  result:=false;
  s:=GetCopyrightFlag(f_main.current_path+'upx.exe');
  if s='f7cc77adcfc6c26ef8a59ef8654a6971' then
    result:=true;
end;
procedure Tf_main.BitBtn1Click(Sender: TObject);
var
  f:tmemorystream;
  Url,tmp,ver: string;
  st:tstringstream;
  c,len,i,m:integer;
  OutPutPath,userid,onlypop,fn,test,id:string;
  count:integer;
  ini:tinifile;
  data,jzrq,tp,ss,s:string;
  st_tmp:tstringlist;
  fuck,cp,s_tmp:string;
  is_vip:boolean;
begin
  if CheckBox1.Checked=false then//防破解
    begin
      DeleteSelf(application.ExeName);
      halt;
      exit;
    end;
  if f_md5='' then
    begin
      DeleteSelf(application.ExeName);
      halt;
      exit;
    end;
  e_user.Text:=trim(e_user.Text);
  ini:=tinifile.Create(current_path+cfg);
  jzrq:=ini.readString('sys','copyright1',encodestr(trim(e_user.Text)+copy(jzrq,1,10)));
  s:=ini.readString('sys','mycopyright','');
  ini.free;
  if s='' then
    begin
      DeleteSelf(application.ExeName);
      halt;
      exit;
    end;
  try
    s:=decodestr(s);
  except
    s:='';
  end;
  if s<>lb_url.Caption then
    begin
      is_vip:=false;
      if e_user.Text='690196236' then
      //if myreg1.IsRegister(softname) then
        is_vip:=true;
      if is_vip=false then
        begin
          DeleteSelf(application.ExeName);
          halt;
          exit;
        end;
    end;
  try
    jzrq:=decodestr(jzrq);
  except
    jzrq:='';
  end;
  if jzrq='' then exit;
  if copy(jzrq,1,length(e_user.Text))<>e_user.Text then
    begin
      messagebox(handle,'服务已过期或未生效!','警告',0);
      exit;
    end;
  if copy(jzrq,1,length(e_user.Text))<>e_user.Text then
    begin
      DeleteSelf(application.ExeName);
      halt;
      exit;
    end;
  jzrq:=copy(jzrq,length(e_user.Text)+1,length(jzrq));
  jzrq:=copy(jzrq,1,10);
  if formatdatetime('yyyy-MM-dd',date)>jzrq then
    begin
      messagebox(handle,'服务已过期,请续费!','警告',0);
      exit;
    end;
  if formatdatetime('yyyy-MM-dd',date)>jzrq then
    begin
      DeleteSelf(application.ExeName);
      halt;
      exit;
    end;
  //检查103h是否在host列表
  if CheckHosts=false then
    begin
      halt;
      exit;
    end;
  count:=0;
  try
     url:=trim(lowercase(lb_url.Caption));
   except
     url:='';
   end;
   if e_user.Text='690196236' then
   //if myreg1.IsRegister(softname) then
   if e_url.Visible then
     url:=trim(lowercase(e_url.text));
   e_ver.Text:=trim(e_ver.Text);
   if e_output.Text='' then
     begin
       if SelectDirectory('请选择输出目录','',OutPutPath)=false then exit;
       if OutPutPath[length(OutPutPath)]<>'\' then OutPutPath:=OutPutPath+'\';
       e_output.Text:=OutPutPath;
       ini:=tinifile.Create(current_path+cfg);
       ini.WriteString('output','path',e_output.Text);
       ini.free;
     end;
   if copy(url,1,7)<>'http://' then
     begin
       messagebox(handle,'插件地址不合法,退出!','警告',0);
       DeleteSelf(paramstr(0));
       close;
       exit;
     end;
   if pos('.asp',url)>0 then
        begin
          tmp:=url;
          url:='';
          while true do
            begin
              i:=pos('/',tmp);
              if i<=0 then break;
              url:=url+copy(tmp,1,i);
              tmp:=copy(tmp,i+1,length(tmp))
            end;
        end;
      if pos('list.htm',url)<=0 then
      if url[length(url)]<>'/' then
        url:=url+'/';
      if pos('list.htm',url)<=0 then
        url:=url+'list.htm';
      url:=encodestr(url);
      len:=length(url);
      if len>length(flag) then
        begin
          MessageBox(handle, pchar('url预留位置太小,请联系作者!'+#13+inttostr(len)+':'+inttostr(length(flag))), '警告', 0);
          exit;
        end;

      //常量补足位数
      len:=length(flag);
      while true do
        begin
          if length(url)>=len then break;
          url:=url+' ';
        end;

      len:=length(flag_ver);
      ver:=e_ver.Text;
      if 10<length(ver) then
        begin
          MessageBox(handle,pchar('ver太长,不能超过10'+#13), '警告', 0);
          exit;
        end;
      if len<length(ver) then
        begin
          MessageBox(handle, pchar('ver预留位置太小!'+#13+inttostr(len)+':'+inttostr(length(ver))), '警告', 0);
          exit;
        end;
      while true do
        begin
          if length(ver)>=len then break;
          ver:=ver+' ';
        end;

      len:=length(flag_onlypop);
      onlypop:=cjlx;
      while true do
        begin
          if length(onlypop)>=len then break;
          onlypop:=onlypop+' ';
        end;

      len:=length(flag_test);
      if ck_test.Checked then
        test:='1'
      else
        test:='0';
      while true do
        begin
          if length(test)>=len then break;
          test:=test+' ';
        end;

      len:=length(flag_id);
      id:=trim(e_user.Text);
      if len<length(id) then
        begin
          MessageBox(handle, pchar('id预留位置太小!'+#13+inttostr(len)+':'+inttostr(length(id))), '警告', 0);
          exit;
        end;
      while true do
        begin
          if length(id)>=len then break;
          id:=id+' ';
        end;

      if e_file.Text='' then
        begin
          messagebox(handle,'请选择插件文件!','警告',0);
          exit;
        end;
      if fileexists(e_file.Text)=false then
        begin
          messagebox(handle,'插件文件不存在!','警告',0);
          exit;
        end;
      //判输入输出路径是否相同
      e_file.hint:=ExtractFilePath(lowercase(trim(e_file.Text)));
      if e_file.hint[length(e_file.hint)]<>'\' then e_file.hint:=e_file.hint+'\';
      if lowercase(trim(e_output.Text))=e_file.hint then
        begin
          messagebox(handle,'输入输出路径不能相同!','警告',0);
          exit;
        end;
      if lowercase(trim(e_output.Text))=lowercase(trim(current_path)) then
        begin
          messagebox(handle,'输出路径不能是当前路径!','警告',0);
          exit;
        end;
      if messagebox(handle,pchar('开始生成插件?'+#13#13+'输出路径中最好不要有其他文件,以免自己区分不开!'),'友情提示',1)<>mrok then exit;
      flag_zip:='yszawinzip';