翻译！从进程中取QQ号码！急，求助！分不够可加，最高800！(200分)

moonight59 · 2006-04-14

有这么一段易语言写的内容，我想转成Delphi的，但是始终不行，请帮忙。 后面我会贴出我写的代码，请会做的朋友帮我改错或者另外写一份！ ================================================================= .程序集窗口程序集1 .程序集变量关键字, 字节集, , , /MsgEx.db .程序集变量路径分隔符, 字节集, , , / .程序集变量 QQ进程名, 文本型, , , QQ.EXE .程序集变量耗时, 整数型 .子程序 _开始搜索_被单击 .局部变量进程句柄, 整数型 .局部变量进程快照, 整数型 .局部变量进程信息, PROCESSENTRY32 耗时＝取启动时间 () QQ进程名＝ “QQ.EXE” 路径分隔符＝到字节集 (“/”) 关键字＝到字节集 (“/MsgEx.db”) 进程快照＝ CreateToolhelp32Snapshot (#TH32CS_SNAPALL, 0) .如果真 (进程快照＝ 0)    信息框 (“创建进程快照列表失败 .”, #信息图标, “提示”)    返回 () .如果真结束 进程信息.dwSize ＝ 296  ' = len (uProcess) 进程句柄＝ Process32First (进程快照, 进程信息) 列表框1.清空 () .判断循环首 (进程句柄 ≠ 0)    .如果真 (寻找文本 (到文本 (进程信息.szExeFile), QQ进程名, , 真) ≠ -1)        列表框1.加入项目 (“ID: ” ＋到文本 (进程信息.th32ProcessID) ＋ “    QQ号码: ” ＋查找QQ号码 (进程信息.th32ProcessID), )    .如果真结束    进程句柄＝ Process32Next (进程快照, 进程信息) .判断循环尾 () CloseHandle (进程快照) 耗时＝取启动时间 () －耗时 标签1.标题＝ “耗时: ” ＋到文本 (耗时) ＋ “ 毫秒” .子程序查找QQ号码, 文本型 .参数进程ID, 整数型 .局部变量操作句柄, 整数型 .局部变量内存地址, 整数型 .局部变量读取结果, 整数型 .局部变量内存块长度, 整数型 .局部变量开始地址, 整数型 .局部变量结束地址, 整数型 .局部变量数据缓冲区, 字节集 .局部变量 QQ号码, 文本型 .局部变量内存块信息, MEMORY_BASIC_INFORMATION .局部变量地址偏移, 整数型 .局部变量地址值, 字节型 操作句柄＝ OpenProcess (#PROCESS_VM_READ ＋ #PROCESS_QUERY_INFORMATION, 0, 进程ID) .如果真 (操作句柄＝ 0)    信息框 (“不能打开进程 .”, #信息图标, “提示”)    返回 (“”) .如果真结束 内存块长度＝ 28 .判断循环首 (真)    .如果真 (VirtualQueryEx (操作句柄, 内存地址, 内存块信息, 内存块长度) ＝ 0)        CloseHandle (操作句柄)        返回 (“”)    .如果真结束    .如果真 (内存块信息.Type ＝ #MEM_PRIVATE 且内存块信息.Protect ＝ #PAGE_READWRITE)        数据缓冲区＝取空白字节集 (内存块信息.RegionSize)        读取结果＝ ReadProcessMemory (操作句柄, 内存地址, 数据缓冲区, 内存块信息.RegionSize, 0)        .如果 (读取结果 ≠ 0)            结束地址＝寻找字节集 (数据缓冲区, 关键字, )            .判断循环首 (结束地址 ≠ -1)                开始地址＝倒找字节集 (数据缓冲区, 路径分隔符, 结束地址－ 1)                .如果真 (开始地址 ≠ -1 且结束地址－开始地址＜ 16 且结束地址－开始地址＞ 4)                    .变量循环首 (开始地址＋ 1, 结束地址－ 1, 1, 地址偏移)  ' 判断是否为数字格式                        地址值＝取字节集数据 (取字节集中间 (数据缓冲区, 地址偏移, 1), #字节型)                        .如果真 (地址值＜ 48 或地址值＞ 57)                            跳出循环 ()                        .如果真结束                    .变量循环尾 ()                    .如果真 (地址偏移＝结束地址)                        QQ号码＝取字节集数据 (取字节集中间 (数据缓冲区, 开始地址＋ 1, 结束地址－开始地址－ 1), #文本型)                        CloseHandle (操作句柄)                        返回 (QQ号码)                    .如果真结束                .如果真结束                结束地址＝寻找字节集 (数据缓冲区, 关键字, 结束地址＋ 1)            .判断循环尾 ()        .否则            ' 输出调试文本 (“不能读取内存块: ” ＋到文本 (内存地址))        .如果结束    .如果真结束    内存地址＝内存地址＋内存块信息.RegionSize .判断循环尾 () CloseHandle (操作句柄) 返回 (“”) ========================================================== 我的程序代码： ========================================================== unit Unit1; interface uses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, ComCtrls, UnitEndQQ, StdCtrls; type  TForm1 = class(TForm)    List: TListView;    btn1: TButton;    procedure ListDblClick(Sender: TObject);    procedure btn1Click(Sender: TObject);  private    { Private declarations }  public    { Public declarations }  end; var  Form1: TForm1; implementation {$R *.dfm} function IsNum(str: string): Boolean; var  i: Integer; begin  Result:=TryStrToInt(str,i); end; procedure GetInfoFromProcess(var NumList, PIDList: TStringList); var  i,position: Integer;  PIDlistTemp: TStringList;  Phd, n: Cardinal;  bAddr: DWORD;  MyChars: array of Char;  PInfo, QQnum: string;  Sys_Info: _SYSTEM_INFO;  MemInfo: MEMORY_BASIC_INFORMATION;  find: Boolean; begin  PIDlistTemp:=TStringList.Create;  GetProcessIDs('QQ.exe',PIDlistTemp);  PIDList.Assign(PIDlistTemp);  GetProcessIDs('TM.exe',PIDlistTemp);  PIDList.Add(PIDlistTemp.Text);  PIDlistTemp.Free;  for i:=PIDList.Count-1 downto 0 do  begin    if(not IsNum(PIDList.Strings))then    begin      PIDList.Delete(i);    end;    end;  for i:=0 to PIDList.Count-1 do  begin    find:=False;    Phd:=OpenProcess(PROCESS_VM_READ + PROCESS_QUERY_INFORMATION,                     False,StrToInt(PIDList.Strings));    if(Phd>0)then    begin      GetSystemInfo(Sys_Info);      bAddr:=DWORD(Sys_Info.lpMinimumApplicationAddress);      while(not find)and(VirtualQueryEx(Phd,Pointer(bAddr),MemInfo,SizeOf(MemInfo))<>0)do      begin        if(MemInfo.Type_9=MEM_PRIVATE)and(MemInfo.AllocationProtect=PAGE_READWRITE)then        begin          SetLength(MyChars,MemInfo.RegionSize);          if(ReadProcessMemory(Phd,Pointer(bAddr),@MyChars,MemInfo.RegionSize,n))          and(n>0)then          begin            PInfo:=Trim(string(MyChars));            position:=Pos('/MsgEx.db',PInfo);            while(not find)and(position>5)do  //1            begin              Delete(PInfo,1,position-12);              if(position>5)then  //2              begin                if(PInfo[position-1] in ['0'..'9'])then   //3                begin                  Dec(position);                  QQnum:='';                  while(PInfo[position] in ['0'..'9'])do    //4                  begin                    QQnum:=QQnum+PInfo[position];                    Dec(position);                  end; //4                  find:=True;                end;//3              end;//2            end;//1          end;        end;        bAddr:=bAddr+MemInfo.RegionSize;      end;      CloseHandle(Phd);      if(QQnum='')then QQnum:='0';      NumList.Add(QQnum);    end;  end; end; procedure TForm1.ListDblClick(Sender: TObject); begin  EndOneProcess(StrToInt(List.Selected.SubItems[0])); end; procedure TForm1.btn1Click(Sender: TObject); var  NL,PIDL: TStringList;  i: Integer; begin  NL:=TStringList.Create;  PIDL:=TStringList.Create;  GetInfoFromProcess(NL,PIDL);  List.Clear;  for i:=0 to PIDL.Count-1 do  begin    with List.Items.Add do    begin      Caption:=NL.Strings;      SubItems.Add(PIDL.Strings);    end;  end;  NL.Free;  PIDL.Free; end; end. ///////////////////////////////////////////////// unit UnitEndQQ; interface uses  Windows, Classes, SysUtils, TLHelp32; procedure EndOneProcess(PID: Cardinal);    //需要uses TLHelp32; procedure EndProcess(AFileName: string);    //需要uses TLHelp32; procedure EnumProcess(AFileName: string; var Num: Integer); procedure GetProcessIDs(AFileName: string; var IDs: TStringList); implementation const  PROCESS_TERMINATE = $0001; procedure EndOneProcess(PID: Cardinal);    //需要uses TLHelp32; begin  TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0), PID), 0); end; procedure EndProcess(AFileName: string);    //需要uses TLHelp32; var  ContinueLoop: BOOL;  FSnapShotHandle: THandle;  FProcessEntry32: TProcessEntry32; begin  FSnapShotHandle:=CreateToolhelp32SnapShot(TH32CS_SNAPPROCESS, 0);  FProcessEntry32.dwSize:=SizeOf(FProcessEntry32);  ContinueLoop:=Process32First(FSnapshotHandle, FProcessEntry32);  while ContinueLoop do  begin    if((UpperCase(ExtractFileName(FProcessEntry32.szExeFile))=UpperCase(AFileName))    or(UpperCase(FProcessEntry32.szExeFile)=UpperCase(AFileName)))then      TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0), FProcessEntry32.th32ProcessID), 0);    ContinueLoop:=Process32Next(FSnapshotHandle, FProcessEntry32);  end; end; procedure EnumProcess(AFileName: string; var Num: Integer); var  ContinueLoop: BOOL;  FSnapShotHandle: THandle;  FProcessEntry32: TProcessEntry32; begin  FSnapShotHandle:=CreateToolhelp32SnapShot(TH32CS_SNAPPROCESS, 0);  FProcessEntry32.dwSize:=SizeOf(FProcessEntry32);  ContinueLoop:=Process32First(FSnapshotHandle, FProcessEntry32);  Num:=0;  while ContinueLoop do  begin    if((UpperCase(ExtractFileName(FProcessEntry32.szExeFile))=UpperCase(AFileName))    or(UpperCase(FProcessEntry32.szExeFile)=UpperCase(AFileName)))then    begin      Inc(Num);    end;    ContinueLoop:=Process32Next(FSnapshotHandle, FProcessEntry32);  end; end; procedure GetProcessIDs(AFileName: string; var IDs: TStringList); var  ContinueLoop: BOOL;  FSnapShotHandle: THandle;  FProcessEntry32: TProcessEntry32; begin  if IDs=nil then Exit;  IDs.Clear;  FSnapShotHandle:=CreateToolhelp32SnapShot(TH32CS_SNAPPROCESS, 0);  FProcessEntry32.dwSize:=SizeOf(FProcessEntry32);  ContinueLoop:=Process32First(FSnapshotHandle, FProcessEntry32);  while ContinueLoop do  begin    if((UpperCase(ExtractFileName(FProcessEntry32.szExeFile))=UpperCase(AFileName))    or(UpperCase(FProcessEntry32.szExeFile)=UpperCase(AFileName)))then      IDs.Add(IntToStr(FProcessEntry32.th32ProcessID));    ContinueLoop:=Process32Next(FSnapshotHandle, FProcessEntry32);  end; end; end.

moonight59 · 2006-04-14

form信息： ====================== object Form1: TForm1  Left = 192  Top = 142  Width = 414  Height = 480  Caption = 'Form1'  Color = clBtnFace  Font.Charset = DEFAULT_CHARSET  Font.Color = clWindowText  Font.Height = -11  Font.Name = 'MS Sans Serif'  Font.Style = []  OldCreateOrder = False  PixelsPerInch = 96  TextHeight = 13  object List: TListView    Left = 0    Top = 0    Width = 273    Height = 433    Checkboxes = True    Columns = <      item        Caption = 'QQ号码'        Width = 110      end      item        Caption = 'PID'        Width = 120      end>    ColumnClick = False    DragMode = dmAutomatic    Font.Charset = GB2312_CHARSET    Font.Color = clWindowText    Font.Height = -12    Font.Name = '宋体'    Font.Style = []    FlatScrollBars = True    GridLines = True    ReadOnly = True    RowSelect = True    ParentFont = False    TabOrder = 0    ViewStyle = vsReport    OnDblClick = ListDblClick  end  object btn1: TButton    Left = 312    Top = 56    Width = 75    Height = 25    Caption = 'refresh'    TabOrder = 1    OnClick = btn1Click  end end

全文检索 · 2006-04-15

这个也不取QQ号码,只是查找到有几个QQ在登陆,还有QQ的ID, 不需要用这么长的代码去得到这些内容

moonight59 · 2006-04-15

我可以明确地告诉你，这个方法能够得到QQ号。易语言代码能够通过编译运行得到当前运行中的QQ号！

全文检索 · 2006-04-16

兄弟你一定不知道我安装的是什么版本,qq2006beta1.exe  XP SP2 你上面的代码已编译通过,得到的结果是   第一个号码 0   我没有第二个号码所以没看到

kalvin666 · 2006-04-16

关注这个问题，但我不会，知道的告诉我啊

wenyian0928 · 2006-04-16

看一看进程方面的书，应该没有问题，不用翻译，自己写一个。 因为我不用QQ，所以无法写。 思路： 1、用PSAPI.dll遍历进程，找到进程； 2、找到QQ号码的窗口句柄(FindWindowsEx)。取值。(用SPY查看QQ号码的窗口句柄及其窗口深度) 最多不超过20行代码。

全文检索 · 2006-04-16

方法倒是不难,主要是QQ版本众多,还有很多人使用珊蝴虫,这些窗口句柄都不一样, 所以我很怀疑能否实现, 现在我使用的2006好办,QQ号码直接用SPY就可以看到.其它版本的QQ则不然 以前2004或2005的都不会显示 所以楼主很难实现获得所有的QQ号码.

moonight59 · 2006-04-17

我只是找人帮忙翻译，没叫你们评论这个代码能不能实现相应的功能！ 我之所以愿意出高分，就是因为我知道代码能够实现相应功能！

moonight59 · 2006-04-17

不相信前面那段易语言程序能实现的人，留下你们的Email，我给你们发它的执行程序！眼见为实

sundata · 2006-04-17

cgcpj@tom.com

moonight59 · 2006-04-17

to sundata: 发给你了。

andd_chen · 2006-04-17

我觉得你这个不能取到qq号，这个东西我前几天做过了，我是用的其他方法实现的，我也很怀疑你这个能不能抓到2006版本的qq，如果可以，你把代码编译后的程序发给我试试 email : andd_chen@126.com

moonight59 · 2006-04-17

to andd_chen: 发给你了。

andd_chen · 2006-04-17

不知道你是要只取一次还是要跟踪聊天记录，如果是跟踪聊天，这个方法可能不行，如果要看当前有哪些号码在用，这个在2006版本前应该可以（我家的是2005）

luoxipo · 2006-04-17

我很怀疑这段代码能不能找到qq窗口，前两天有人聊天，中了qq尾巴，我不小心点了下，也中了，但是我的qq并不发消息，今天没事，拿那个尾巴研究了下，其实是盗传奇号的个马而已，它查找qq的方式就是通过窗口来的，但是qq2006版的这种方法好像是失效了

moonight59 · 2006-04-18

请你们看清楚问题！

moonight · 2006-05-25

顶一下，希望有人看到！再来帮忙！

翻译！从进程中取QQ号码！急，求助！分不够可加，最高800！(200分)

moonight59

Unregistered / Unconfirmed

moonight59

Unregistered / Unconfirmed

全文检索

Unregistered / Unconfirmed

moonight59

Unregistered / Unconfirmed

全文检索

Unregistered / Unconfirmed

kalvin666

Unregistered / Unconfirmed

wenyian0928

Unregistered / Unconfirmed

全文检索

Unregistered / Unconfirmed

moonight59

Unregistered / Unconfirmed

moonight59

Unregistered / Unconfirmed

sundata

Unregistered / Unconfirmed

moonight59

Unregistered / Unconfirmed

andd_chen

Unregistered / Unconfirmed

moonight59

Unregistered / Unconfirmed

andd_chen

Unregistered / Unconfirmed

luoxipo

Unregistered / Unconfirmed

moonight59

Unregistered / Unconfirmed

moonight

Unregistered / Unconfirmed

Similar threads