CPU hızını öğrenme-02

functionRDTSC:Int64;assembler;

asm

db$0F,$31

end;

functionRDQPC:Int64;

begin

QueryPerformanceCounter(result);

end;

functionCPUSpeed:Integer;

varf,tsc,pc:Int64;

begin

ifQueryPerformanceFrequency(f)thenbegin

Sleep(0);

pc:=RDQPC;

tsc:=RDTSC;

Sleep(100);

pc:=RDQPC-pc;

tsc:=RDTSC-tsc;

result:=round(tsc*f/(pc*1000000));end

elseresult:=-1;

end;

procedureTForm1.Button1Click(Sender:TObject);

begin

label1.caption:=Format('%dMhz',[CPUSpeed]);

end;end.

CPU hızını öğrenme-01

functionGetCPUSpeed:Double;

const

DelayTime=500;//measuretimeinms

var

TimerHi,TimerLo:DWORD;

PriorityClass,Priority:Integer;

begin

PriorityClass:=GetPriorityClass(GetCurrentProcess);

Priority:=GetThreadPriority(GetCurrentThread);

SetPriorityClass(GetCurrentProcess,REALTIME_PRIORITY_CLASS);

SetThreadPriority(GetCurrentThread,THREAD_PRIORITY_TIME_CRITICAL);

Sleep(10);

asm

dw 310Fh

mov TimerLo,eax

mov TimerHi,edx

end;

Sleep(DelayTime);

asm

dw310Fh

sub eax,TimerLo

sbbedx,TimerHi

movTimerLo,eax

movTimerHi,edx

end;

SetThreadPriority(GetCurrentThread,Priority);

SetPriorityClass(GetCurrentProcess,PriorityClass);

Result:=TimerLo/(1000.0*DelayTime);

end;

//Tousethisfunction,write:Caption:=Format('%fMHz',[GetCPUSpeed]);

CPU frekansının alınması

functionRDTSC:Int64;assembler;

asm

db$0F,$31//opcodeforRDTSC

end;

functionRDQPC:Int64;

begin

QueryPerformanceCounter(result);

end;

functionCPUSpeed:Integer;

var

f,tsc,pc:Int64;

begin

ifQueryPerformanceFrequency(f)then

begin

Sleep(0);

pc:=RDQPC;

tsc:=RDTSC;

Sleep(100);

pc:=RDQPC-pc;

tsc:=RDTSC-tsc;

result:=round(tsc*f/(pc*1000000));

end

else

result:=-1;

end;

//Kullanimi:

procedureTForm1.Button1Click(Sender:TObject);

begin

label1.caption:=Format('%dMhz',[CPUSpeed]);

end;

CPU kullanım durumunu öğrenme

unit Unit1;interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, CommCtrl, StdCtrls, Menus,WinSpool, ExtCtrls, Buttons, Registry;

type

TForm1 = class(TForm)

Button1: TButton;Label1: TLabel;Label2: TLabel;Timer1: TTimer;

Button2: TButton;procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

private{ Private declarations }

started : boolean;

reg : TRegistry;

public { Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

var Dummy : array[0..1024] of byte;

begin // Stats started by Button1 hit

Reg:=TRegistry.Create;

Reg.RootKey:=HKEY_DYN_DATA; // Statistic data is saved under this topic

{ Before starting retrieving statistic data you have to query the appropiate key under 'PerfStats\StartStat'. }

Reg.OpenKey

('PerfStats\StartStat',false); // Open this key first to start collecting performance data Reg.ReadBinaryData('KERNEL\CPUUsage',Dummy,Sizeof(Dummy));

Reg.CloseKey;started:=true;end;

procedure TForm1.Timer1Timer(Sender: TObject);

var CPUU : integer;

begin

{ After starting the collection of statistic data, you can retrieve the recent value under the 'PerfStats\StatData' key. This is done by a timer event in this example }

if started then begin

Reg.OpenKey

('PerfStats\StatData',false); // Open extension kex for txt files Reg.ReadBinaryData('KERNEL\CPUUsage',CPUU,SizeOf(Integer));

Reg.CloseKey;Label1.Caption:=IntToStr(CPUU)+'%';end;end;

procedure TForm1.Button2Click(Sender: TObject);

var Dummy : array[0..1024] of byte;

begin

// Button2 hit stops statistic collection { Collecting statistic data is stopped by a query under 'PerfStats/StopStat' }

Reg.OpenKey

('PerfStats\StopStat',false); // Open this key first to start collecting performance data

Reg.ReadBinaryData

('KERNEL\CPUUsage',Dummy,SizeOf(Dummy));

Reg.Free;Started:=false;end; end.

Copy-Delete-Move Function

Uses ShellApi;

function CopyDir(const fromDir, toDir: string): Boolean;

var   fos: TSHFileOpStruct;

begin

ZeroMemory(@fos, SizeOf(fos));

with fos do  begin

wFunc  := FO_COPY;

fFlags := FOF_FILESONLY;

pFrom  := PChar(fromDir + #0);

pTo    := PChar(toDir)

end;

Result := (0 = ShFileOperation(fos));

end;

function MoveDir(const fromDir, toDir: string): Boolean;

var   fos: TSHFileOpStruct;

begin

ZeroMemory(@fos, SizeOf(fos));

with fos do  begin

wFunc  := FO_MOVE;

fFlags := FOF_FILESONLY;

pFrom  := PChar(fromDir + #0);

pTo    := PChar(toDir)

end;

Result := (0 = ShFileOperation(fos));

end;

function DelDir(dir: string): Boolean;

var   fos: TSHFileOpStruct;

begin

ZeroMemory(@fos, SizeOf(fos));

with fos do  begin

wFunc  := FO_DELETE;

fFlags := FOF_SILENT or FOF_NOCONFIRMATION;

pFrom  := PChar(dir + #0);

end;

Result := (0 = ShFileOperation(fos));

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

if cCopyDir('d:\download', 'e:\') = True then

ShowMessage('Directory copied.');

end;