nhcsearchgamefrm.pas

NetHook API 对战平台内核库是一套实现时下流行的网络对战平台[如浩方、VS]同样功能的通用内核库

unit NhcSearchGameFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileCtrl, IdBaseComponent, IdComponent, IdRawBase,
  IdRawClient, IdIcmpClient;

type
  TSearchGameForm = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    GameNameEdit: TEdit;
    FilesEdit: TEdit;
    CurrentPathLabel: TLabel;
    StartButton: TButton;
    StopButton: TButton;
    ExitButton: TButton;
    DriveComboBox1: TDriveComboBox;
    procedure ExitButtonClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure StopButtonClick(Sender: TObject);
    procedure StartButtonClick(Sender: TObject);
  private
    { Private declarations }
    FStop: Boolean;
    FSearchFileList: TStrings;
    FFindFileName: string;
    FCount: Integer;
    
    function SearchDir(Dir: string): string;
    function GetDriver: string;
  public
    { Public declarations }
    procedure SetGameName(const Name: string);
    procedure SetSearchFiles(const Files: string);
    function GetFindFileName: string;
  end;

implementation

{$R *.dfm}

procedure TSearchGameForm.ExitButtonClick(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

procedure TSearchGameForm.FormCreate(Sender: TObject);
begin
  FSearchFileList := TStringList.Create;
end;

procedure TSearchGameForm.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FSearchFileList);
end;

function TSearchGameForm.SearchDir(Dir: string): string;
var
  F: TSearchRec;
  FR: Integer;
  I: Integer;

  function AcceptSearchFile(const FileName: string): Boolean;
  var
    Tip: string;
  begin
    CurrentPathLabel.Caption := Dir;
    Tip := Format('找到了文件[%s]，使用这个文件吗？', [FileName]);
    Result := MessageBox(Application.Handle, PChar(Tip), '确认文件', MB_YESNO) = IDYES;
  end;
begin
  Result := '';
  Dir := IncludeTrailingPathDelimiter(Dir);
  Inc(FCount);
  if FCount mod 300 = 0 then
  begin
    CurrentPathLabel.Caption := Dir;
    Application.ProcessMessages;
  end;
  
  // 遍历文件 
  FR := FindFirst(Dir + '*.exe', faAnyFile, F);
  try
    while FR = 0 do
    begin
      if FStop then Exit;
    
      for I := 0 to FSearchFileList.Count - 1 do
      begin
        if SameText(F.Name, FSearchFileList[I]) then
        begin
          if AcceptSearchFile(F.Name) then
          begin
            Result := Dir + F.Name;
            Exit;
          end;
        end;
      end;
      FR := FindNext(F);
    end;
  finally
    FindClose(F);
  end;

  // 遍历目录
  FR := FindFirst(Dir + '\*', faDirectory, F);
  try
    while FR = 0 do
    begin
      if FStop then Exit;
    
      if (F.Name <> '.') and (F.Name <> '..') then
      begin
        Result := SearchDir(Dir + F.Name);
        if Result <> '' then Exit;
      end;
      FR := FindNext(F);
    end;
  finally
    FindClose(F);
  end;
  Result := '';
end;

procedure TSearchGameForm.StartButtonClick(Sender: TObject);
begin
  FFindFileName := '';
  FStop := False;
  FCount := 0;
  FFindFileName := SearchDir(GetDriver);
  if FStop then
    ShowMessage('用户终止搜索。')
  else if FFindFileName = '' then
    ShowMessage('没有找到文件，只能人工指定！')
  else
    ModalResult := mrOK;
end;

procedure TSearchGameForm.StopButtonClick(Sender: TObject);
begin
  FStop := True;
end;

procedure TSearchGameForm.SetGameName(const Name: string);
begin
  GameNameEdit.Text := Name;
end;

procedure TSearchGameForm.SetSearchFiles(const Files: string);
begin
  FilesEdit.Text := Files;
  FSearchFileList.Delimiter := ',';
  FSearchFileList.DelimitedText := Files;
end;

function TSearchGameForm.GetDriver: string;
begin
  Result := DriveComboBox1.Drive + ':';
end;

function TSearchGameForm.GetFindFileName: string;
begin
  Result := FFindFileName;
end;

end.