Aktif yazilima mesaj gondermek

Orhan · Mesaj gönderen **Orhan** » 12 Eki 2005 08:15

Hayirli Ramazanlar

Bilgi yarismasiyla ilgili "Paltalk! icin bir yazilim yaptim. Bir konuya takildim. Bir kac ornek denedim fakat olmadi. Bu konuda bana yardimci olursaniz memnun olurum.

Sorulu-cevapli olarak yazilimi olusturdum. Program, sorulan soru dogru cevaplandirildiginda Memo"ya soruyu cevaplayanin "Mik"iyle beraber dogru veya yanlis oldugunu yaziyor.
Memo"daki verilen yanlis-dogru cevaplari direk olarak "Paltalk"a gondermek istiyorum.
Yani Memo"daki cevaplar "Paltalk" ekranina iletilmesi lazim.

Selamlar

Mesaj gönderen **lazio** » 12 Eki 2005 10:56

sendkey işleminden bahsediyorsan;

Kod: Tümünü seç

// Converts a string of characters and key names to keyboard events and passes them to Windows.
// Example syntax: SendKeys('abc123{left}{left}{left}def{end}456{left 6}ghi{end}789', True);


unit sndkey32tr;

interface

uses MyMsg, SysUtils, Windows, Messages;

function SendKeys(SendKeysString : PChar; Wait : Boolean) : Boolean;
function AppActivate(WindowName : PChar) : boolean;

const
  WorkBufLen = 40;
var
  WorkBuf : array[0..WorkBufLen] of Char;

implementation
type
  THKeys = array[0..pred(MaxLongInt)] of byte;
var
  AllocationSize : integer;

function SendKeys(SendKeysString : PChar; Wait : Boolean) : Boolean;
type
  WBytes = array[0..pred(SizeOf(Word))] of Byte;
  TSendKey = record
    Name : ShortString;
    VKey : Byte;
  end;

const
  MaxSendKeyRecs = 41;
  SendKeyRecs : array[1..MaxSendKeyRecs] of TSendKey =
  (
    (Name : 'BACKSPACE'; VKey : VK_BACK),
    (Name : 'BKSP'; VKey : VK_BACK),
    (Name : 'BREAK'; VKey : VK_CANCEL),
    (Name : 'BS'; VKey : VK_BACK),
    (Name : 'CAPSLOCK'; VKey : VK_CAPITAL),
    (Name : 'CLEAR'; VKey : VK_CLEAR),
    (Name : 'DEL'; VKey : VK_DELETE),
    (Name : 'DELETE'; VKey : VK_DELETE),
    (Name : 'DOWN'; VKey : VK_DOWN),
    (Name : 'END'; VKey : VK_END),
    (Name : 'ENTER'; VKey : VK_RETURN),
    (Name : 'ESC'; VKey : VK_ESCAPE),
    (Name : 'ESCAPE'; VKey : VK_ESCAPE),
    (Name : 'F1'; VKey : VK_F1),
    (Name : 'F10'; VKey : VK_F10),
    (Name : 'F11'; VKey : VK_F11),
    (Name : 'F12'; VKey : VK_F12),
    (Name : 'F13'; VKey : VK_F13),
    (Name : 'F14'; VKey : VK_F14),
    (Name : 'F15'; VKey : VK_F15),
    (Name : 'F16'; VKey : VK_F16),
    (Name : 'F2'; VKey : VK_F2),
    (Name : 'F3'; VKey : VK_F3),
    (Name : 'F4'; VKey : VK_F4),
    (Name : 'F5'; VKey : VK_F5),
    (Name : 'F6'; VKey : VK_F6),
    (Name : 'F7'; VKey : VK_F7),
    (Name : 'F8'; VKey : VK_F8),
    (Name : 'F9'; VKey : VK_F9),
    (Name : 'HELP'; VKey : VK_HELP),
    (Name : 'HOME'; VKey : VK_HOME),
    (Name : 'INS'; VKey : VK_INSERT),
    (Name : 'LEFT'; VKey : VK_LEFT),
    (Name : 'NUMLOCK'; VKey : VK_NUMLOCK),
    (Name : 'PGDN'; VKey : VK_NEXT),
    (Name : 'PGUP'; VKey : VK_PRIOR),
    (Name : 'PRTSC'; VKey : VK_PRINT),
    (Name : 'RIGHT'; VKey : VK_RIGHT),
    (Name : 'SCROLLLOCK'; VKey : VK_SCROLL),
    (Name : 'TAB'; VKey : VK_TAB),
    (Name : 'UP'; VKey : VK_UP));

  VK_NULL = 0;
  VK_SemiColon = 186;
  VK_Equal = 187;
  VK_Comma = 188;
  VK_Minus = 189;
  VK_Period = 190;
  VK_Slash = 191;
  VK_BackQuote = 192;
  VK_LeftBracket = 219;
  VK_BackSlash = 220;
  VK_RightBracket = 221;
  VK_Quote = 222;
  VK_Last = VK_Quote;

  ExtendedVKeys : set of byte = [VK_Up, VK_Down, VK_Left, VK_Right, VK_Home, VK_End, VK_Prior, {PgUp} VK_Next, {PgDn} VK_Insert, VK_Delete];

const
  INVALIDKEY = $FFFF {Unsigned -1};
  VKKEYSCANSHIFTON = $01;
  VKKEYSCANCTRLON = $02;
  VKKEYSCANALTON = $04;
  UNITNAME = 'SendKeys';
var
  UsingParens, ShiftDown, ControlDown, AltDown, FoundClose : Boolean;
  PosSpace : Byte;
  I, L : Integer;
  NumTimes, MKey : Word;
  KeyString : string[20];

  procedure DisplayMessage(Message : PChar);
  begin
    MessageBox(0, Message, UNITNAME, 0);
  end;

  function BitSet(BitTable, BitMask : Byte) : Boolean;
  begin
    Result := ByteBool(BitTable and BitMask);
  end;

  procedure SetBit(var BitTable : Byte; BitMask : Byte);
  begin
    BitTable := BitTable or Bitmask;
  end;

  procedure KeyboardEvent(VKey, ScanCode : Byte; Flags : Longint);
  var
    KeyboardMsg : TMsg;
  begin
    keybd_event(VKey, ScanCode, Flags, 0);
    if Wait then
      while (PeekMessage(KeyboardMsg, 0, WM_KEYFIRST, WM_KEYLAST, PM_REMOVE)) do
      begin
        TranslateMessage(KeyboardMsg);
        DispatchMessage(KeyboardMsg);
      end;
  end;

  procedure SendKeyDown(VKey : Byte; NumTimes : Word; GenUpMsg : Boolean);
  var
    Cnt : Word;
    ScanCode : Byte;
    NumState : Boolean;
    KeyBoardState : TKeyboardState;
  begin
    if (VKey = VK_NUMLOCK) then
    begin
      NumState := ByteBool(GetKeyState(VK_NUMLOCK) and 1);
      GetKeyBoardState(KeyBoardState);
      if NumState then
        KeyBoardState[VK_NUMLOCK] := (KeyBoardState[VK_NUMLOCK] and not 1)
      else
        KeyBoardState[VK_NUMLOCK] := (KeyBoardState[VK_NUMLOCK] or 1);
      SetKeyBoardState(KeyBoardState);
      exit;
    end;

    ScanCode := Lo(MapVirtualKey(VKey, 0));
    for Cnt := 1 to NumTimes do
      if (VKey in ExtendedVKeys) then
      begin
        KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY);
        if (GenUpMsg) then
          KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP)
      end
      else
      begin
        KeyboardEvent(VKey, ScanCode, 0);
        if (GenUpMsg) then
          KeyboardEvent(VKey, ScanCode, KEYEVENTF_KEYUP);
      end;
  end;


  procedure SendKeyUp(VKey : Byte);
  var
    ScanCode : Byte;
  begin
    ScanCode := Lo(MapVirtualKey(VKey, 0));
    if (VKey in ExtendedVKeys) then
      KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY and KEYEVENTF_KEYUP)
    else
      KeyboardEvent(VKey, ScanCode, KEYEVENTF_KEYUP);
  end;

  procedure SendKey(MKey : Word; NumTimes : Word; GenDownMsg : Boolean);
  begin
    if (BitSet(Hi(MKey), VKKEYSCANSHIFTON)) then
      SendKeyDown(VK_SHIFT, 1, False);
    if (BitSet(Hi(MKey), VKKEYSCANCTRLON)) then
      SendKeyDown(VK_CONTROL, 1, False);
    if (BitSet(Hi(MKey), VKKEYSCANALTON)) then
      SendKeyDown(VK_MENU, 1, False);
    SendKeyDown(Lo(MKey), NumTimes, GenDownMsg);
    if (BitSet(Hi(MKey), VKKEYSCANSHIFTON)) then
      SendKeyUp(VK_SHIFT);
    if (BitSet(Hi(MKey), VKKEYSCANCTRLON)) then
      SendKeyUp(VK_CONTROL);
    if (BitSet(Hi(MKey), VKKEYSCANALTON)) then
      SendKeyUp(VK_MENU);
  end;

  {Implements a simple binary search to locate special key name strings}

  function StringToVKey(KeyString : ShortString) : Word;
  var
    Found, Collided : Boolean;
    Bottom, Top, Middle : Byte;
  begin
    Result := INVALIDKEY;
    Bottom := 1;
    Top := MaxSendKeyRecs;
    Found := false;
    Middle := (Bottom + Top) div 2;
    repeat
      Collided := ((Bottom = Middle) or (Top = Middle));
      if (KeyString = SendKeyRecs[Middle].Name) then
      begin
        Found := True;
        Result := SendKeyRecs[Middle].VKey;
      end
      else
      begin
        if (KeyString > SendKeyRecs[Middle].Name) then
          Bottom := Middle
        else
          Top := Middle;
        Middle := (Succ(Bottom + Top)) div 2;
      end;
    until (Found or Collided);
    if (Result = INVALIDKEY) then
    HataOk('Hatalı Tuş !');
  end;

  procedure PopUpShiftKeys;
  begin
    if (not UsingParens) then
    begin
      if ShiftDown then
        SendKeyUp(VK_SHIFT);
      if ControlDown then
        SendKeyUp(VK_CONTROL);
      if AltDown then
        SendKeyUp(VK_MENU);
      ShiftDown := false;
      ControlDown := false;
      AltDown := false;
    end;
  end;

begin
  AllocationSize := MaxInt;
  Result := false;
  UsingParens := false;
  ShiftDown := false;
  ControlDown := false;
  AltDown := false;
  I := 0;
  L := StrLen(SendKeysString);
  if (L > AllocationSize) then
    L := AllocationSize;
  if (L = 0) then
    Exit;

  while (I < L) do
  begin
    case SendKeysString[I] of
      '(' :
        begin
          UsingParens := True;
          Inc(I);
        end;
      ')' :
        begin
          UsingParens := False;
          PopUpShiftKeys;
          Inc(I);
        end;
      '%' :
        begin
          AltDown := True;
          SendKeyDown(VK_MENU, 1, False);
          Inc(I);
        end;
      '+' :
        begin
          ShiftDown := True;
          SendKeyDown(VK_SHIFT, 1, False);
          Inc(I);
        end;
      '^' :
        begin
          ControlDown := True;
          SendKeyDown(VK_CONTROL, 1, False);
          Inc(I);
        end;
      '{' :
        begin
          NumTimes := 1;
          if (SendKeysString[Succ(I)] = '{') then
          begin
            MKey := VK_LEFTBRACKET;
            SetBit(Wbytes(MKey)[1], VKKEYSCANSHIFTON);
            SendKey(MKey, 1, True);
            PopUpShiftKeys;
            Inc(I, 3);
            Continue;
          end;
          KeyString := '';
          FoundClose := False;
          while (I <= L) do
          begin
            Inc(I);
            if (SendKeysString[I] = '}') then
            begin
              FoundClose := True;
              Inc(I);
              Break;
            end;
            KeyString := KeyString + Upcase(SendKeysString[I]);
          end;
          if (not FoundClose) then
          begin
            //DisplayMessage('No Close');
            Exit;
          end;
          if (SendKeysString[I] = '}') then
          begin
            MKey := VK_RIGHTBRACKET;
            SetBit(Wbytes(MKey)[1], VKKEYSCANSHIFTON);
            SendKey(MKey, 1, True);
            PopUpShiftKeys;
            Inc(I);
            Continue;
          end;
          PosSpace := Pos(' ', KeyString);
          if (PosSpace <> 0) then
          begin
            NumTimes := StrToInt(Copy(KeyString, Succ(PosSpace), Length(KeyString) - PosSpace));
            KeyString := Copy(KeyString, 1, Pred(PosSpace));
          end;
          if (Length(KeyString) = 1) then
            MKey := vkKeyScan(KeyString[1])
          else
            MKey := StringToVKey(KeyString);
          if (MKey <> INVALIDKEY) then
          begin
            SendKey(MKey, NumTimes, True);
            PopUpShiftKeys;
            Continue;
          end;
        end;
      '~' :
        begin
          SendKeyDown(VK_RETURN, 1, True);
          PopUpShiftKeys;
          Inc(I);
        end;
    else
      begin
        MKey := vkKeyScan(SendKeysString[I]);
        if (MKey <> INVALIDKEY) then
        begin
          SendKey(MKey, 1, True);
          PopUpShiftKeys;
        end
        else
          HataOk('Tuş Gönderiminde Hata !');
        Inc(I);
      end;
    end;
  end;
  Result := true;
  PopUpShiftKeys;
end;

var
  WindowHandle : HWND;

function EnumWindowsProc(WHandle : HWND; lParam : LPARAM) : BOOL; export; stdcall;
var
  WindowName : array[0..MAX_PATH] of char;
begin // Can't test GetWindowText's return value since some windows don't have a title
  GetWindowText(WHandle, WindowName, MAX_PATH);
  Result := (StrLIComp(WindowName, PChar(lParam), StrLen(PChar(lParam))) <> 0);
  if (not Result) then
    WindowHandle := WHandle;
end;

function AppActivate(WindowName : PChar) : boolean;
begin
  try
    Result := true;
    WindowHandle := FindWindow(nil, WindowName);
    if (WindowHandle = 0) then
      EnumWindows(@EnumWindowsProc, Integer(PChar(WindowName)));
    if (WindowHandle <> 0) then
    begin
      SendMessage(WindowHandle, WM_SYSCOMMAND, SC_HOTKEY, WindowHandle);
      SendMessage(WindowHandle, WM_SYSCOMMAND, SC_RESTORE, WindowHandle);
      SetForegroundWindow(WindowHandle);
    end
    else
      Result := false;
  except
    on Exception do
      Result := false;
  end;
end;

end.

Orhan · Mesaj gönderen **Orhan** » 12 Eki 2005 11:55

Hayirli Ramazanlar

Eline, koluna, diline saglik.
Masaalah kod bayagi kisaymis!!!
Kod bayagi uzun. Icinden nasil cikarim bilmem ama.
Bildigim kadariyla ekranda aktiv olan bir ikinci programin
memosuna mesaj gondermek icin "handle" numarasiyla gonderilmesi lazim.

Yani ben: yaptigim programdan bir ikinci programa mesaj gondermek istiyorum. Yani sorularin cevaplarini bir ikinci ekrana yazmak istiyorum

selamlar

Mesaj gönderen **lazio** » 13 Eki 2005 09:03

Orhan yazdı:Hayirli Ramazanlar

Eline, koluna, diline saglik.
Masaalah kod bayagi kisaymis!!!
Kod bayagi uzun. Icinden nasil cikarim bilmem ama.
Bildigim kadariyla ekranda aktiv olan bir ikinci programin
memosuna mesaj gondermek icin "handle" numarasiyla gonderilmesi lazim.

Yani ben: yaptigim programdan bir ikinci programa mesaj gondermek istiyorum. Yani sorularin cevaplarini bir ikinci ekrana yazmak istiyorum

selamlar

yukarıdaki kod bir alıntıdır hocam. bu kodu bir unit olarak projene ekledikten sonra, AppActivate() ile programı aktif duruma getir, SendKey() ile TAB göndererek Memo ya konumlan ve yi se SendKey() ile yazmak istediklerini yaz. ben buna benzer şekilde kullanmıştım. kolay gele..

Orhan · Mesaj gönderen **Orhan** » 13 Eki 2005 11:41

Hayirli Ramazanlar

Ustadim gondermis oldugunuz kodu calistirip denedim. Fakat herhangi bir tepki vermedi. Ya ben yanlislik yaptim yada bir sorun var.

Ben soyle bir kod denedim:

Kod: Tümünü seç

procedure TForm1.Button1Click(Sender: TObject); 
var 
wnd: THandle; 
s: String; 
begin 
wnd := FindWindow('notepad', nil); 
Win32Check(wnd <> 0); 
wnd := FindWindowEx(wnd, 0, 'Edit', nil); 
s := Richedit1.Text; 
SendMessage(wnd, WM_SETTEXT, 0, LParam(PChar(s))); 
end

Bu kod benim yapmak istedigim isin mantigini olusturuyor.
Fakat ayni islemi "Paltalk" icin donusturemedim.
Burada mesaj "notepad" yerine "Paltalk"a gonderilmesi lazim.

Selamlar

Mesaj gönderen **MicroChip** » 15 Eki 2005 01:11

spy gibi yazılımlarla paltak ın gerçek adını göreblirsin bazen yanıltıcı olabilir. yani illa Paltak olacak değil

Orhan · Mesaj gönderen **Orhan** » 16 Eki 2005 01:58

Hayirli ramazanlar

Ilginiz icin tesekkur
Kardes bende ayni seyi tahmin ettim fakat bir cozum bulamadim
Bahsettiginiz programi ben tanimiyorum. Nette arattim bir suru program var. Hangisi oldugunu anlayamadim. Bir link verirseniz memnun olacagim

Selamlar

Delphi Forum

Aktif yazilima mesaj gondermek

Aktif yazilima mesaj gondermek

Mesaj gonderme

Re: Mesaj gonderme

Mesaj gonderme

Spy