Softwarová Záchrana 3/Softwarova-zachrana-3.bin/ArsClip/source.zip/UnitPaste.pas

Pascal/Delphi Source File | 2004-09-02 | 19.9 KB | 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.