📄 uthdthread.~pas
字号:
unit uthdthread;
interface
uses
Classes,sysutils,windows;
type
TTHDThread = class(TThread)
private
{ Private declarations }
protected
TotalSize,TotalTime :DWord;
strlist :TStringlist;
imaxspeed,iminspeed,iavrspeed :integer;
procedure Execute; override;
procedure TestDriver(Driver :Char;IsRepeat:boolean);
procedure WriteAFile(filename :string;blocksize:integer;filesize:integer);
procedure UpdateSpeedInfo;
procedure AddTestInfo;
public
IsTest :boolean;
Driver:char;
IsRepeat:boolean;
iBlockSize,iFileSize:integer;
hfile :THandle;
end;
implementation
uses umain;
{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure TTHDThread.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }
{ TTHDThread }
procedure TTHDThread.AddTestInfo;
begin
main.memo1.Lines.Add(datetimetostr(now())+':');
main.memo1.Lines.Add('平均速度:'+inttostr(iAvrSpeed));
main.memo1.Lines.Add('最大速度:'+inttostr(iMaxSpeed));
main.memo1.Lines.Add('最小速度:'+inttostr(iMinSpeed));
main.memo1.Lines.Add('');
end;
procedure TTHDThread.Execute;
begin
{ Place thread code here }
strlist := TStringlist.Create;
while true do
begin
if terminated then break;
if IsTest then
begin
TestDriver(Driver,IsRepeat);
end;
Sleep(5000);
end;
strlist.Clear;
strlist.Free;
end;
procedure TTHDThread.TestDriver(Driver: Char; IsRepeat: boolean);
var
speed :integer;
startTick,EndTick:DWord;
count,i :integer;
dwdiskfree :int64;
filename :string;
begin
repeat
TotalSize := 0;
TotalTime := 0;
imaxspeed := 0;
iminspeed := 160;
iavrspeed := 0;
dwdiskfree := DiskFree(ord(driver) -ord('a')+1);
dwDiskfree := dwDiskFree div 1024 div 1024;
count := dwDiskFree div iFileSize;
for i := 0 to count - 1 do
begin
if not IsTest then
break;
starttick := gettickcount();
filename := driver+':\'+formatdatetime('yymmddh24mnss',now())+'.hdt';
WriteAFile(filename,iBlockSize,iFileSize);
strlist.Add(filename);
endtick := gettickcount();
speed := iFileSize div ((endtick-starttick)div 1000);
if speed > imaxspeed then imaxspeed := speed;
if Speed < iMinSpeed then iMinspeed := speed;
TotalSize := TotalSize + iFileSize;
TotalTime := TotalTime + ((endtick-starttick) div 1000);
iAvrSpeed := TotalSize div TotalTime ;
Synchronize(UpdateSpeedInfo);
if not IsTest then
break;
end;
Synchronize(AddTestInfo);
for i := 0 to strlist.Count - 1 do
begin
deletefile(pchar(strlist.Strings[0]));
strlist.Delete(0);
end;
until (IsTest and not IsRepeat) or (not IsTest)
end;
procedure TTHDThread.UpdateSpeedInfo;
begin
main.MaxSpeed := iMaxspeed;
main.MinSpeed := iminspeed;
main.AvrSpeed := iavrspeed;
end;
procedure TTHDThread.WriteAFile(filename: string; blocksize,
filesize: integer);
var
buf :array of char;
wrtnlen :dword;
len :dword;
i :integer;
count :integer;
begin
try
hfile := CreateFile(pchar(filename),GENERIC_WRITE,FILE_SHARE_READ ,nil,CREATE_ALWAYS,
FILE_ATTRIBUTE_ARCHIVE,0);
count := filesize*1024 div blocksize;
len := 1024*blocksize;
SetLength(Buf,len);
FillMemory(buf,len,random(255));
for i := 0 to count - 1 do
begin
if not IsTest then
break;
WriteFile(hfile,buf[0],len,wrtnlen,nil);
if not IsTest then
break;
end;
finally
closehandle(hfile);
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -