Скины

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

Вот, если кому надо исходник [killtrial.dll]:

Code:

{
  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.

Вызываем её примерно так:

Code:

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.

 

Я, например, только что был на официальном сайте и прочитал такое:

Но за код все равно спасибо.

 

Не за что, если не лень ткни ++. Но хотелось бы чтото простенькое и функциональное, а главное бесплатное. Мог бы сам написать, но както не охото на это время тратить.

 

дак AlphaControls бесплатный для СНГ

 

Тогда почему когда я его пускаю у меня выводит мессадж что триал?)

 

У тебя, наверное, триал версия установлена.

 

на этой странице все написано: http://www.alphaskins.com/index_rus.php
у меня стоит, никаких месседжей нету