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

📄 uthdthread.~pas

📁 硬盘测速软件,可以测试硬盘的读写速度,也可以测试硬盘性能.能够测试不同的文件块大小,文件大小,能够循环测试
💻 ~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 + -