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

📄 qqnumview.pas

📁 一个小的Delphi的QQ消息浏览工具
💻 PAS
字号:
unit QQNumView;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls,Registry,FileCtrl;

type
  TFindQQNum = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Label2: TLabel;
    ListView1: TListView;
    procedure Button1Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
  private
    { Private declarations }
    function FindPath():string;
    procedure FileSearch(PathName: string);
  public
    { Public declarations }
    procedure FindQQ();

  end;

var
  FindQQNum: TFindQQNum;

implementation

{$R *.dfm}
  uses MainUnit;
function TFindQQNum.FindPath():string;
const
  _Path = 'Software\Tencent\QQ';
var
  reg :TRegistry;
begin
  Result:='';
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    if reg.KeyExists(_Path) then
    begin
      if reg.OpenKey(_Path, False) then
      begin
        Result := reg.ReadString('Install');
      end;
    end;
  finally
    reg.CloseKey;
  end;
end;

procedure TFindQQNum.FindQQ();
var
  QQPath:string;
begin
  QQPath:=FindPath;
  if FindPath='' then Exit;
  Edit1.Text:=QQPath;

  FileSearch(QQPath);
  
end;

procedure TFindQQNum.ListView1DblClick(Sender: TObject);
begin

  MainForm.ShowMsg(Edit1.Text+'\'+ListView1.Selected.Caption+'\MsgEx.db',ListView1.Selected.Caption);
  Close;
end;

procedure TFindQQNum.Button1Click(Sender: TObject);
var
QQPath:string;
begin
  QQPath:='';
  SelectDirectory('请选择QQ安装目录','.',QQPath);
  if FindPath='' then Exit;
  Edit1.Text:=QQPath;
  FileSearch(QQPath);
end;

function IsDigit(S: string): Boolean; //变量S为要判断的字符串,返回true则正确
var
  i: integer;

begin
  Result := True;
  for i := 1 to length(s) do
  begin
    if not (s[i] in ['0'..'9']) then //判断字符串每个字符即s[i],是否为"0"到'9"数字及".'
      Result := False;
  end;
end;

procedure TFindQQNum.FileSearch(PathName: string);
var
  F: TSearchRec;
  Found: Boolean;
begin
  ListView1.Clear;
  ChDir(PathName);
  Found := (FindFirst('*.*', faAnyFile, F) = 0);
  while Found do
  begin
    if (F.Name = '.') or (F.Name = '..') then
    begin
      Found := (FindNext(F) = 0);
      Continue;
    end;

    if (F.Attr and faDirectory) > 0 then
    begin
      Application.ProcessMessages;
      //FileSearch(F.Name);
      if IsDigit(F.Name) then
      begin
        with ListView1.Items.Add do
        begin
          Caption := ExtractFileName(F.Name); //添加第一项
          //SubItems.Add(OpenDialog1.Files[i]);
          //Checked := True;
        end;
      end;
    end;
    //F.Name就是文件名,GetCurrentDir可以得到当前目录

    Found := (FindNext(F) = 0);
  end;
  FindClose(F);
  ChDir('..\');
end;

end.

⌨️ 快捷键说明

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