ANTICHAT.XYZ    VIDEO.ANTICHAT.XYZ    НОВЫЕ СООБЩЕНИЯ    ФОРУМ  
Баннер 1   Баннер 2
Antichat снова доступен.
Форум Antichat (Античат) возвращается и снова открыт для пользователей. Здесь обсуждаются безопасность, программирование, технологии и многое другое. Сообщество снова собирается вместе.
Новый адрес: forum.antichat.xyz
Вернуться   Форум АНТИЧАТ > Программирование > С/С++, C#, Delphi, .NET, Asm
   
 
 
Опции темы Поиск в этой теме Опции просмотра

Скины
  #1  
Старый 17.09.2009, 20:08
Аватар для Fliplab
Fliplab
Участник форума
Регистрация: 29.07.2008
Сообщений: 128
Провел на форуме:
225836

Репутация: 34
Отправить сообщение для Fliplab с помощью ICQ
По умолчанию Скины

Ребят посоветуйте какойнибудь бесплатный компонент для Delphi для поддержки скинов, а то стоит триальный AlphaControls7 и не очень удобно к проге подвязывать свою либу по блоку вывода о триале.

Вот, если кому надо исходник [killtrial.dll]:
Код:
{
  Kill trial of AlphaControls7
  version 1.0
  email:fliplab@ya.ru
  author:Fliplab Software
  icq:1948260
}

library KillTrial;

uses
  Windows;

type
  OldCode = packed record
    One: DWord;
    Two: Word;
  end;


  far_jmp = packed record
    PuhsOp: Byte;
    PushArg: Pointer;
    RetOp: Byte;
  end;

var
  JmpMbw, JmpMba: far_jmp;
  OldMbw, OldMba: OldCode;
  MbwAdr, MbaAdr: Pointer;

function GetRandomString(): PWideChar;
var
  rId: DWord;
begin
  GetMem(Result, 4096);
  rId := Random(3) + 1;
  LoadStringW(hInstance, rId, Result, 4096);
end;

function NewMessageBoxExA(hWnd: HWND; lpText, lpCaption: PAnsiChar;
                          uType: UINT; wLanguageId: Word): Integer; stdcall;
var
  Text, Caption: PWideChar;
  tLen, cLen: DWord;
begin
  tLen := lstrlen(lpText) * SizeOf(WideChar) + 2;
  cLen := lstrlen(lpCaption) * SizeOf(WideChar) + 2;
  GetMem(Text, tLen);
  GetMem(Caption, cLen);
  StringToWideChar(lpText, Text, tLen);
  StringToWideChar(lpCaption, Caption, cLen);
  Result := MessageBoxExW(hWnd, Text, Caption, uType, wLanguageId);
  FreeMem(Text);
  FreeMem(Caption);
end;

function TrueMessageBoxExW(hWnd: HWND; lpText, lpCaption: PWideChar;
                           uType: UINT; wLanguageId: Word): Integer; stdcall;
var
  Written: DWord;
begin
  WriteProcessMemory(INVALID_HANDLE_VALUE, MbwAdr, @OldMbw, SizeOf(OldCode), Written);
  Result := MessageBoxExW(hWnd, lpText, lpCaption, uType, wLanguageId);
  WriteProcessMemory(INVALID_HANDLE_VALUE, MbwAdr, @JmpMbw, SizeOf(far_jmp), Written);
end;


function NewMessageBoxExW(hWndi: HWND; lpText, lpCaption: PWideChar;
                          uType: UINT; wLanguageId: Word): Integer; stdcall;
var
  MyHWND: HWND;
begin
  MyHWND := FindWindow(nil, 'Название программы');
  if (MyHWND <> 0) and (MyHWND = hWndi) and (Pos('This version of component is trial,', lpText) > 0) and (Pos('Warning', lpCaption) > 0) then
    Result := 0
  else
    Result := TrueMessageBoxExW(hWndi, lpText, lpCaption, uType, wLanguageId);
end;

procedure SetHook();
var
  hUser32, Bytes: DWord;
begin
  hUser32 := GetModuleHandle('user32.dll');
  MbwAdr  := GetProcAddress(hUser32, 'MessageBoxExW');
  MbaAdr  := GetProcAddress(hUser32, 'MessageBoxExA');
  ReadProcessMemory(INVALID_HANDLE_VALUE, MbwAdr, @OldMbw, SizeOf(OldCode), Bytes);
  ReadProcessMemory(INVALID_HANDLE_VALUE, MbaAdr, @OldMba, SizeOf(OldCode), Bytes);
  JmpMbw.PuhsOp  := $68;
  JmpMbw.PushArg := @NewMessageBoxExW;
  JmpMbw.RetOp   := $C3;
  JmpMba.PuhsOp  := $68;
  JmpMba.PushArg := @NewMessageBoxExA;
  JmpMba.RetOp   := $C3;
  WriteProcessMemory(INVALID_HANDLE_VALUE, MbwAdr, @JmpMbw, SizeOf(far_jmp), Bytes);
  WriteProcessMemory(INVALID_HANDLE_VALUE, MbaAdr, @JmpMba, SizeOf(far_jmp), Bytes);
end;

procedure Unhook();
var
  Bytes: DWord;
begin
  WriteProcessMemory(INVALID_HANDLE_VALUE, MbaAdr, @OldMba, SizeOf(OldCode), Bytes);
  WriteProcessMemory(INVALID_HANDLE_VALUE, MbwAdr, @OldMbw, SizeOf(OldCode), Bytes);
end;

// залепа
function MessageProc(code : integer; wParam : word;
                    lParam : longint) : longint; stdcall;
begin
  CallNextHookEx(0, Code, wParam, lparam);
  Result := 0;
end;

procedure SetGlobalHookProc();
begin
  SetWindowsHookEx(WH_GETMESSAGE, @MessageProc, HInstance, 0);
  Sleep(INFINITE);
end;
//

procedure SetGlobalHook();
var
  hMutex, TrId: DWord;
begin
  hMutex := CreateMutex(nil, False, 'TrialHook');
  if GetLastError = 0 then
    CreateThread(nil, 0, @SetGlobalHookProc, nil, 0, TrId) else
  CloseHandle(hMutex);
end;

procedure DLLEntryPoint(dwReason: DWord);
begin
  case dwReason of
    DLL_PROCESS_ATTACH: begin
                          SetGlobalHook();
                          Randomize();
                          SetHook()
                        end;
    DLL_PROCESS_DETACH: UnHook();
  end;
end;

begin
 DllProc := @DLLEntryPoint;
 DLLEntryPoint(DLL_PROCESS_ATTACH);
end.
Вызываем её примерно так:
Код:
program test;

uses
  Forms, Windows,
  MainUnit in 'MainUnit.pas' {MainForm};

{$R *.res}

begin
  LoadLibrary('KillTrial.dll');
  Application.Initialize;
  Application.Title := 'название программы';
  Application.CreateForm(TMainForm, MainForm);
  Application.Run;
end.

Последний раз редактировалось Fliplab; 17.09.2009 в 20:16..
 
Ответить с цитированием
 



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
LogonStudio + мои скины для него blaga Soft - Windows 2 11.02.2007 07:28
Всем qipерам СКИНЫ SK | Heaton ICQ 6 22.01.2007 15:24
Скины для Icq 5.1 devil2007 ICQ 3 29.06.2006 01:29



Здесь присутствуют: 1 (пользователей: 0 , гостей: 1)
 


Быстрый переход




ANTICHAT.XYZ