Скины
Ребят посоветуйте какойнибудь бесплатный компонент для 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.
|
