Новичок
Профиль
Группа: Участник
Сообщений: 29
Регистрация: 23.9.2009
Где: Нижний Новгород
Репутация: нет
Всего: нет
|
У меня проект с кучей модулей, нужно определить в каком месте происходит максимальная загрузка процессора. Есть ли какие-нибудь утилиты для тестирования подобных вещей? В проекте происходит постоянный обмен данными как с БД(Oracle) так и с различными драйверами, возможно в этих местах и cpu и грузится? Подскажите хотя бы в каком направлении копать. Привожу фрагмент проекта (ядро системы): | Код |
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs;
procedure ProgStart;
procedure ProgInit;
procedure ProgClose;
procedure ProgConfigureFromDB;
//function CryptDecrypt (var hKey : Integer; var hHash : Integer; Final : Integer; dwFlags : Integer; pbData : PChar; var pdwDataLen : Integer) : Integer; stdcall; external 'advapi32' name 'CryptDecrypt'
implementation
uses Rhf_Core_Srv, Rhf_Core_SrvVar, Rhf_Core_ShrWrapper, Rhf_Core_Type,
DbaseRhf, DaSQLQuery, Tws_Rhf_Type, Rhfserver,
Rhf_Core_ConfCompiler, Rhf_Core_Remoter, Tws_Rhf_SHRStruct,
Rhf_Core_ReaderPLC, Rhf_Core_ThrManager, Rhf_Core_WriterDAS, DB;
// Rhf_Core_Descrambler, Lib_MultiDB, PLReg, SrvKeys, dbtables;
procedure ProgStart;
var StopSrv: boolean;
begin
if RunMode = rmCompile then
begin
// Compile only
Compiler.ExecuteCompile;
Readln;
ProgClose;
Halt(0);
end
else
begin
ProgConfigureFromDB;
// create the share memory (Not used in Compile mode)
try
// Someone changed the zone codification usually applied.
// It needs swapping informations for Marienhutte.
// DG 15/11/05
//if Plant_id = 'MH' then
// SHRWrapper := TMhShrWrapper.Create
//else
SHRWrapper := TShrWrapper.Create;
SHRWrapper.ShrLogProc := Log; // assign log procedure
SHRWrapper.InitShr(ShrMemPath); // try to initialize
if SHRWrapper.Initialized then
begin
Log('Shared memory initialized correctly',0,'ProgInit');
end
else
begin
Log('An error during SHR MEM initialization',0,'ProgInit');
ProgClose;
Halt(4);
end;
except
on E:Exception do
begin
Log('SHRWrapper: ' + E.Message,0,'ProgInit');
ProgClose;
Halt(4); // shared memory initialization error
end;
end;
// PLC init for ReaderPLC
try
Log('PLC initialization...',0,'ProgInit');
if not PLCReader.InitPLC then
begin
Log('PLC initialization failed.',0,'ProgInit');
ProgClose;
Halt(5);
end;
Log('Done.',0,'ProgInit');
except
on E:Exception do
begin
Log('PLCReader: ' + E.Message,0,'ProgInit');
ProgClose;
Halt(5); // PLC connection initialization error
end;
end;
{Start the TCP/IP communications}
try
Remoter := TCoreRemoter.Create;
Remoter.InitServer;
//Remoter.StartComms; // start TCP server
except
on E:Exception do
begin
Log('Remoter: ' + E.Message,0,'ProgInit');
ProgClose;
Halt(6); // PLC connection initialization error
end;
end;
{Start the Threads }
try
if Compiler.ExecuteCompile then {Compile and start the acquisitions }
begin
Compiler.ConfigureThrMan;
if WriterDAS.StartStore then
ThrManager.ResumeAll;
Sleep(1000);
Remoter.StartComms; // start TCP server
if RunMode = rmDebug then
begin
Readln;
ProgClose;
Halt(7);
end;
end
else
raise Exception.Create('Compilation error. Rhf_Core stopped.');
except
on E:Exception do
begin
Log('Compilation - start acquisition: ' + E.Message,0,'ProgInit');
ProgClose;
Halt(7); // compilation & start acquisition initialization error
end;
end;
end;
end;
procedure ProgInit;
var i : integer;
var Buffer, Buffer2, Buffer3: string;
function GetEnvironment(item: string): string;
var
NPtr,RPtr: PChar;
RLen:Integer;
begin
NPtr:= StrNew(PChar(item));
RPtr:= StrAlloc(50);
RLen:= 50;
GetEnvironmentVariable(NPtr,RPtr,RLen);
result:= StrPas(RPtr);
StrDispose(NPtr);
StrDispose(RPtr);
end;
//JH 2006-01-20
function HexToInt(Value: String): Integer;
var Cnt: Integer;
begin
Result := 0;
for Cnt := 1 to Length(Value) do
begin
if Value[Cnt] in ['0'..'9'] then Result := Result * 16 + Ord(Value[Cnt]) - Ord('0');
if Value[Cnt] in ['A'..'F'] then Result := Result * 16 + Ord(Value[Cnt]) - Ord('A') + 10;
end
end;
begin
// Get the RHFOPT_DIR evironment variable (main project directory)
RootPath := GetEnvironment(ENV_ROOT_DIR);
SeverityL := 10; // log everythink
if (RootPath = '') or (not DirectoryExists(RootPath)) then
begin
Writeln('!!! FATAL ERROR !!!');
Writeln('RHFOPT_DIR environment variable not found or invalid.');
Writeln('Please, set it and when run again Rhf_Core.');
Writeln('If the problem persists, contact your system administrator.');
Readln;
Halt(2); // environment variable not properly configured
end;
try
XMLconfig := LoadServerConf(RootPath + '\Rhfserver.xml');
// prepare all the important paths
ShrMemPath := XMLconfig.Paths.Shr_Mem;
DASFilePath := XMLconfig.Paths.DASfile;
LogFilePath := XMLconfig.Paths.Log;
// initialize the logger
LogInitilization(LogFilePath, XMLconfig.Core.DasBckDays);
DisplayCopyright;
Log('Log file initialization done.',0,'ProgInit');
// estabilish connection to the DB server
for i := 1 to Length(XMLconfig.General.DbPwd) do
begin
Buffer := Buffer + Char(XMLconfig.General.DbPwd[i]);
end;
{//To crypt
i := 1;
while i <= Length(Buffer) do
begin
Buffer[i] := Char(Ord(Buffer[i]) - Ord('a'));
i := i + 1;
end;
for i := 1 to Length(Buffer) do
begin
Buffer2 := Buffer2 + IntToHex(Integer(Buffer[i]),2);
end;}
i := 1;
while i <= Length(Buffer) do
begin
Buffer3 := Buffer3 + Char(HexToInt(Buffer[i]+Buffer[i+1]));
i := i + 2;
end;
i := 1;
while i <= Length(Buffer3) do
begin
Buffer3[i] := Char(Ord(Buffer3[i]) + Ord('a'));
i := i + 1;
end;
DB_Connected := DbmsLogin(Dbms1
,XMLconfig.General.DbConnStr //'pc011:1521:ftlp92'
,XMLconfig.General.DbUser
,Buffer3 //XMLconfig.General.DbPwd
,3);
if not DB_Connected then
begin
Log('DB login fail ',0,'ProgInit');
Halt(3); // database connection error
end;
Plant_id := XMLconfig.General.PlantId;
Log('Plant_ID setted to: ' + Plant_id,0,'ProgInit');
DbmsDBSwitch(Dbms1);
except
on E:Exception do
begin
Log('Initialization error:'+ E.Message,0,'ProgInit');
ProgClose;
Halt(3); // database connection error
end;
end;
end;
procedure ProgClose;
begin
if RunMode <> rmCompile then
begin
{ Destroy the TCP/IP server }
try
if Remoter <> nil then
FreeAndNil(Remoter);
except
on E:Exception do
begin
Log('Destroing Remoter: ' + E.Message,0,'ProgClose');
end;
end;
{ Destroy the acquisition threads }
try
if ThrManager <> nil then
FreeAndNil(ThrManager); // automatically stop all threads
except
on E:Exception do
begin
Log('Destroing ThrManager: ' + E.Message,0,'ProgClose');
end;
end;
{ Stop the DAS file acquisition - Destruction is made in own unit }
try
if WriterDAS <> nil then
WriterDAS.StopStore;
except
on E:Exception do
begin
Log('Destroing WriterDAS: ' + E.Message,0,'ProgClose');
end;
end;
end;
if SHRWrapper <> nil then
begin
FreeAndNil(SHRWrapper);
end;
if DB_Connected then
begin
Dbms1.Close;
DB_Connected := False;
end;
Log('Program Closed',0,'ProgClose');
end;
procedure ProgConfigureFromDB;
begin
{ Retrive from XML file "Rhfserver.xml" the general configuration parameters }
try
DASDayBck := XMLconfig.Core.DasBckDays;
Log(Format('Set: DAS backup days = %d',[DASDayBck]), 0, 'ProgConfigureFromDB');
DASfileHour := XMLconfig.Core.DasDurHours;
Log(Format('Set: DAS file duration = %dh',[DASfileHour]), 0, 'ProgConfigureFromDB');
SwapFloat := XMLconfig.Core.SwapFloat;
Log(Format('Set: Swap float flag = %d',[SwapFloat]), 0, 'ProgConfigureFromDB');
SwapLongInt := XMLconfig.Core.SwapLongInt;
Log(Format('Set: Swap Longint flag = %d',[SwapLongInt]), 0, 'ProgConfigureFromDB');
SendOPTfl := XMLconfig.Core.SendOpt;
Log(Format('Set: Send OPT SPs flag = %d',[SendOPTfl]), 0, 'ProgConfigureFromDB');
MoveEvnfl := XMLconfig.Core.MoveEvents;
Log(Format('Set: Movement event flag= %d',[MoveEvnfl]), 0, 'ProgConfigureFromDB');
EnableWD := XMLconfig.Core.EnableWD;
Log(Format('Set: Enable WD flag = %d',[EnableWD]), 0, 'ProgConfigureFromDB');
except
on E:Exception do
begin
Log('Configuring: ' + E.Message,0,'ProgConfigureFromDB');
ProgClose;
Halt(3); // database connection error
end;
end;
end.
|
end; |
Грузит процессор 
Загрузка ...
