[Delphi]：解决3DMark闪退及3DMark宕的问题
2024-05-14 07:21:00
为了解决一些3DMark的问题，例如闪退，跑的过程中3DMark程序无响应的。于是就想个办法实现解决这两个问题，也算是下SW workaround的吧。避免不必要的麻烦~
unit main;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls, TlHelp32, ExtCtrls, ComCtrls, Gauges, IniFiles;typeTForm1 = 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;varForm1: 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;
varSI: 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;
beginosVer.dwOSVersionInfoSize := Sizeof(TOSVERSIONINFO);GetVersionEX(osVer);if osVer.dwPlatformId = VER_PLATFORM_WIN32_NT thenbegin//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);endelseCreatePipe(hReadPipe, hWritePipe, nil, 1024);tryFillChar(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) thenbeginExitCode := 0;while ExitCode = 0 dobeginwrResult := WaitForSingleObject(PI.hProcess, 500);if PeekNamedPipe(hReadPipe, @Dest[0], 1024, @Avail, nil, nil) thenbeginif Avail > 0 thenbeginTmpList := TStringList.Create;tryFillChar(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);finallyTmpList.Free;end;end;end;if wrResult <> WAIT_TIMEOUT then ExitCode := 1;end;GetExitCodeProcess(PI.hProcess, ExitCode);CloseHandle(PI.hProcess);CloseHandle(PI.hThread);end;finallyCloseHandle(hReadPipe);CloseHandle(hWritePipe);end;//Form1.Memo1.Lines.Append('Thread exit!');
end;function Run3DMarkThread():string;stdcall;
varbefore: DWORD;after: DWORD;
beginwhile True do beginbefore:=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;
constPROCESS_TERMINATE = $0001;
beginResult := 0;FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);FProcessEntry32.dwSize := SizeOf(FProcessEntry32);ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);while Integer(ContinueLoop) <> 0 dobeginif ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =UpperCase(ExeFileName))) thenResult := Integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE,BOOL(0),FProcessEntry32.th32ProcessID),0));ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;CloseHandle(FSnapshotHandle);
end;procedure TForm1.Timer1Timer(Sender: TObject);
varlefttime: Integer;
beginLefttime:=StrToInt(Edit1.Text);Inc(Elatime);lefttime:=lefttime-Elatime;Edit2.Text:= IntToStr(Elatime);Edit3.Text:=IntToStr(lefttime);Gauge1.Progress:=Elatime;if lefttime < 1 then beginEndProcess('3DMarkICFDemo.exe');EndProcess('3DMarkCmd.exe');Application.Terminate;end;
end;procedure TForm1.FormCreate(Sender: TObject);
Varcfgfile: 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 begininifile:=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);
varProcessName : string;ProcessID : Integer;
beginFSnapshotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);FProcessEntry32.dwSize:=Sizeof(FProcessEntry32);ContinueLoop:=Process32First(FSnapshotHandle,FProcessEntry32);while ContinueLoop dobeginProcessName := FProcessEntry32.szExeFile;ProcessID := FProcessEntry32.th32ProcessID;if(ProcessName='3DMarkICFDemo.exe') then beginif ProcessID=LastProcessID then beginEndProcess('3DMarkICFDemo.exe');EndProcess('3DMarkCmd.exe');Memo1.Lines.add('Process Name: '+ProcessName +' Killed with #' + inttostr(LastProcessID));endelse beginLastProcessID:=ProcessID;Memo1.Lines.add('Process Name: '+ProcessName +' -> ProcessID: '+ inttostr(ProcessID));end;end;ContinueLoop:=Process32Next(FSnapshotHandle,FProcessEntry32);end;
end;procedure TForm1.WMSysCommand(var Msg: TWMSysCommand);
beginif (Msg.CmdType=SC_CLOSE ) thenbeginShowMessage('Please DO NOT close TESTING Window');end ;
end;end.
[Delphi]：解决3DMark闪退及3DMark宕的问题相关推荐
- 解决eclipse闪退的办法
2019独角兽企业重金招聘Python工程师标准>>> 解决eclipse闪退的办法 博客分类: 异常 系统安装了两个eclipse,一个是Eclipse sdk3.2,另一个是Ec ...
- 天堂2 mysql一闪而过_天堂2革命闪退怎么办_天堂2革命彻底解决游戏闪退方法_手心游戏...
天堂2革命闪退怎么解决?有玩家反馈玩天堂2革命出现黑屏闪退现象,进入游戏先是黑屏然后直接闪退,针对此问题下面小编就为大家带来天堂2革命黑屏闪退的解决方法,有被黑屏闪退困扰的小伙伴们来看看吧. < ...
- 历史经验之解决vMix22闪退的办法（亲测管用）
历史经验之解决vMix22闪退的办法(亲测管用) #vMix22闪退# #vmix# 试下面方法: 参考链接:https://blog.csdn.net/weixin_41486034/article ...
- 解决VS2010闪退问题
解决VS2010闪退问题 在开发VB.net时,可以正常打开VS2010,可以正常添加控件,当开始编写程序时,VS2010软件会闪退,有以下解决方案: ①VS2010 缺失相关文件,解决方法:通过添加 ...
- Xilinx ISE 14.7 官方Win10版本安装教程（解决Win10闪退问题）
Xilinx ISE 14.7 官方Win10版本安装教程(解决Win10闪退问题) 说在前面 第一步 官网下载 ISE 14.7 Win10 第二步 安装 第三步 运行程序 第四步 Oracle V ...
- 微信 android 闪退问题怎么解决方法,如何解决微信闪退问题 四种解决微信闪退无法登录的原因及方法分享...
微信闪退无法登录怎么办?现在使用微信的用户越来越多,即方便又快捷,有的朋友在使用时候可能会遇到微信闪退无法登陆的情况,今天小编为大家带来了四种解决微信闪退无法登录的原因及方法分享,感兴趣的朋友快来了解 ...
- Ubuntu20.04如何解决QQ闪退问题
Ubuntu20.04如何解决QQ闪退问题(亲测有效) 解决办法(代码) 解决办法(代码) 以下附上QQ官网中对于解决这类办法的原文: 如果版本更新后登录出现闪退情况,请删除 ~/.config/te ...
- 解决Mathtype闪退
安装造字工坊广告字体可导致解决Mathtype闪退 刚买的新电脑,Mathtype直接装上就能完美使用.直到今早某同学拜托我P个海报,我把老电脑里的广告字体往新电脑里全部拷贝过来.P完图以后,Math ...
- jQuery的进行解决layui闪退的问题
情况:点击第一个input 日期,可以正常选择日期,之后点击任何一个,都会闪一下然后消失,无法正常选择:原因:lay-key的值的问题,需要循环重新为lay-key赋值解决:<input typ ...
最新文章
- Linux 运维常用命令 find、awk、sed、grep、vi、ps、lsof、rpm
- Hadoop：HDFS NameNode内存全景
- 餐厅前台php,餐厅前台接听电话技巧
- Mybatis注解实现一对多关联映射(@Many)
- selenium python_Python+Selenium基础入门及实践
- 宠了4年的老婆，说走就走，没有一点情份，你会怎么做
- jvm_垃圾收集算法讲解（二）
- android 11 版本更新内容,android 11怎么更新 android 11更新方法
- 解决Hbuliderx的代码不能自动补全的问题
- 自然语言处理(NLP)资源
- 友图自动排料引擎 V1.0 开发指南
- VC++进行ActiveX控件的开发
- JAVA JSP网上订餐系统JSP餐厅点餐系统源码JSP点餐系统JSP网上订餐系统JSP在线订餐系统
- Android版添加phonegap--美洽客服插件教程
- 微信扫二维码跳转网页链接如何制作
- less混合 + less计算
- 微信小程序分享小程序码的生成，多参数以及参数的获取
- 谁若97岁死，奈何桥上等3年
- 测试狗：冷冻电镜是什么？冷冻电镜技术的应用
- netcore docker for windows build image,push docker hub（linux pull镜像运行容器）