[Delphi]：解决3DMark闪退及3DMark宕的问题

为了解决一些3DMark的问题，例如闪退，跑的过程中3DMark程序无响应的。于是就想个办法实现解决这两个问题，也算是下SW workaround的吧。避免不必要的麻烦~

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, TlHelp32, ExtCtrls, ComCtrls, Gauges, IniFiles;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    Timer1: TTimer;
    Label3: TLabel;
    Edit3: TEdit;
    Memo1: TMemo;
    Gauge1: TGauge;
    Timer2: TTimer;
    Label4: TLabel;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
  private
    { Private declarations }
  public
    { Public declarations }
    function EndProcess(ExeFileName:string):integer;
  end;

var
  Form1: TForm1;
  Elatime: Integer=0;
  hReadPipe: THandle;
  hWritePipe: THandle;
  command1 :String;
  ContinueLoop: BOOLean;
  FSnapshotHandle: THandle;
  FProcessEntry32:TProcessEntry32;
  LastProcessID : Integer=0;
  inifile: Tinifile;

implementation

{$R *.dfm}

function  RunDosCommand(command: String):string;stdcall;
var
  SI: TStartUpInfo;
  PI: TProcessInformation;
  SA: TSecurityAttributes;
//SD: TSecurityDescriptor;
  BytesRead: DWORD;
  Dest: array[0..1023] of char;
  CmdLine: array[0..512] of char;
  TmpList: TStringList;
  Avail, ExitCode, wrResult: DWORD;
  osVer: TOSVERSIONINFO;
  tmpstr: AnsiString;
begin
  osVer.dwOSVersionInfoSize := Sizeof(TOSVERSIONINFO);
  GetVersionEX(osVer);

  if osVer.dwPlatformId = VER_PLATFORM_WIN32_NT then
  begin
  //InitializeSecurityDescriptor(@SD,   SECURITY_DESCRIPTOR_REVISION);
  //SetSecurityDescriptorDacl(@SD,   True,   nil,   False);
    SA.nLength := SizeOf(SA);
    SA.lpSecurityDescriptor := nil; //@SD;
    SA.bInheritHandle := True;
    CreatePipe(hReadPipe, hWritePipe, @SA, 0);
  end
  else
    CreatePipe(hReadPipe, hWritePipe, nil, 1024);
  try
    FillChar(SI, SizeOf(SI), 0);
    SI.cb := SizeOf(TStartUpInfo);
    SI.wShowWindow := SW_HIDE;
    SI.dwFlags := STARTF_USESHOWWINDOW;
    SI.dwFlags := SI.dwFlags or STARTF_USESTDHANDLES;
    SI.hStdOutput := hWritePipe;
    SI.hStdError := hWritePipe;
    StrPCopy(CmdLine, Command1);
    if CreateProcess(nil, CmdLine, nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil, SI, PI) then
    begin
      ExitCode := 0;
      while ExitCode = 0 do
      begin
        wrResult := WaitForSingleObject(PI.hProcess, 500);
        if PeekNamedPipe(hReadPipe, @Dest[0], 1024, @Avail, nil, nil) then
        begin
          if Avail > 0 then
          begin
            TmpList := TStringList.Create;
            try
              FillChar(Dest, SizeOf(Dest), 0);
              ReadFile(hReadPipe, Dest[0], Avail, BytesRead, nil);
              TmpStr := Copy(Dest, 0, BytesRead - 1);
              TmpList.Text := TmpStr;
              //Form1.Memo1.Lines.Append(tmpstr);
            finally
              TmpList.Free;
            end;
          end;
        end;
        if wrResult <> WAIT_TIMEOUT then ExitCode := 1;
      end;
      GetExitCodeProcess(PI.hProcess, ExitCode);
      CloseHandle(PI.hProcess);
      CloseHandle(PI.hThread);
    end;
  finally
    CloseHandle(hReadPipe);
    CloseHandle(hWritePipe);
  end;
  //Form1.Memo1.Lines.Append('Thread exit!');
end;

function Run3DMarkThread():string;stdcall;
var
  before: DWORD;
  after: DWORD;
begin
  while True do begin
    before:=GetTickCount;
    RunDosCommand(command1);
    after:=GetTickCount;
    after:=(after-before) div 1000;
    Form1.Memo1.Lines.Add('This loop cost:'+IntToStr(after)+'s');

    if after < 60 then WinExec('shutdown -r -t 60', SW_HIDE );

    Sleep(1000);
  end;
end;

function TForm1.EndProcess(ExeFileName:string):integer;
const
  PROCESS_TERMINATE = $0001;
begin
    Result := 0;
    FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
    ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);

  while Integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
    UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
    UpperCase(ExeFileName))) then
    Result := Integer(
    TerminateProcess(OpenProcess(PROCESS_TERMINATE,
    BOOL(0),FProcessEntry32.th32ProcessID),0));
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
    CloseHandle(FSnapshotHandle);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  lefttime: Integer;
begin
  Lefttime:=StrToInt(Edit1.Text);
  Inc(Elatime);
  lefttime:=lefttime-Elatime;
  Edit2.Text:= IntToStr(Elatime);
  Edit3.Text:=IntToStr(lefttime);
  Gauge1.Progress:=Elatime;
  if lefttime < 1 then begin
    EndProcess('3DMarkICFDemo.exe');
    EndProcess('3DMarkCmd.exe');
    Application.Terminate;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
Var
  cfgfile: string;
  Tid: DWORD;
begin
  //cfgfile :='c:\Testfile\config\3DMark.ini';
  cfgfile :='.\3DMark.ini';
  Memo1.Clear;
  Label4.Caption:='600';

  command1:='C:\Program Files\UL\3DMark\3DMarkCmd.exe --definition=firestrike_extreme.3dmdef --audio=off --out=3dmark.3dr --loop=1';

  if FileExists(cfgfile) then begin
    inifile:=Tinifile.create(cfgfile);
    command1:=inifile.ReadString('CONFIG', 'cmdline', 'C:\Program Files\UL\3DMark\3DMarkCmd.exe --definition=firestrike_extreme.3dmdef --audio=off --out=3dmark.3dr --loop=1');
    Edit1.Text:=inifile.ReadString('CONFIG', 'runtime', '3600');
    Label4.Caption:=inifile.ReadString('CONFIG', 'timeout', '600');
    inifile.Free;
  end;

  Memo1.Lines.Append('Cmdline: '+command1);
  Edit3.Text:=Edit1.Text;
  Gauge1.MaxValue:=StrToInt(Edit1.Text);
  CreateThread(nil, 0, @Run3DMarkThread, nil, 0, Tid);
  Timer2.Interval:=StrToInt(Label4.Caption)*1000;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
var
  ProcessName : string;
  ProcessID : Integer;
begin
  FSnapshotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  FProcessEntry32.dwSize:=Sizeof(FProcessEntry32);
  ContinueLoop:=Process32First(FSnapshotHandle,FProcessEntry32);
  while ContinueLoop do
  begin
      ProcessName := FProcessEntry32.szExeFile;
      ProcessID := FProcessEntry32.th32ProcessID;

      if(ProcessName='3DMarkICFDemo.exe') then begin
        if ProcessID=LastProcessID then begin
          EndProcess('3DMarkICFDemo.exe');
          EndProcess('3DMarkCmd.exe');
          Memo1.Lines.add('Process Name: '+ProcessName +' Killed with #' + inttostr(LastProcessID));
        end
        else begin
          LastProcessID:=ProcessID;
          Memo1.Lines.add('Process Name: '+ProcessName +' -> ProcessID: '+ inttostr(ProcessID));
        end;
      end;
      ContinueLoop:=Process32Next(FSnapshotHandle,FProcessEntry32);
  end;
end;

procedure TForm1.WMSysCommand(var Msg: TWMSysCommand);
begin
  if (Msg.CmdType=SC_CLOSE ) then
  begin
    ShowMessage('Please DO NOT close TESTING Window');
  end ;
end;

end.