⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 fmpost.pas

📁 曾经在网上流行一时的QQ聊神
💻 PAS
字号:
unit FMPOST;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ToolWin, ExtCtrls, Grids, ImgList, Buttons,
  AMHotKey,Clipbrd;

type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    classview: TListView;
    timer1s: TTimer;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    postfile: TMemo;
    OpenDialog1: TOpenDialog;
    ToolButton4: TToolButton;
    ToolButton6: TToolButton;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    UpDown1: TUpDown;
    Edit1: TEdit;
    Edit2: TEdit;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    Label5: TLabel;
    Label6: TLabel;
    ToolButton7: TToolButton;
    ToolButton10: TToolButton;
    ImageList1: TImageList;
    SpeedButton1: TSpeedButton;
    ToolButton11: TToolButton;
    Label7: TLabel;
    ToolButton5: TToolButton;
    procedure posttext(theid:string;thetext:string);


    procedure classviewCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure timer1sTimer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure ToolButton8Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure ToolButton11Click(Sender: TObject);
   
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);

  protected
  procedure myshortcut(var message: TMessage); message WM_HOTKEY;

  private

    { Private declarations }
  public

    { Public declarations }
  end;

var
  Form1: TForm1;
  curviewline,curfileline:integer;
  id:integer;


implementation

{$R *.dfm}
procedure TForm1.myshortcut(var message: TMessage);
VAR
CLASSITEM:TLISTITEM;
classid:string;
classhandle:HWND;
i:integer;
classname:pchar;
classstring:string;
begin
        classhandle:=WindowFromPoint(Mouse.CursorPos);
        GetMem(ClassName, 25);
        GetClassName(classhandle,ClassName,25);
        classstring:=classname;
        classid:=INTTOSTR(classhandle);

        if CLASSVIEW.Items.Count>0 then
        begin
               FOR I:=0 TO CLASSVIEW.Items.Count-1 DO
                        if  classid=classview.Items[i].Caption then
                        begin
                                classview.Items[i].Selected:=true;
                                classview.Repaint;
                                exit;
                        end;

        end;

        CLASSITEM:=CLASSVIEW.Items.Add;
        CLASSITEM.Caption:=classid;
        CLASSITEM.SubItems.Add(classstring);
        CLASSITEM.SubItems.Add('');
        CLASSITEM.Selected:=true;
        Edit1Change(owner);



end;
procedure TForm1.posttext(theid:string;thetext:string);
var
realid:integer;
begin
        realid:=strtoint(theid);
        Clipboard.SetTextBuf(pchar(thetext));
        POSTMessage(realid, WM_paste, 1, 1);
        POSTMessage(realid, WM_KEYDOWN,VK_return,1);
        POSTMessage(realid,WM_KEYup,VK_return,1);
end;


procedure TForm1.classviewCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
        if  item.Index=curviewline then
                item.ListView.Canvas.Brush.Color:=$00B4F5C0;
end;

procedure TForm1.timer1sTimer(Sender: TObject);

begin
        if curviewline>=classview.Items.Count then
        begin
                curviewline:=0;
                if toolbutton7.Down then curfileline:=curfileline+1;
        end;
        if curfileline>=postfile.Lines.Count  then curfileline:=0;
        classview.Items[curviewline].SubItems[1]:=postfile.Lines[curfileline];
        posttext(classview.Items[curviewline].Caption,classview.Items[curviewline].SubItems[1]);
        classview.Repaint;
        label6.Caption:=inttostr(curfileline+1);


        curviewline:=curviewline+1;
        if toolbutton9.Down then curfileline:=curfileline+1;

end;

procedure TForm1.FormShow(Sender: TObject);
begin
        curviewline:=0;
        curfileline:=0;
end;

procedure TForm1.ToolButton1Click(Sender: TObject);
begin
        classview.Visible:=true ;
        postfile.Visible:=false;
end;

procedure TForm1.ToolButton2Click(Sender: TObject);
begin
        postfile.Visible:=true;
        classview.Visible:=false;
end;

procedure TForm1.ToolButton4Click(Sender: TObject);
begin
 if OpenDialog1.Execute then
                postfile.Lines.LoadFromFile(OpenDialog1.FileName)
end;

procedure TForm1.Edit1Change(Sender: TObject);
var timefloat:real;
    timeint:integer;
begin
        if classview.Items.Count<1 then
        BEGIN
                edit2.Text:=edit1.Text;
                timeint:=STRTOINT(edit1.Text)*1000;
        END
        else
        begin
                timefloat:=UpDown1.Position/classview.Items.Count;
                edit2.Text:=floattostr(timefloat);
                timeint:=round(timefloat*1000);

        end;
        form1.timer1s.Interval:=timeint;


end;

procedure TForm1.ToolButton8Click(Sender: TObject);
begin
        if classview.Items.Count=0 then toolbutton8.Down:=false;
        if toolbutton8.Down then
                BEGIN
                timer1s.Enabled:=true;
                toolbutton8.ImageIndex:=5;
                toolbutton8.Caption:='停止发送';
                END
        else
                BEGIN
                timer1s.Enabled:=false;
                toolbutton8.ImageIndex:=3;
                toolbutton8.Caption:='开始发送';
                END;

end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
        curfileline:=postfile.Perform (em_LineFromChar,$FFFF, 0);
        label6.Caption:=inttostr(curfileline+1);
end;

procedure TForm1.ToolButton11Click(Sender: TObject);
var classindex:integer;
begin
        if classview.Selected=nil then exit;
        if classview.Items.Count=1 then
        BEGIN
                ToolButton8.Down:=FALSE;
                form1.ToolButton8.Click;
                CLASSVIEW.Selected.Delete;
                Edit1Change(owner);
                exit;
        END;
        classindex:=CLASSVIEW.Selected.Index;
        CLASSVIEW.Selected.Delete;
        Edit1Change(owner);
        if classindex=0 then
                CLASSVIEW.Items[0].Selected:=true
        else
                CLASSVIEW.Items[classindex-1].Selected:=true;




end;





procedure TForm1.FormCreate(Sender: TObject);
begin
        id:=GlobalAddAtom('hotkey');
        RegisterHotKey(handle,id,0, VK_F12);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
UnRegisterHotKey(handle,id);
end;

procedure TForm1.ToolButton5Click(Sender: TObject);
VAR
i,lasth,tempmainh,tempsubh:INTEGER;
classid,classstring,tempid:string;
ClassName:pansichar;
CLASSITEM:TLISTITEM;
begin
        tempid:='0';
        tempmainh:= FindWindow('AfxFrameOrView42s',nil );
        if  tempmainh=0 then exit;
        tempmainh:=getwindow(tempmainh,GW_HWNDPREV);
        lasth:=getwindow(tempmainh,GW_HWNDLAST);
        repeat
                tempmainh:=getwindow(tempmainh,GW_HWNDNEXT);

                GetMem(ClassName, 35);
                GetClassName(tempmainh,ClassName,35);
                FreeMem(ClassName, 35); 
                classstring:=strpas(classname);
                if classstring='AfxFrameOrView42s' then
                begin
                        tempsubh:=FindWindowEx(tempmainh,0,'AfxMDIFrame42s', nil);
                        tempsubh:=FindWindowEx(tempsubh,0,'AfxFrameOrview42s', nil);
                        tempsubh:=getwindow(tempsubh,GW_HWNDNEXT);
                        tempsubh:=getwindow(tempsubh,GW_CHILD);
                        tempsubh:=FindWindowEx(tempsubh,0,'RICHEDIT', nil);
                        classid:=inttostr(tempsubh);
                        if tempsubh<>0 then
                        begin

                                if CLASSVIEW.Items.Count>0 then
                                begin
                                        FOR I:=0 TO CLASSVIEW.Items.Count-1 DO
                                                if  classid=classview.Items[i].Caption then
                                                        tempid:=classview.Items[i].Caption;
                                end;
                                if classid<>tempid then
                                begin
                                        CLASSITEM:=CLASSVIEW.Items.Add;
                                        CLASSITEM.Caption:=classid;
                                        CLASSITEM.SubItems.Add('RICHEDIT');
                                        CLASSITEM.SubItems.Add('');
                                        CLASSITEM.Selected:=true;
                                        Edit1Change(owner);
                                end;
                        end;
                end;
        until tempmainh=lasth;



end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -