home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Softwarová Záchrana 3
/
Softwarova-zachrana-3.bin
/
ArsClip
/
source.zip
/
UnitPaste.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2004-09-02
|
20KB
|
712 lines
unit UnitPaste;
{
Purpose:
Move the Pasting logic into it's own class. The FrmMainPopup unit
was getting a little bloated.
NOTES;
Use EmptyClipboard (or Clipboard.Clear) before pasting - this marks
clips as "ours" so the ClipboardManager can ignore them
Updates:
Don't use Simple Text version when pasting CF_DIBs
--------------------
Pasting complex items will now also include a plain text (for programs
that don't understand what, for example, CF_HTML is)
--------------------
New option to alter the clipboard (and trigger the Clipboard Manager)
Win9x Mimic characters shift keys didn't work
-----------
Clear the clipboard before pasting
This is the only place an item may be placed on the clipboard
------
Another fix for SHIFT+Insert on Win2k
--------------------
- New support for pasting with keystrokes embedded in the text
- Fix for SHIFT+Insert on Win2k
}
interface
uses UnitClipQueue, INIFiles;
type TPasteMethod = (
PASTE_CTRL_V=0,
PASTE_SHIFT_INS=1,
PASTE_MIMIC=2,
PASTE_CLIPBOARD=3,
PASTE_DEFAULT=4
);
type TPaste = class(TObject)
private
{Configurations for pasting method}
UseKeyboardMimic,
UsePastingSI,
UsePastingCV,
UseClipboardOnly,
{single time use overrides for pasting}
PasteCVOnce,
PasteSIOnce,
ClipboardOnlyOnce,
KeyboardMimicOnce : boolean;
EXEPasteList : THashedStringList;
procedure ClearMethods;
public
constructor Create;
destructor Destroy; override;
procedure SendText(s: string; ci : TClipItem = nil);
procedure SendTextWithKeystrokes(s : string);
procedure PlaceOnClipboardDontBypassClipboardManager(s : string);
procedure SendSHIFT_INSERT;
procedure SendCTRL_V;
procedure SendTAB;
procedure SendENTER;
procedure SendINSERT;
procedure SendDELETE;
procedure SendBACKSPACE;
procedure SendHOME;
procedure SendEND;
procedure SendUP;
procedure SendDOWN;
procedure SendLEFT;
procedure SendRIGHT;
{Used by FrmCONFIG to set pasting method}
procedure SetClipboardOnly;
function GetClipboardOnly : boolean;
procedure SetMimicTyping;
procedure SetUsePaste;
procedure SetUsePasteSI;
{Used by FrmMainPopup}
procedure SetClipboardOnlyOnce;
procedure SetKeyboardMimicOnce;
function GetKeyboardMimicOnce : boolean;
procedure SetUsePasteCVOnce;
procedure SetUsePasteSIOnce;
procedure ClearOnceFlags;
procedure AssignPaste(EXEName : string; method : TPasteMethod);
function GetPasteMethod(EXEName : string) : TPasteMethod;
function GetDefaultPasteMethod : TPasteMethod;
end;
var Paste : TPaste;
implementation
uses Windows, SysUtils, StrUtils, UnitFrmMainPopup, clipbrd,
UnitFrmClipboardManager, UnitOtherQueue, UnitMisc, UnitToken, Forms, Dialogs;
const EXEPASTE_FILE = 'exepaste.ini';
{ TPaste }
procedure TPaste.PlaceOnClipboardDontBypassClipboardManager(s: string);
begin
// No clearing, do not prevent the Clipboard from detecting the change
clipboard.SetTextBuf(PChar(s));
end;
//
// Either send text S or use ClipItem if specificed
//
procedure TPaste.SendText(s: string; ci : TClipItem = nil);
procedure SendUsingKeyboardMimic(s : string);
var c : char;
w : word;
i : integer;
ShiftPressed, EnterPressed : boolean;
begin
UnitMisc.AppendLog('mimic typing');
for i := 1 to length(s) do begin
c := s[i];
w := VkKeyScan(c);
ShiftPressed := (hi(w) and 1) > 0;
EnterPressed := (byte(c) = VK_RETURN);
{VkKeyScan: The first bit of the hi byte set means shift is pressed}
{Ditch LF - assume CR came first}
if (c <> #10) then begin
if ShiftPressed and (not EnterPressed) then begin
//keybd_event(VK_RSHIFT, 0, 0, 0);
keybd_event(VK_SHIFT, Lo(MapVirtualKey(VK_SHIFT,0)),0,0);
end;
{Press and release key}
keybd_event(lo(w), w, 0, 0);
keybd_event(lo(w), w, KEYEVENTF_KEYUP, 0);
if ShiftPressed and (not EnterPressed) then begin
//keybd_event(VK_RSHIFT, 0, KEYEVENTF_KEYUP, 0);
keybd_event(VK_SHIFT, Lo(MapVirtualKey(VK_SHIFT,0)), KEYEVENTF_KEYUP, 0);
end;
end;
if (i mod 10 = 0) then sleep(1); // give the keyboard buffer a little break
end;
end;
procedure PutOnClipboard;
begin
clipboard.Clear; // <-- Makes use OWNER and flags the data
// to be ignored by us
clipboard.SetTextBuf(PChar(s));
end;
procedure SendUsingPaste(s : string);
begin
//
// place text on clipboard and paste via CTRL+P
//
UnitMisc.AppendLog('clearing and placing selected text on clipboard');
UnitMisc.AppendLog('---"' + s + '"---');
PutOnClipboard;
sleep(10);
if (self.PasteSIOnce) then begin
Self.SendSHIFT_INSERT;
end else if (self.PasteCVOnce) then begin
Self.SendCTRL_V;
end else if (self.UsePastingCV) then begin
Self.SendCTRL_V;
end else if (self.UsePastingSI) then begin
Self.SendSHIFT_INSERT;
end;
end;
function PutClipOnCLipboard(ci : TClipItem; Format : word = 0) : boolean;
var duph : THandle;
dups : cardinal;
pc : PChar;
s : string;
begin
result := false;
if (Format = CF_TEXT) then begin
s := ci.GetAsText;
dups := length(s) + 1;
duph := Windows.GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, dups);
pc := Windows.GlobalLock(duph);
Windows.MoveMemory(pc, pchar(s), dups);
Windows.GlobalUnlock(duph);
Windows.SetClipboardData(CF_TEXT, duph);
end else begin
duph := UnitMisc.DupHandle(ci.GetHandle, dups);
if (duph <> 0) then begin
Windows.SetClipboardData(ci.GetFormat, duph);
end else begin
UnitMisc.AppendLog('SendText: Unable to dup ClipItem to place on clipboard');
EXIT;
end;
end;
result := true;
end;
begin
if (s = '') and (ci = nil) then EXIT;
UnitMisc.AppendLog('[Paste Start]');
// send text using configured method
// Update: ClipboardOnlyWindow will override and force
// a clipboard only operation
if (ci = nil) then begin
UnitMisc.AppendLog('Plain text version');
if (self.ClipboardOnlyOnce) then begin
self.ClipboardOnlyOnce := false;
PutOnClipboard;
end else if (self.UseKeyboardMimic or self.KeyboardMimicOnce) then begin
SendUsingKeyboardMimic(s);
self.KeyboardMimicOnce := false;
end else if (self.UsePastingCV or self.UsePastingSI
or self.PasteCVOnce or self.PasteSIOnce) then begin
SendUsingPaste(s);
self.PasteCVOnce := false;
self.PasteSIOnce := false;
end else begin
// send clipboard only
PutOnClipboard;
end;
end else begin
UnitMisc.AppendLog('complex text version');
//
// No calls to unit Clipbrd can be used to in this section
// since it will try to open and already open clipboard.
// Place both the plain text version and the complex item on the clipboard
//
Windows.OpenClipboard(0);
Windows.EmptyClipboard;
//Clipboard.Clear; // <- Makes use owner
if ci.HasText and (ci.GetFormat <> Windows.CF_DIB) then begin
if not PutClipOnCLipboard(ci, CF_TEXT) then begin
Windows.CloseClipboard;
EXIT;
end;
end;
if not PutClipOnCLipboard(ci) then begin
Windows.CloseClipboard;
EXIT;
end;
Windows.CloseClipboard;
//ci.PlaceOnClipboard;
if (self.ClipboardOnlyOnce) then begin
self.ClipboardOnlyOnce := false;
end else if (self.UseKeyboardMimic or self.KeyboardMimicOnce) then begin
if (ci.HasText) then begin
SendUsingKeyboardMimic(ci.GetAsText);
end else begin
// I can't mimic the clipitem - default to ctrl+v
self.SendCTRL_V;
end;
self.KeyboardMimicOnce := false;
end else if (self.UsePastingCV or self.PasteCVOnce) then begin
self.SendCTRL_V;
self.PasteCVOnce := false;
end else if (self.UsePastingSI or self.PasteSIOnce) then begin
self.SendSHIFT_INSERT;
self.PasteSIOnce := false;
end;
end;
UnitMisc.AppendLog('[Paste End]');
//frmClipboardManager.InformOfPaste;
//frmClipboardManager.SetIgnoreClipboard(false);
end;
//
// used by SendText and OtherItemClickEvent to simulate the user
// pressing CTRL+V to paste
//
procedure TPaste.SendCTRL_V;
var w : word;
begin
UnitMisc.AppendLog('sending CTRL+V');
// clear any phantom keystrokes
keybd_event(VK_SHIFT, VkKeyScan(char(VK_SHIFT)), KEYEVENTF_KEYUP, 0);
keybd_event(VK_CONTROL , VkKeyScan(char(VK_control)), KEYEVENTF_KEYUP, 0);
sleep(10);
// press CTRL, press V, release V, release CTRL
keybd_event(VK_CONTROL , VkKeyScan(char(VK_control)), 0, 0);
sleep(10);
w := VkKeyScan('V');
keybd_event(lo(w), w, 0, 0);
sleep(10);
keybd_event(lo(w), w, KEYEVENTF_KEYUP, 0);
sleep(10);
keybd_event(VK_CONTROL , VkKeyScan(char(VK_control)), KEYEVENTF_KEYUP, 0);
sleep(10);
UnitMisc.AppendLog('sent CTRL+V');
end;
procedure TPaste.SendSHIFT_INSERT;
begin
UnitMisc.AppendLog('sending SHIFT+INSERT');
// clear any phantom keystrokes
keybd_event(VK_SHIFT, VkKeyScan(char(VK_SHIFT)), KEYEVENTF_KEYUP, 0);
keybd_event(VK_CONTROL , VkKeyScan(char(VK_control)), KEYEVENTF_KEYUP, 0);
sleep(10);
// press SHIFT, press INSERT, release INSERT, release SHIFT
// Label VK_INSERT as extended, othewise it freaks out when combined with SHIFT
keybd_event(VK_SHIFT, Lo(MapVirtualKey(VK_SHIFT,0)),0,0); // win9x
sleep(1);
keybd_event(VK_INSERT, Lo(MapVirtualKey(VK_INSERT,0)),KEYEVENTF_EXTENDEDKEY, 0);
sleep(1);
keybd_event(VK_INSERT, Lo(MapVirtualKey(VK_INSERT,0)),KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP,0);
sleep(1);
keybd_event(VK_SHIFT, Lo(MapVirtualKey(VK_SHIFT,0)), KEYEVENTF_KEYUP, 0);
sleep(5);
UnitMisc.AppendLog('sent SHIFT+INSERT');
end;
procedure TPaste.SendTAB;
begin
UnitMisc.AppendLog('sending tab');
keybd_event(VK_TAB , 0, 0, 0);
sleep(50);
keybd_event(VK_TAB, 0, KEYEVENTF_KEYUP, 0);
sleep(10);
UnitMisc.AppendLog('sent tab');
end;
procedure TPaste.SendDELETE;
begin
UnitMisc.AppendLog('sending del');
keybd_event(VK_DELETE, 0, 0, 0);
sleep(50);
keybd_event(VK_DELETE, 0, KEYEVENTF_KEYUP, 0);
sleep(10);
UnitMisc.AppendLog('sent del');
end;
procedure TPaste.SendINSERT;
begin
UnitMisc.AppendLog('sending INSERT');
keybd_event(VK_INSERT, 0, 0, 0);
sleep(50);
keybd_event(VK_INSERT, 0, KEYEVENTF_KEYUP, 0);
sleep(10);
UnitMisc.AppendLog('sent INSERT');
end;
procedure TPaste.SendENTER;
begin
UnitMisc.AppendLog('sending insert');
keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN,0), 0, 0);
sleep(50);
keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN,0), KEYEVENTF_KEYUP, 0);
sleep(10);
UnitMisc.AppendLog('sent insert');
end;
procedure TPaste.ClearMethods;
begin
self.UseKeyboardMimic := false;
self.UsePastingSI := false;
self.UsePastingCV := false;
self.UseClipboardOnly := false;
end;
procedure TPaste.SetClipboardOnly;
begin
self.ClearMethods;
self.UseClipboardOnly := true;
end;
procedure TPaste.SetMimicTyping;
begin
self.ClearMethods;
self.UseKeyboardMimic := true;
end;
procedure TPaste.SetUsePaste;
begin
self.ClearMethods;
self.UsePastingCV := true;
end;
procedure TPaste.SetUsePasteSI;
begin
self.ClearMethods;
self.UsePastingSI := true;
end;
procedure TPaste.SetKeyboardMimicOnce;
begin
self.KeyboardMimicOnce := true;
end;
procedure TPaste.SetUsePasteCVOnce;
begin
self.PasteCVOnce := true;
end;
procedure TPaste.SetUsePasteSIOnce;
begin
self.PasteSIOnce := true;
end;
procedure TPaste.SetClipboardOnlyOnce;
begin
self.ClipboardOnlyOnce := true;
end;
function TPaste.GetClipboardOnly: boolean;
begin
result := self.UseClipboardOnly;
end;
{
//
// Not used, but may need to be refered to later
//
procedure TFrmMainPopup.PlaceTextOnClipboard(s : string);
procedure SetBuffer(format: Word; var buffer; Size: Integer);
var Data: THandle;
DataPtr: Pointer;
begin
clipboard.Open;
try
Data := Windows.GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, Size);
try
DataPtr := GlobalLock(Data);
try
Move(Buffer, DataPtr^, Size);
clipboard.Clear;
Windows.SetClipboardData(Format, Data);
finally
Windows.GlobalUnlock(Data);
end;
except
Windows.GlobalFree(Data);
raise;
end;
finally
clipboard.Close;
end;
end;
begin
s := s + #0 + 'ArsClip' + #0;
SetBuffer(CF_TEXT, PChar(s)^, length(s) + 1);
end;
}
function TPaste.GetKeyboardMimicOnce: boolean;
begin
result := self.UseKeyboardMimic;
end;
type TKeyProc = procedure;
procedure TPaste.SendTextWithKeystrokes(s: string);
var str : string;
key : string;
const SLEEPMS = 60;
procedure PreKey;
begin
self.SendText(str);
sleep(SLEEPMS);
end;
procedure PostKey;
begin
Application.ProcessMessages;
str := '';
end;
begin
// key rid of '[KEYS]'
s := rightstr(s,length(s) - 6);
str := '';
while (s <> '') do begin
if (pos('[',s) <> 0) and (pos(']',s) <> 0) then begin
str := str + TokenString(s, '[');
if (s <> '') then begin
key := Uppercase(TokenString(s, ']'));
if (key = 'TAB') then begin
prekey; self.SendTAB; PostKey;
end else if (key = 'ENTER') then begin
prekey; self.SendENTER; PostKey;
end else if (key = 'DEL') then begin
prekey; self.SendDELETE; PostKey;
end else if (key = 'HOME') then begin
prekey; self.SendHOME; PostKey;
end else if (key = 'BACK') then begin
prekey; self.SendBACKSPACE; PostKey;
end else if (key = 'END') then begin
prekey; self.SendEND; PostKey;
end else if (key = 'INS') then begin
prekey; self.SendINSERT; PostKey;
end else if (key = 'UP') then begin
prekey; self.SendUP;PostKey;
end else if (key = 'DOWN') then begin
prekey; self.SendDOWN; PostKey;
end else if (key = 'LEFT') then begin
prekey;self.SendLEFT; PostKey;
end else if (key = 'RIGHT') then begin
prekey; self.SendRIGHT; PostKey;
end else begin
// not a key, just add it to they string to
// send buffer
str := str + '['+ key + ']';
end;
end;
end else begin
str := s;
s := '';
end;
end;
if (s = '') then begin
if (str <> '') then begin
self.SendText(str);
end;
end;
end;
procedure TPaste.SendBACKSPACE;
begin
UnitMisc.AppendLog('sending back');
keybd_event(VK_BACK , 0, 0, 0);
sleep(50);
keybd_event(VK_BACK, 0, KEYEVENTF_KEYUP, 0);
sleep(10);
UnitMisc.AppendLog('sent back');
end;
procedure TPaste.SendEND;
begin
UnitMisc.AppendLog('sending end');
keybd_event(VK_END , 0, 0, 0);
sleep(50);
keybd_event(VK_END, 0, KEYEVENTF_KEYUP, 0);
sleep(10);
UnitMisc.AppendLog('sent end');
end;
procedure TPaste.SendHOME;
begin
UnitMisc.AppendLog('sending VK_HOME');
keybd_event(VK_HOME , 0, 0, 0);
sleep(50);
keybd_event(VK_HOME, 0, KEYEVENTF_KEYUP, 0);
sleep(10);
UnitMisc.AppendLog('sent VK_HOME');
end;
procedure TPaste.SendDOWN;
begin
UnitMisc.AppendLog('sending VK_DOWN');
keybd_event(VK_DOWN , 0, 0, 0);
sleep(50);
keybd_event(VK_DOWN, 0, KEYEVENTF_KEYUP, 0);
sleep(10);
UnitMisc.AppendLog('sent VK_DOWN');
end;
procedure TPaste.SendLEFT;
begin
UnitMisc.AppendLog('sending VK_LEFT');
keybd_event(VK_LEFT , 0, 0, 0);
sleep(50);
keybd_event(VK_LEFT, 0, KEYEVENTF_KEYUP, 0);
sleep(10);
UnitMisc.AppendLog('sent VK_LEFT');
end;
procedure TPaste.SendRIGHT;
begin
UnitMisc.AppendLog('sending VK_RIGHT');
keybd_event(VK_RIGHT , 0, 0, 0);
sleep(50);
keybd_event(VK_RIGHT, 0, KEYEVENTF_KEYUP, 0);
sleep(10);
UnitMisc.AppendLog('sent VK_RIGHT');
end;
procedure TPaste.SendUP;
begin
UnitMisc.AppendLog('sending VK_UP');
keybd_event(VK_UP , 0, 0, 0);
sleep(50);
keybd_event(VK_UP, 0, KEYEVENTF_KEYUP, 0);
sleep(10);
UnitMisc.AppendLog('sent VK_UP');
end;
procedure TPaste.ClearOnceFlags;
begin
PasteCVOnce := false;
PasteSIOnce := false;
ClipboardOnlyOnce := false;
KeyboardMimicOnce := false;
end;
//
// Assigned Paste Methods
//
constructor TPaste.Create;
var s : string;
begin
self.EXEPasteList := THashedStringList.Create;
s := IncludeTrailingPathDelimiter(ExtractFilePath(application.ExeName));
s := s + EXEPASTE_FILE;
if FileExists(s) then begin
self.EXEPasteList.LoadFromFile(s);
end;
end;
destructor TPaste.Destroy;
var s : string;
begin
s := IncludeTrailingPathDelimiter(ExtractFilePath(application.ExeName));
s := s + EXEPASTE_FILE;
self.EXEPasteList.SaveToFile(EXEPASTE_FILE);
MyFree(EXEPasteList);
end;
procedure TPaste.AssignPaste(EXEName: string; method: TPasteMethod);
begin
EXEPasteList.Values[EXEName] := IntToStr(Integer(method));
end;
function TPaste.GetPasteMethod(EXEName : string) : TPasteMethod;
var s : string;
begin
result := PASTE_DEFAULT;
s := EXEPasteList.Values[EXEName];
if (s <> '') then begin
result := TPasteMethod(StrToInt(s));
end;
end;
function TPaste.GetDefaultPasteMethod: TPasteMethod;
begin
result := PASTE_DEFAULT; // this case should never fire
if self.UseKeyboardMimic then begin
result := PASTE_MIMIC;
end else if self.UsePastingSI then begin
result := PASTE_SHIFT_INS;
end else if self.UsePastingCV then begin
result := PASTE_CTRL_V;
end else if self.UseClipboardOnly then begin
result := PASTE_CLIPBOARD
end;
end;
initialization
begin
Paste := TPaste.Create;
end;
finalization
begin
MyFree(Paste);
end;
end.