unit pub;

interface


uses windows, sysutils, dialogs, classes, registry, Messages, FileCtrl;

const
   ROOT_KEY = HKEY_LOCAL_MACHINE;
   ROOT_PATH = '\SOFTWARE\TSa\Temp';

   WM_RegDebug       = WM_User + 1;
   WM_Debug          = WM_User + 2;
   WM_ChildClose     = WM_User + 3;       // LParam == 0=Alarmlog 1=Errorlog
   WM_Thread_Running = WM_User + 4;       // WParam = Sensor count, lParam=2 running and new found 1= running 0=stopped
   WM_TempNotify     = WM_User + 5;       // wParam = Sensor lParam=temp*100
   WM_AvgTempNotify  = WM_User + 6;       // wParam = Sensor lParam=Averagetemp*100
   WM_AlarmNotify    = WM_User + 7;       // wParam = Sensor lParam= 2=High 1=Low 0=No alarm
   WM_AlarmReNotify  = WM_User + 8;
   WM_NoAlarms       = WM_User + 9;
   WM_SlopeNotify    = WM_User + 10;      //WParam=Sensor LParam=Type; 0=End, 1=Falling 2=Raising
   WM_ErrorNotify    = WM_User + 11;      //WParam=Sensor  LParam= error
   WM_LanguageChanged = WM_User + 12;     //Language changed
   WM_SavePosition   = WM_User + 13;      //Mainform closing, LParam = child index
   WM_SaveImage      = WM_User + 14;      //Save jpeg or bmp image
   WM_PollNotify     = WM_User + 15;      //LParam=Thread polling status 1=started 0=finished
   WM_Callback       = WM_User + 100;
   WM_MYHIDE         = WM_User + 101;

   LOG_FILE = '.\LOG.TXT';
   MAX_LOG_LINES = 1000;
   MAX_ALARM_LINES = 100;

type
   pData = ^TData;
   TData = record
      tdTime : TDateTime;
      fTemp  : Double;
   end;

procedure LogAdd(LogText : String);
procedure AddLog(LogText : String; LogFile : String; iMaxLines : Integer);
function AppendToFile (const fname, s : String) : Integer;
function GetDataPath(DateOfData : TDateTime): String;

//*******

function OpenRegistry (const subkey, sensor : String; CanCreate : Boolean): TRegistry;
function RegGetString (const subkey, sensor, valuename : String): String;
function RegGetInt    (const subkey, sensor, valuename : String; Default : Integer): Integer;
function RegGetBool   (const subkey, sensor, valuename : String): Boolean;
procedure RegPutString(const subkey, sensor, valuename : String; value : String);
procedure RegPutInt   (const subkey, sensor, valuename : String; value : Integer);
procedure RegPutBool  (const subkey, sensor, valuename : String; value : Boolean);
procedure RegGetSensorNames  (List : TStringList);
procedure RegGetKeyOrValueNames (const Key : String; List : TStringList; KeyNames : Boolean);
procedure RegDeleteValue (const Key, valuename : String);
procedure RegDeleteKey(const subkey, sensor : String);
function RegGetFloat (const subkey, sensor, valuename : String; Default : Double) : Double;
procedure RegPutFloat (const subkey, sensor, valuename : String; value : Double);
procedure RegMoveKey (const oldkey, newkey : String);
procedure SaveWindowPos(iHandle : THandle; indx : Integer);
procedure GetFiles (const sExt, sDir : String; List : TStringList; bInclExt : Boolean);

implementation

function OpenRegistry (const subkey, sensor : String; CanCreate : Boolean): TRegistry;
var sRoot : String;
begin
   sRoot := ROOT_PATH + '\' + subkey;
   if sensor <> '' then
      sRoot := sRoot + '\' + sensor;

   result := TRegistry.Create(KEY_READ or KEY_WRITE);
   result.RootKey := ROOT_KEY;
   result.OpenKey(sRoot,CanCreate);
end;

function RegGetString (const subkey, sensor, valuename : String) : String;
var reg : TRegistry;
begin
   result := '';
   reg := OpenRegistry(subkey, sensor,FALSE);
   try
      result := reg.ReadString(valuename);
      reg.CloseKey;
      reg.Free;
   except
      reg.Free;
   end;
end;

procedure RegPutString (const subkey, sensor, valuename : String; value : String);
var reg : TRegistry;
begin
   reg := OpenRegistry(subkey, sensor,TRUE);
   try
      reg.WriteString(valuename,value);
      reg.CloseKey;
      reg.Free;
   except
      reg.Free;
   end;
end;


function RegGetInt (const subkey, sensor, valuename : String; Default : Integer) : Integer;
var reg : TRegistry;
begin
   result := Default;
   reg := OpenRegistry(subkey, sensor,FALSE);
   try
      result := reg.ReadInteger(valuename);
      reg.CloseKey;
      reg.Free;
   except
      reg.Free;
   end;
end;

procedure RegPutInt (const subkey, sensor, valuename : String; value : Integer);
var reg : TRegistry;
begin
   reg := OpenRegistry(subkey, sensor,TRUE);
   try
      reg.WriteInteger(valuename,value);
      reg.CloseKey;
      reg.Free;
   except
      reg.Free;
   end;
end;

function RegGetFloat (const subkey, sensor, valuename : String; Default : Double) : Double;
var reg : TRegistry;
begin
   result := Default;
   reg := OpenRegistry(subkey, sensor,FALSE);
   try
      result := reg.ReadFloat(valuename);
      reg.CloseKey;
      reg.Free;
   except
      reg.Free;
   end;
end;

procedure RegPutFloat (const subkey, sensor, valuename : String; value : Double);
var reg : TRegistry;
begin
   reg := OpenRegistry(subkey, sensor,TRUE);
   try
      reg.WriteFloat(valuename,value);
      reg.CloseKey;
      reg.Free;
   except
      reg.Free;
   end;
end;

function RegGetBool (const subkey, sensor, valuename : String): Boolean;
var reg : TRegistry;
begin
   result := FALSE;
   reg := OpenRegistry(subkey, sensor,FALSE);
   try
      result := reg.ReadBool(valuename);
      reg.CloseKey;
      reg.Free;
   except
      reg.Free;
   end;
end;

procedure RegPutBool (const subkey, sensor, valuename : String; value : Boolean);
var reg : TRegistry;
begin
   reg := OpenRegistry(subkey, sensor,TRUE);
   try
      reg.WriteBool(valuename,value);
      reg.CloseKey;
      reg.Free;
   except
      reg.Free;
   end;
end;

procedure RegGetSensorNames (List : TStringList);
var reg : TRegistry;
    slKeyList : TStringList;
    i : Integer;
begin
   List.Clear;
   reg := OpenRegistry('Sensors', '',FALSE);
   slKeyList := TStringList.Create;
   slKeyList.Sorted := TRUE;
   try
      slKeyList.Clear;
      try
         reg.GetKeyNames(slKeyList);
         reg.CloseKey;
         reg.Free;
      except
         reg.Free;
      end;
      for i := 1 to slKeyList.Count do
         List.Add(RegGetString('Sensors',IntToStr(i),'Name'));
   finally
      slKeyList.Free;
   end;
end;


procedure RegGetKeyOrValueNames (const Key : String; List : TStringList; KeyNames : Boolean);
var reg : TRegistry;
begin
   reg := OpenRegistry(Key, '',FALSE);
   try
      if KeyNames then
         reg.GetKeyNames(List)
      else
         reg.GetValueNames(List);
      reg.CloseKey;
      reg.Free;
   except
      reg.Free;
   end;
end;


procedure RegDeleteValue (const Key, valuename : String);
var reg : TRegistry;
begin
   reg := OpenRegistry(Key, '',TRUE);
   try
      reg.DeleteValue(valuename);
      reg.CloseKey;
      reg.Free;
   except
      reg.Free;
   end;
end;

procedure RegDeleteKey (const subkey, sensor : String);
var reg : TRegistry;
    i   : Integer;
    values : TStringList;
begin
   reg := OpenRegistry(subkey, sensor, FALSE);
   values := TStringList.Create;
   try
      reg.GetValueNames(values);

      for i:=0 to values.Count-1 do
         reg.DeleteValue(values.Strings[i]);

      reg.DeleteKey(ROOT_PATH+'\'+subkey+'\'+sensor);

      reg.CloseKey;
      reg.Free;
      values.Free;
   except
      reg.Free;
      values.Free;
   end;
end;

procedure RegMoveKey (const oldkey, newkey : String);
var reg : TRegistry;
begin
   reg := OpenRegistry(oldkey, '', FALSE);
   try
      reg.MoveKey(oldkey, newkey, TRUE);
      reg.Free;
   except
      reg.Free;
   end;
end;

function GetDataPath(DateOfData : TDateTime): String;
var sDataPath : String;
begin
   sDataPath := RegGetString('General','','DataPath');

   if DateOfData <> 0 then
      result := sDataPath+FormatDateTime('yyyy\mm\dd\',DateOfData)
   else
      result := sDataPath;
end;


procedure SaveWindowPos(iHandle : THandle; indx : Integer);
var wp : PWindowPlacement;
    iWidth,
    iHeight : Integer;
begin
   GetMem(wp,SizeOf(TWindowPlacement));
   try
      wp^.Length := SizeOf(TWindowPlacement);
      if GetWindowPlacement(iHandle,wp) then
      begin
         case indx of
            -2 : RegPutInt('Windows','0','AppState',0);
            -1 : RegPutInt('Windows','0','AppState',wp^.showCmd);
         else
               begin
                  RegPutInt('Windows',IntToStr(indx),'Top',wp^.rcNormalPosition.Top);
                  RegPutInt('Windows',IntToStr(indx),'Left',wp^.rcNormalPosition.Left);
                  iWidth := wp^.rcNormalPosition.Right - wp^.rcNormalPosition.Left;
                  RegPutInt('Windows',IntToStr(indx),'Width',iWidth);
                  iHeight := wp^.rcNormalPosition.Bottom - wp^.rcNormalPosition.Top;
                  RegPutInt('Windows',IntToStr(indx),'Height',iHeight);
                  RegPutInt('Windows',IntToStr(indx),'State',wp^.showCmd);
               end;
         end;
      end;
   finally
      FreeMem(wp,SizeOf(TWindowPlacement));
   end;
end;


procedure GetFiles (const sExt, sDir : String; List : TStringList; bInclExt : Boolean);
// Get names of files in a directory sDir haveing extension sExt
var   sr: TSearchRec;
begin
   List.Clear;
   if FindFirst(sDir+'\*.'+sExt , faAnyfile, sr) = 0 then
   begin
      if bInclExt then
         List.Add(sr.Name)
      else
         List.Add(Copy(sr.Name,1,Pos('.',sr.Name)-1));
      while FindNext(sr) = 0 do
      begin
         if bInclExt then
            List.Add(sr.Name)
         else
            List.Add(Copy(sr.Name,1,Pos('.',sr.Name)-1));
      end;
      FindClose(sr);
   end;
end;


procedure LogAdd (LogText : String);
begin
   AddLog(LogText, LOG_FILE, MAX_LOG_LINES);
end;


procedure AddLog(LogText : String; LogFile : String; iMaxLines : Integer);
var dtNow : TDateTime;
    sl    : TStringList;
    bOK   : Boolean;
    iCnt  : Integer;
begin
   dtNow := now;
   sl := TStringList.Create;
   try
      sl.Sorted := FALSE;
      if FileExists(LogFile) then
         sl.LoadFromFile(LogFile);
      sl.Add(FormatDateTime('dd.mm.yyyy hh:nn:ss ',dtNow)+LogText);

      //Keep only MAX_LOG_LINES
      while sl.Count > iMaxLines do
         sl.Delete(0);
      iCnt := 0;
      repeat
         try
            sl.SaveToFile(LogFile);
            bOK := TRUE;
         except
            bOK := FALSE;
            sleep(100);
            Inc(iCnt);
            if iCnt > 100 then
	         begin
               ShowMessage('AddLog failed. File:'+LogFile);
               bOK := TRUE;
            end;
         end;
      until bOK;
   finally
      sl.Free;
   end;
end;

function AppendToFile (const fname, s : String) : Integer;
{
 Append string to a file. If file does not exist, it will be created
}
var fnum : TextFile;
    sPath : String;
begin
try
   result := 0;
   if s <> '' then
   begin
      Assign (fnum,fname);
      {$I-}
      Append (fnum);
      {$I+}
      result := IOResult;
      if result <> 0 then
      begin
         sPath := ExtractFileDir(fname);
         if (sPath <> '') and not DirectoryExists(sPath) then
            ForceDirectories(sPath);
         {$I-}
         ReWrite(fnum);
         {$I+}
         result := IOResult;
      end;
      Writeln (fnum,s);
      Flush (fnum);
      Close (fnum);
   end;
except

end;
end;

end.
