解除CSDN BLOG发表文章的限制， 直接发送文章， 不必重复输入了

一个很简单的程序， 编程环境 dephi  6 + win2k

实现原理， 通过发送消息的方法， 将字符串发送得到指定窗口

使用方法 ， 拷贝粘贴文章到程序窗口中， 搜索目标窗口， 按发送即可

================================================================

 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Menus;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Button3: TButton;
    Timer1: TTimer;
    ProgressBar1: TProgressBar;
    pm1: TPopupMenu;
    N0x0D0x0Asendas0x0D1: TMenuItem;
    N0x0D0x0Asendas0x0A1: TMenuItem;
    OriginalBuffer1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure OriginalBuffer1Click(Sender: TObject);
    procedure N0x0D0x0Asendas0x0D1Click(Sender: TObject);
    procedure N0x0D0x0Asendas0x0A1Click(Sender: TObject);
  private
    { Private declarations }
    bRetrievingWnd:Boolean;
    bSending:boolean;
    iSendMode:integer;
  public
    { Public declarations }
    procedure SendChar;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  KeyPreview := TRUE;
  bRetrievingWnd := False;
  bSending := false;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   if bRetrievingWnd then
     begin
       Timer1.Enabled := False;
       bRetrievingWnd := False;
       Button2.Caption := '&GetWindow';
     end
   else
     begin
       bRetrievingWnd := true;
       Timer1.Enabled := true;
       button2.Caption := '&Stop';
     end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  aHwnd:HWND;
  pt:TPoint;
begin
  GetCursorPos(pt);
  aHwnd := WindowFromPoint(pt);
  if aHwnd=0 then exit;
  //Edit1.Text := '0x' + IntToHex(aHwnd, 8);
  Edit1.Text := IntToStr(aHwnd);

end;

procedure TForm1.Button1Click(Sender: TObject);
var
  rc:TRect;
begin
  GetWindowRect(button1.Handle, rc);
  pm1.Popup(rc.Left, rc.Bottom);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
   close;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key=VK_ESCAPE then
     Button2Click(Sender);
end;

procedure TForm1.SendChar;
var
  iLoop:Integer;
  iLen:Integer;
  iChar:Byte;
  aHwnd :HWND;
  aBufSend:String;
begin

  aBufSend :=  Memo1.Text;

  iLen := Length(aBufSend);
  aHwnd := StrToInt(Edit1.text);
  if aHwnd=Memo1.Handle then Exit;
 
  ProgressBar1.Min := 0;
  ProgressBar1.Max := iLen;

  iLoop := 1;
  while iLoop<=iLen do
    begin
       iChar := ord(aBufSend[iLoop]);

       //if iSendMode=0 then // original stream buffer
          SendMessage(aHwnd, WM_CHAR, iChar, 0);
       if iSendMode=1 then // 0x0D0A->0x0D
          if ( iLoop<iLen ) and (aBufSend[iLoop]=#13) and
             (aBufSend[iLoop+1]=#10) then
             begin
               inc(iLoop);
               SendMessage(aHwnd, 13, iChar, 0);
             end
       else if iSendMode=2 then // 0x0D0A->0x0A
          if ( iLoop<iLen ) and (aBufSend[iLoop]=#13) and
             (aBufSend[iLoop+1]=#10) then
             begin
               inc(iLoop);
               SendMessage(aHwnd, 10, iChar, 0)
             end;

  //     KeyBd_Event(iChar, 0, 0, 0 );
  //     KeyBd_Event(iChar, 0, KEYEVENTF_KEYUP, 0 );
       ProgressBar1.Position := iLoop;
       Application.ProcessMessages;
       inc(iLoop);
    end;

  ProgressBar1.Position := 0;
end;

procedure TForm1.OriginalBuffer1Click(Sender: TObject);
begin
   iSendMode := 0;
   SendChar;
end;

procedure TForm1.N0x0D0x0Asendas0x0D1Click(Sender: TObject);
begin
   iSendMode := 1;
   SendChar;
end;

procedure TForm1.N0x0D0x0Asendas0x0A1Click(Sender: TObject);
begin
   iSendMode := 2;
   SendChar;
end;

end.