unit_mypro.pas

传奇3封外挂客户端+登陆器+配置器源码............................

unit Unit_MyPro;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,Variants,
  StdCtrls, ExtCtrls, ComCtrls,DB, DBTables,ShellAPI, ShlObj,Registry,TlHelp32,WinSock,SUIForm,SUIThemes;
type
  TGuild=record
    name:String;
    char1:String;
    char2:String;
    count:integer;
  end;
  PGuild=^TGuild;
  function FindDir(handle:THandle):String;
  function HostToIP(Name: string; var Ip: string): Boolean;
  function DynamicResolution(bit: integer):Boolean;
  function Idx_Guild(GuildList:TList;GuildPath:string):boolean;
  Function ReadFileInfo(var Exe_Title:String;var Exe_Ver:String;var Exe_Type:word;var Tmp_Server_info:TList;Var Tmp_Update_info:TList;Var Tmp_Notice:TMemoryStream;Var Tmp_Cmlist:TMemoryStream):Boolean;
  procedure SetForm_Style(destform:TsuiForm;Form_Type:integer);
  function SetMir3(VerCode:int64):boolean;
  procedure CloseHwnd(h:hwnd);
var
  AppPath:String;
  Reg_SvrIp,ServerUrl:String;
  Reg_SvrPort,Select_idx:integer;
  ServerS,Updates:TList;
  Pic_Memo:TMemoryStream;
  ExeTitle,ExeVer:String;
  ExeType:Word;
  Mir3ExeName:String;
implementation

uses Unit_RcFile;

function FindDir(handle:THandle):String;
var
  TitleName : string;
  lpItemID : PItemIDList;
  BrowseInfo : TBrowseInfo;
  DisplayName : array[0..MAX_PATH] of char;
  TempPath : array[0..MAX_PATH] of char;
begin
  Result:='';
  FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
  BrowseInfo.hwndOwner := Handle;
  BrowseInfo.pszDisplayName := @DisplayName;
  TitleName := '请选择一个目录：';
  BrowseInfo.lpszTitle := PChar(TitleName);
  BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
  lpItemID := SHBrowseForFolder(BrowseInfo);
  if lpItemId <> nil then begin
    SHGetPathFromIDList(lpItemID, TempPath);
    Result:=TempPath;
    if Copy(Result,length(Result),1)<>'\' then Result:=Result+'\';
    GlobalFreePtr(lpItemID);
  end;
end;



Function StrToIp(Str:String):String;
var
  ip,ip1,ip2,ip3,ip4:string;
begin
  ip1:=Trim(Copy(Str,1,3));
  ip2:=Trim(Copy(Str,5,3));
  ip3:=Trim(Copy(Str,9,3));
  ip4:=Trim(Copy(Str,13,3));
  if ip1+ip2+ip3+ip4<>'' then
  begin
    Try
      if (StrToInt(ip1)<0) or (StrToInt(ip1)>255) then ip1:='255';
      if (StrToInt(ip2)<0) or (StrToInt(ip2)>255) then ip2:='255';
      if (StrToInt(ip3)<0) or (StrToInt(ip3)>255) then ip3:='255';
      if (StrToInt(ip4)<0) or (StrToInt(ip4)>255) then ip4:='255';
      Ip:=ip1+'.'+ip2+'.'+ip3+'.'+ip4;
    except
      ip:='';
    end;
  end
  else ip:='';
  Result:=ip;
end;

function HostToIP(Name: string; var Ip: string): Boolean;
var
  wsdata : TWSAData;
  hostName : array [0..255] of char;
  hostEnt : PHostEnt;
  addr : PChar;
begin
  WSAStartup ($0101, wsdata);
  try
    gethostname (hostName, sizeof (hostName));
    StrPCopy(hostName, Name);
    hostEnt := gethostbyname (hostName);
    if Assigned (hostEnt) then
      if Assigned (hostEnt^.h_addr_list) then
      begin
        addr := hostEnt^.h_addr_list^;
        if Assigned (addr) then
        begin
           IP := Format ('%d.%d.%d.%d', [byte (addr [0]),byte (addr [1]), byte (addr [2]), byte (addr [3])]);
           Result := True;
        end
        else
          Result := False;
        end
      else Result := False
    else
    begin Result := False;  end;
finally
  WSACleanup;
end
end;

function DynamicResolution(bit: integer):Boolean;
var
  lpDevMode: TDeviceMode;
  tmpDc:HDC;
  x,y,rl:integer;
begin
  tmpDC := GetDC(0);
  try
    x := GetSystemMetrics(SM_CXSCREEN);
    y := GetSystemMetrics(SM_CYSCREEN);
    rl := GetDeviceCaps(tmpDC,BITSPIXEL);
  except end;
  if rl=bit then exit;
  Result := EnumDisplaySettings(nil, 0, lpDevMode);
  if Result then
  begin
    lpDevMode.dmFields := DM_PELSWIDTH Or DM_PELSHEIGHT or DM_DISPLAYFREQUENCY or DM_BITSPERPEL ;
    lpDevMode.dmPelsWidth := X;
    lpDevMode.dmPelsHeight := Y;
    lpDevMode.dmBitsPerPel := bit;
    Result := ChangeDisplaySettings(lpDevMode, 0) = DISP_CHANGE_SUCCESSFUL;
  end;
  SystemParametersInfo(SPI_GETWORKAREA,0,0,SPIF_SENDCHANGE);
end;

function Idx_Guild(GuildList:TList;GuildPath:string):boolean;
var
  Guilds_txt,Guild_txt:TStrings;
  i,j,count,lxcount:integer;
  GuildName,Str:String;
  Guild:PGuild;
  Jsbz,lxbz:boolean;
begin
  GuildList.Clear;
  Result:=True;
  if not FileExists(GuildPath+'Guildlist.txt') then
  begin
    Result:=False;
    exit;
  end;
  Guilds_txt:=TStringList.create;
  Guild_txt:=TStringList.create;
  Guilds_txt.LoadFromFile(GuildPath+'Guildlist.txt');
  for i := 0 to Guilds_txt.Count-1 do
  begin
    New(Guild);
    GuildName:=Trim(Guilds_txt[i]);
    Guild_txt.Clear;
    count:=0;
    lxcount:=0;
    jsbz:=False;
    if Copy(GuildName,1,1)<>';' then
    begin
      if FileExists(GuildPath+'Guilds\'+GuildName+'.txt') then
      begin
        Guild.name:=GuildName;
        Guild_txt.LoadFromFile(GuildPath+'Guilds\'+GuildName+'.txt');
        for j:=0 to Guild_txt.Count-1 do
        begin
          str:=Trim(Guild_txt[j]);
          if Copy(Str,1,1)='#' then
          begin
            jsbz:=True;
            if StrToInt(Trim(Copy(Str,2,pos(' ',str)-1)))=1 then lxbz:=true;
          end;
          if (Copy(Str,1,1)='+') and Jsbz then
          begin
            count:=count+1;
            if lxbz and (lxcount=0) then
            begin
              Guild.char1:=Trim(Copy(Str,2,length(Str)-1));
              lxcount:=1;
            end
            else
            begin
            if lxbz and (lxcount=1) then
            begin
              Guild.char2:=Trim(Copy(Str,2,length(Str)-1));
              lxcount:=2;
            end;
            end;
          end;
        end;
        Guild.count:=count;
      end;
      GuildList.Add(Guild);
    end;
  end;
  Guilds_txt.free;
  Guild_txt.Free;
end;

Function ReadFileInfo(var Exe_Title:String;var Exe_Ver:String;var Exe_Type:word;var Tmp_Server_info:TList;Var Tmp_Update_info:TList;Var Tmp_Notice:TMemoryStream;Var Tmp_Cmlist:TMemoryStream):Boolean;
var
  Source_Memo,Rc_Memo:TMemoryStream;
  SourceSize,RcSize:integer;
  RcFile:TRcFile;
begin
  try
  try
    Source_Memo:=TMemoryStream.Create;
    Rc_Memo:=TMemoryStream.Create;
    SourceSize:=1222144;
    Source_Memo.LoadFromFile(Application.ExeName);
    RcSize:=Source_Memo.Size-SourceSize;
    Rc_Memo.SetSize(RcSize);
    Source_Memo.Seek(SourceSize,soFromBeginning);
    Rc_Memo.CopyFrom(Source_Memo,RcSize);
    Rc_Memo.Position:=0;
    RcFile:=TRcFile.Create;
    RcFile.DecodeMem(Rc_Memo,Exe_Title,Exe_Ver,Exe_Type,Tmp_Server_info,Tmp_Update_info,Pic_Memo,Tmp_Notice,Tmp_Cmlist);
    RcFile.Free;
  finally
    Source_Memo.Free;
    Rc_Memo.Free;
  end;
  except
    Result:=False;
    Exit;
  end;
  Result:=True;
end;

procedure SetForm_Style(destform:TsuiForm;Form_Type:integer);
begin
  case Form_Type of
    0:destform.UIStyle:=MacOS;
    1:destform.UIStyle:=WinXP;
    2:destform.UIStyle:=Protein;
    3:destform.UIStyle:=FromThemeFile;
    4:destform.UIStyle:=BlueGlass;
  end;

end;


function SetMir3(VerCode:int64):boolean;
var
  s:string;
  byte1:longint;
  Found:boolean;
  byte2:integer;
  HProcess,HSnapshot:THandle;
  lpNumberOfBytesRead,lpNumberOfBytesWritten: DWORD;
  appe:TProcessEntry32;
begin
  Result:=True;
  HSnapshot:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  appe.dwSize:= SizeOf(appe);
  found:= Process32First(HSnapshot, appe);
  while Integer(found) <> 0 do
  begin
  try
    s:=ExtractFileName(appe.szExeFile);
    if (UpperCase(s)=UpperCase(ExtractFileName(Mir3ExeName))) or (UpperCase(s)=UpperCase('mir3.exe')) then
    begin
      HProcess:=OpenProcess(PROCESS_ALL_ACCESS,true,appe.th32ProcessID);
      byte2:=$4b97d8;
      ReadProcessMemory(HProcess,Ptr(byte2),@byte1,4,lpNumberOfBytesRead);
      if byte1=20030704 then//光通NEW
      begin
        byte1:=VerCode;
        WriteProcessMemory(HProcess,ptr(byte2),@byte1,4,lpNumberOfBytesWritten);
      end
      else
      begin
        byte2:=$4b5798;
        ReadProcessMemory(HProcess,Ptr(byte2),@byte1,4,lpNumberOfBytesRead);
        if byte1=20030704 then//光通old
        begin
          byte1:=VerCode;
          WriteProcessMemory(HProcess,ptr(byte2),@byte1,4,lpNumberOfBytesWritten);
        end
        else
        begin
          byte2:=$4c2888;
          ReadProcessMemory(HProcess,Ptr(byte2),@byte1,4,lpNumberOfBytesRead);
          if byte1=20030704 then//3G
          begin
            byte1:=VerCode;
            WriteProcessMemory(HProcess,ptr(byte2),@byte1,4,lpNumberOfBytesWritten);
          end
          else Result:=False;
        end;
      end;
    end;
  except
  end;
  Found:=Process32Next(HSnapshot,appe);
  end;
  CloseHandle(HSnapshot);
end;


procedure CloseHwnd(h:hwnd);
var
  dwThreadId,dwProcessId:DWORD;
  hProcess:integer;
begin
  dwThreadId:=GetWindowThreadProcessId(h,@dwProcessId);
  hProcess:=OpenProcess(PROCESS_TERMINATE,FALSE,dwProcessId);
  if(hProcess<>NULL) then  TerminateProcess(hProcess,0);
end;
end.