mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-11 22:45:39 +02:00
945 lines
24 KiB
ObjectPascal
945 lines
24 KiB
ObjectPascal
unit U_ProtRutin;
|
|
|
|
interface
|
|
uses Controls, Forms,Windows, classes, SysUtils, registry, extctrls, Dialogs, U_Main;
|
|
|
|
type
|
|
|
|
TTrialBaseInfo = record
|
|
FirstRun: string[100];
|
|
LastRun: string[100];
|
|
NumberRunTr: integer;
|
|
end;
|
|
|
|
PTrialBaseInfo = ^TTrialBaseInfo;
|
|
|
|
TTimers = class(TObject)
|
|
procedure Timer1Timer(Sender: TObject);
|
|
procedure Timer2Timer(Sender: TObject);
|
|
private
|
|
{ Private declarations }
|
|
public
|
|
{ Public declarations }
|
|
end;
|
|
|
|
procedure GetAllCurrentDateTr;
|
|
procedure SetAllLastDateTr;
|
|
procedure GetAllFirstDateTr;
|
|
procedure SetAllFirstDateTr;
|
|
procedure SetAllFirstDateTr1;
|
|
procedure GetBaseLastDateTr;
|
|
procedure SetBaseLastDateTr;
|
|
procedure GetBaseFirstDateTr;
|
|
procedure SetBaseFirstDateTr;
|
|
procedure GetRegFirstDateTr;
|
|
procedure SetRegFirstDateTr;
|
|
procedure GetRegLastDateTr;
|
|
procedure SetRegLastDateTr;
|
|
procedure GetFileFirstDateTr;
|
|
procedure GetFileLastDateTr;
|
|
function IsFirstRunTr: boolean;
|
|
function IsAllOkTr: boolean;
|
|
function IsTrialPeriodEndTr: boolean;
|
|
function IsMayRunTr: boolean;
|
|
function GetFileNameTr: string;
|
|
procedure CreateFileTr;
|
|
function GetNumRunTr: integer;
|
|
procedure IncNumRunTr;
|
|
procedure SetNumRunTr;
|
|
procedure EmptySLSTr;
|
|
|
|
procedure LogAllDate;
|
|
procedure GetBaseInfo;
|
|
procedure SetBaseNumRun(incremental: boolean = False);
|
|
|
|
{$IF Defined(TRIAL_SCS) or Defined(PROCAT_SCS)}
|
|
function GetAllDate: string;
|
|
{$IFEND}
|
|
|
|
const
|
|
EndPeriod = '!êåòñè ûììàðãîðï àêîðñ îãîíüëåòàòûïñè ûòîáàð äîèðåÏ';
|
|
{$IF Defined(PROCAT_SCS)}
|
|
{$IF Defined(TRIAL_SCS)}
|
|
{$IF Defined(SCS_PANDUIT)}
|
|
TrialDayTr = 31 XOR $1A;
|
|
TrialRunTr = 119 XOR $2A;
|
|
{$ELSE}
|
|
TrialDayTr = 91 XOR $1A;
|
|
TrialRunTr = 119 XOR $2A;
|
|
{$IFEND}
|
|
{$ELSE}
|
|
TrialDayTr = 31 XOR $1A;
|
|
TrialRunTr = 119 XOR $2A;
|
|
{$IFEND}
|
|
{$ELSE}
|
|
{$IF Defined(SCS_PE)}
|
|
TrialDayTr = 31 XOR $1A;
|
|
TrialRunTr = 99 XOR $2A;
|
|
{$ELSE}
|
|
TrialDayTr = 15 XOR $1A;
|
|
TrialRunTr = 19 XOR $2A;
|
|
{$IFEND}
|
|
{$IFEND}
|
|
|
|
var
|
|
TTimers1: TTimers;
|
|
|
|
BaseInfo: TTrialBaseInfo;
|
|
SystemCurrentDateTr: string; // Date system
|
|
FileCurrentDateTr: string; // Date system
|
|
RegFirstDateTr: string; // Date of first run in registry
|
|
RegLastDateTr: string; // Date of last run in registry
|
|
FileLastDateTr: string; // Date of last run in file winspool.ccc
|
|
FileFirstDateTr: string; // Date of first run in file winspool.ccc
|
|
|
|
TimerSave, TimerClose: TTimer;
|
|
|
|
const
|
|
HiddenFileName: String = 'ýãäùúååæÄééé'; {'WINSPOOL.CCC' xor $AA }
|
|
|
|
implementation
|
|
|
|
uses U_BaseCommon, U_ProtectionCommon;
|
|
|
|
procedure TTimers.Timer1Timer(Sender: TObject);
|
|
begin
|
|
TimerClose.Enabled := False;
|
|
TimerSave.Enabled := False;
|
|
Application.Terminate;
|
|
{$if Defined(ES_GRAPH_SC)}
|
|
Application.Terminate;
|
|
{$else}
|
|
ExitProcess(1);
|
|
{$ifend}
|
|
end;
|
|
|
|
procedure TTimers.Timer2Timer(Sender: TObject);
|
|
begin
|
|
TimerSave.Enabled := False;
|
|
SetAllLastDateTr;
|
|
end;
|
|
|
|
function IsMayRunTr: boolean;
|
|
begin
|
|
result := False;
|
|
if IsAllOkTr then
|
|
begin
|
|
if NOT IsTrialPeriodEndTr then
|
|
if strtodateU(BaseInfo.LastRun) = strtodateU(SystemCurrentDateTr) then
|
|
begin
|
|
if GetNumRunTr < (TrialRunTr XOR $2A) then
|
|
begin
|
|
IncNumRunTr;
|
|
result := True;
|
|
end
|
|
end
|
|
else
|
|
begin
|
|
SetNumRunTr;
|
|
result := True;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SetNumRunTr;
|
|
var Reg: TRegistry;
|
|
begin
|
|
Reg := TRegistry.Create;
|
|
try
|
|
Reg.RootKey := RegRootKey; //HKEY_USERS;
|
|
if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion',true) then
|
|
begin
|
|
try
|
|
{$IF Defined(SCS_PANDUIT) or Defined(SCS_PE)}
|
|
Reg.WriteString('A_M_D', inttostr( 1 XOR $AA ))
|
|
{$ELSE}
|
|
Reg.WriteString('AMD', inttostr( 1 XOR $AA ))
|
|
{$IFEND}
|
|
except
|
|
SetErrorMode(0);
|
|
end;
|
|
end
|
|
finally
|
|
Reg.CloseKey;
|
|
Reg.Free;
|
|
end;
|
|
SetBaseNumRun;
|
|
end;
|
|
|
|
procedure SetBaseNumRun(incremental: Boolean = False);
|
|
var
|
|
TempIStream: TMemoryStream;
|
|
TempInfo: PTrialBaseInfo;
|
|
BaseLastDateTr: string;
|
|
BaseFirstDateTr: string;
|
|
DateBase: TDateTime;
|
|
SysYear, SysMonth, SysDay: word;
|
|
begin
|
|
try
|
|
TempIStream := TMemoryStream.Create;
|
|
TempIStream.Position := 0;
|
|
if incremental then
|
|
BaseInfo.NumberRunTr := BaseInfo.NumberRunTr + 1
|
|
else
|
|
BaseInfo.NumberRunTr := 1;
|
|
try
|
|
F_ProjMan.DM.Query_Select.Close;
|
|
F_ProjMan.DM.Query_Select.SQL.Clear;
|
|
F_ProjMan.DM.Query_Select.SQL.Text := 'select * from KATALOG where ID = 1';
|
|
F_ProjMan.DM.Query_Select.ExecQuery;
|
|
if Not F_ProjMan.DM.Query_Select.Eof then
|
|
begin
|
|
GetMem(TempInfo, sizeof(TTrialBaseInfo));
|
|
try
|
|
try
|
|
DateBase := StrToDateU(BaseInfo.FirstRun);
|
|
except
|
|
DateBase := Now;
|
|
end;
|
|
DecodeDate(DateBase, SysYear, SysMonth, SysDay);
|
|
DateBase := EncodeDate(SysYear - 20, SysMonth, SysDay);
|
|
BaseFirstDateTr := DateTimeToStrU(DateBase);
|
|
TempInfo.FirstRun := inttostr(trunc(DateBase));
|
|
|
|
try
|
|
DateBase := strtoDateU(BaseInfo.LastRun);
|
|
except
|
|
DateBase := Now;
|
|
end;
|
|
DecodeDate(DateBase, SysYear, SysMonth, SysDay);
|
|
DateBase := EncodeDate(SysYear - 10, SysMonth, SysDay);
|
|
BaseLastDateTr := DateTimeToStrU(DateBase);
|
|
TempInfo.LastRun := inttostr(trunc(DateBase));
|
|
|
|
TempInfo.NumberRunTr := BaseInfo.NumberRunTr Xor $BB;
|
|
|
|
TempIStream.Position := 0;
|
|
TempIStream.Write(TempInfo^, sizeof(TTrialBaseInfo));
|
|
TempIStream.Position := 0;
|
|
|
|
F_ProjMan.DM.Query_Operat.Close;
|
|
F_ProjMan.DM.Query_Operat.SQL.Text := 'Update KATALOG SET CAD_BLOCK = ?CAD_BLOCK WHERE ID = 1';
|
|
F_ProjMan.DM.Query_Operat.ParamByName('CAD_BLOCK').LoadFromStream(TempIStream);
|
|
F_ProjMan.DM.Query_Operat.ExecQuery;
|
|
except
|
|
end;
|
|
FreeMem(TempInfo)
|
|
end;
|
|
finally
|
|
TempIStream.Free;
|
|
end;
|
|
except
|
|
end;
|
|
end;
|
|
|
|
procedure IncNumRunTr;
|
|
var Reg: TRegistry;
|
|
begin
|
|
Reg := TRegistry.Create;
|
|
try
|
|
Reg.RootKey := RegRootKey;
|
|
if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion',true) then
|
|
begin
|
|
try
|
|
{$IF Defined(SCS_PANDUIT) or Defined(SCS_PE)}
|
|
Reg.WriteString('A_M_D', inttostr(((strtoint(Reg.ReadString('A_M_D')) XOR $AA) + 1) XOR $AA ));
|
|
{$ELSE}
|
|
Reg.WriteString('AMD', inttostr(((strtoint(Reg.ReadString('AMD')) XOR $AA) + 1) XOR $AA ));
|
|
{$IFEND}
|
|
except
|
|
SetErrorMode(0);
|
|
end;
|
|
end
|
|
finally
|
|
Reg.CloseKey;
|
|
Reg.Free;
|
|
end;
|
|
SetBaseNumRun(True);
|
|
end;
|
|
|
|
function GetNumRunTr: integer;
|
|
var Reg: TRegistry;
|
|
temp1tr: integer;
|
|
begin
|
|
result := 0;
|
|
temp1tr := TrialRunTr;
|
|
Reg := TRegistry.Create;
|
|
try
|
|
Reg.RootKey := RegRootKey; //HKEY_USERS;
|
|
if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion',true) then
|
|
begin
|
|
try
|
|
{$IF Defined(SCS_PANDUIT) or Defined(SCS_PE)}
|
|
temp1tr := (strtoint(Reg.ReadString('A_M_D')) XOR $AA);
|
|
{$ELSE}
|
|
temp1tr := (strtoint(Reg.ReadString('AMD')) XOR $AA);
|
|
{$IFEND}
|
|
except
|
|
SetErrorMode(0);
|
|
end;
|
|
end
|
|
finally
|
|
Reg.CloseKey;
|
|
Reg.Free;
|
|
end;
|
|
result := TrialRunTr;
|
|
GetBaseInfo;
|
|
{$IF Defined(SCS_PANDUIT) or Defined(SCS_PE)}
|
|
BaseInfo.NumberRunTr := temp1tr;
|
|
{$IFEND}
|
|
if BaseInfo.NumberRunTr = temp1tr then
|
|
result := BaseInfo.NumberRunTr;
|
|
end;
|
|
|
|
procedure SetAllFirstDateTr;
|
|
begin
|
|
EmptySLSTr;
|
|
SetNumRunTr;
|
|
SetBaseFirstDateTr;
|
|
SetRegFirstDateTr;
|
|
CreateFileTr;
|
|
SetAllLastDateTr;
|
|
end;
|
|
|
|
procedure SetAllFirstDateTr1;
|
|
begin
|
|
SetNumRunTr;
|
|
SetBaseFirstDateTr;
|
|
SetRegFirstDateTr;
|
|
CreateFileTr;
|
|
SetAllLastDateTr;
|
|
end;
|
|
|
|
procedure EmptySLSTr;
|
|
var
|
|
temp: string;
|
|
Reg: TRegistry;
|
|
begin
|
|
Reg := TRegistry.Create;
|
|
temp := 'All ok';
|
|
try
|
|
Reg.RootKey := HKEY_LOCAL_MACHINE;
|
|
if Reg.OpenKeyReadOnly('\SOFTWARE\Microsoft\Windows\CurrentVersion') then
|
|
begin
|
|
{$IF Defined(SCS_PANDUIT) or Defined(SCS_PE)}
|
|
temp := Reg.ReadString('Class_GUID');
|
|
{$ELSE}
|
|
temp := Reg.ReadString('Clas GUID');
|
|
{$IFEND}
|
|
if length(temp) > 0 then
|
|
Temp := '00';
|
|
end;
|
|
except
|
|
end;
|
|
if temp <> '00' then
|
|
begin
|
|
try
|
|
try
|
|
Reg.CloseKey;
|
|
except
|
|
end;
|
|
|
|
Reg.RootKey := RegRootKey; //HKEY_LOCAL_MACHINE;
|
|
if Reg.OpenKeyReadOnly('\SOFTWARE\Microsoft\Windows\CurrentVersion') then
|
|
begin
|
|
{$IF Defined(SCS_PANDUIT) or Defined(SCS_PE)}
|
|
temp := Reg.ReadString('Class_GUID');
|
|
{$ELSE}
|
|
temp := Reg.ReadString('Clas GUID');
|
|
{$IFEND}
|
|
if length(temp) > 0 then
|
|
Temp := '00';
|
|
end;
|
|
except
|
|
end;
|
|
end;
|
|
Reg.free;
|
|
|
|
if Temp = '00' then
|
|
exit;
|
|
|
|
try
|
|
//F_ProjMan.DM.Query_Operat.Close;
|
|
//F_ProjMan.DM.Query_Operat.SQL.Text := 'Delete from KATALOG where ID <> 1';
|
|
//F_ProjMan.DM.Query_Operat.ExecQuery;
|
|
//F_ProjMan.DM.Query_Operat.Close;
|
|
//F_ProjMan.DM.Query_Operat.SQL.Text := 'Update KATALOG SET CAD_BLOCK = ?CAD_BLOCK where ID = 1';
|
|
//F_ProjMan.DM.Query_Operat.ExecQuery;
|
|
except
|
|
end;
|
|
end;
|
|
|
|
procedure SetAllLastDateTr;
|
|
begin
|
|
SetBaseLastDateTr;
|
|
SetRegLastDateTr;
|
|
end;
|
|
|
|
function IsAllOkTr: boolean;
|
|
begin
|
|
if NOT Assigned(TimerClose) then
|
|
begin
|
|
TTimers.Create;
|
|
TimerClose := TTimer.Create(nil);
|
|
TimerClose.OnTimer := TTimers1.Timer1Timer;
|
|
TimerClose.Interval := 500;
|
|
TimerClose.Enabled := False;
|
|
TimerSave := TTimer.Create(nil);
|
|
TimerSave.OnTimer := TTimers1.Timer2Timer;
|
|
TimerSave.Interval := 100;
|
|
TimerSave.Enabled := False;
|
|
end;
|
|
|
|
GetAllFirstDateTr;
|
|
GetAllCurrentDateTr;
|
|
if ((BaseInfo.FirstRun = '') OR(FileFirstDateTr = '') OR (RegFirstDateTr ='') OR (RegLastDateTr = '') OR (BaseInfo.LastRun = '')) then
|
|
result := False
|
|
else
|
|
begin
|
|
result := False;
|
|
if (BaseInfo.FirstRun = FileFirstDateTr) AND (BaseInfo.FirstRun = RegFirstDateTr) AND (RegFirstDateTr = FileFirstDateTr) then
|
|
begin
|
|
if (BaseInfo.LastRun = FileLastDateTr) AND (BaseInfo.LastRun = RegLastDateTr) AND (FileLastDateTr = RegLastDateTr) then
|
|
begin
|
|
if FileCurrentDateTr = SystemCurrentDateTr then
|
|
result := True;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function IsTrialPeriodEndTr: boolean;
|
|
begin
|
|
GetAllFirstDateTr;
|
|
GetAllCurrentDateTr;
|
|
if IsAllOkTr then
|
|
begin
|
|
result := True;
|
|
if strtodateU(BaseInfo.LastRun) <= strtodateU(SystemCurrentDateTr) then
|
|
if strtodateU(SystemCurrentDateTr) - strtodateU(BaseInfo.FirstRun) < (TrialDayTr XOR $1A) then
|
|
result := False;
|
|
end
|
|
else
|
|
result := True;
|
|
end;
|
|
|
|
Function SetFileDate(
|
|
Const FileName : String;
|
|
Const FileDate : TDateTime): Boolean;
|
|
var
|
|
FileHandle : THandle;
|
|
FileSetDateResult : Integer;
|
|
begin
|
|
try
|
|
try
|
|
FileHandle := FileOpen
|
|
(FileName,
|
|
fmOpenWrite OR fmShareDenyNone);
|
|
if FileHandle > 0 Then begin
|
|
FileSetDateResult :=
|
|
FileSetDate(
|
|
FileHandle,
|
|
DateTimeToFileDate(FileDate));
|
|
result := (FileSetDateResult = 0);
|
|
end;
|
|
except
|
|
Result := False;
|
|
end;
|
|
finally
|
|
FileClose (FileHandle);
|
|
end;
|
|
end;
|
|
|
|
procedure ChangeDate(AFileName: string);
|
|
var
|
|
i: TDateTime;
|
|
H: Integer;
|
|
f: TFileTime;
|
|
s: TSystemTime;
|
|
begin
|
|
H := CreateFile(PChar(AFileName), $0100, 0, nil, OPEN_EXISTING,
|
|
FILE_FLAG_BACKUP_SEMANTICS, 0);
|
|
|
|
i := Now;
|
|
|
|
DateTimeToSystemTime(i, S);
|
|
SystemTimeToFileTime(S, F);
|
|
LocalFileTimeToFileTime(F, F);
|
|
SetFileTime(H, @f, @f, @f);
|
|
CloseHandle(H);
|
|
end;
|
|
|
|
procedure CreateFileTr;
|
|
var
|
|
fs: TFileStream;
|
|
memStream: TMemoryStream;
|
|
DateTime: TDateTime;
|
|
f: file;
|
|
begin
|
|
try
|
|
RenameFile(GetFileNameTr, GetFileNameTr + '~');
|
|
DeleteFile(GetFileNameTr + '~');
|
|
DeleteFile(GetFileNameTr);
|
|
sleep(200);
|
|
DateTime := now;
|
|
|
|
AssignFile(F, GetFileNameTr);
|
|
Reset(F);
|
|
ReWrite(f, 1);
|
|
BlockWrite(f, DateTime, sizeof(DateTime));
|
|
FileSetDate(TFileRec(F).Handle, DateTimeToFileDate(Date));
|
|
FlushFileBuffers(TFileRec(F).Handle);
|
|
Close(F);
|
|
|
|
memStream := TMemoryStream.Create;
|
|
memStream.Write(DateTime, SizeOf(DateTime));
|
|
// fs := TFileStream.Create(GetFileNameTr, fmCreate);
|
|
// fs.Write(DateTime, SizeOf(DateTime));
|
|
memStream.SaveToFile(GetFileNameTr);
|
|
except
|
|
end;
|
|
try
|
|
// fs.Free;
|
|
memStream.Free;
|
|
ChangeDate(GetFileNameTr);
|
|
FileSetAttr(GetFileNameTr, faHidden);
|
|
SetFileDate(GetFileNameTr, DateTime);
|
|
except
|
|
end;
|
|
end;
|
|
|
|
procedure GetFileFirstDateTr;
|
|
var s: PChar;
|
|
str1: string;
|
|
Buffer: array[0..127] of Char;
|
|
i: integer;
|
|
sr: TSearchRec;
|
|
DateF: TDateTime;
|
|
DateFS :SystemTime;
|
|
begin
|
|
FileFirstDateTr := '';
|
|
Buffer := 'c:\windows\';
|
|
s := Buffer;
|
|
i := SizeOf(Buffer);
|
|
GetWindowsDirectory(s, i);
|
|
str1 := s;
|
|
str1 := str1 + '\' + 'system.ini';
|
|
if FindFirst(GetFileNameTr, faAnyFile, sr) = 0 then
|
|
begin
|
|
FileTimeToSystemTime(sr.FindData.ftCreationTime, DateFS);
|
|
DateF := EncodeDate(DateFS.wYear, DateFS.wMonth, DateFS.wDay);
|
|
FileFirstDateTr := DateTimeToStrU(DateF);
|
|
end;
|
|
FindClose(sr);
|
|
{$IF Defined(TRIAL_SCS) or Defined(PROCAT_SCS)}
|
|
FileFirstDateTr := RegFirstDateTr;
|
|
{$IFEND}
|
|
end;
|
|
|
|
procedure GetFileLastDateTr;
|
|
var s: PChar;
|
|
str1: string;
|
|
Buffer: array[0..127] of Char;
|
|
i: integer;
|
|
sr: TSearchRec;
|
|
DateF: TDateTime;
|
|
DateFS :SystemTime;
|
|
begin
|
|
FileLastDateTr := '';
|
|
Buffer := 'c:\windows\';
|
|
s := Buffer;
|
|
i := SizeOf(Buffer);
|
|
GetWindowsDirectory(s, i);
|
|
str1 := s;
|
|
str1 := str1 + '\' + 'system.ini';
|
|
if FindFirst(GetFileNameTr, faAnyFile, sr) = 0 then
|
|
begin
|
|
FileTimeToSystemTime(sr.FindData.ftLastAccessTime, DateFS);
|
|
DateF := EncodeDate(DateFS.wYear, DateFS.wMonth, DateFS.wDay) + 1;
|
|
FileLastDateTr := DateTimeToStrU(DateF);
|
|
end;
|
|
FindClose(sr);
|
|
FileLastDateTr := BaseInfo.LastRun;
|
|
end;
|
|
|
|
function GetFileNameTr: String;
|
|
var
|
|
pc: Array[0..$FF] of Char;
|
|
SystemDir: String;
|
|
i: Integer;
|
|
St: String;
|
|
begin
|
|
GetSystemDirectory(pc, $FF);
|
|
SystemDir := StrPas(pc);
|
|
St := HiddenFileName;
|
|
for i := 1 to Length(St) do
|
|
St[i] := char(byte(St[i]) xor $AA); { for example, $AA }
|
|
Result := SystemDir + '\' + St;
|
|
end;
|
|
|
|
function IsFirstRunTr: boolean;
|
|
begin
|
|
GetAllFirstDateTr;
|
|
GetAllCurrentDateTr;
|
|
if ((BaseInfo.FirstRun = '') AND (FileFirstDateTr = '') AND (RegFirstDateTr ='') AND (RegLastDateTr = '') AND (BaseInfo.LastRun = '')) then
|
|
result := True
|
|
else
|
|
result := False;
|
|
end;
|
|
|
|
procedure GetBaseLastDateTr;
|
|
begin
|
|
GetBaseInfo;
|
|
end;
|
|
|
|
// F_ProjMan.DM.Query_Select.SQL.Clear;
|
|
// F_ProjMan.DM.Query_Operat.SQL.Clear;
|
|
|
|
procedure GetBaseInfo;
|
|
var
|
|
BaseLastDateTr: string;
|
|
BaseFirstDateTr: string;
|
|
TempIStream: TMemoryStream;
|
|
TempInfo: PTrialBaseInfo;
|
|
DateBase: TDateTime;
|
|
SysYear, SysMonth, SysDay: word;
|
|
begin
|
|
try
|
|
TempIStream := TMemoryStream.Create;
|
|
TempIStream.Position := 0;
|
|
try
|
|
F_ProjMan.DM.Query_Select.Close;
|
|
F_ProjMan.DM.Query_Select.SQL.Clear;
|
|
F_ProjMan.DM.Query_Select.SQL.Text := 'select * from KATALOG where ID = 1';
|
|
F_ProjMan.DM.Query_Select.ExecQuery;
|
|
if Not F_ProjMan.DM.Query_Select.Eof then
|
|
begin
|
|
F_ProjMan.DM.Query_Select.FieldByName('CAD_BLOCK').SaveToStream(TempIStream);
|
|
TempIStream.Position := 0;
|
|
if TempIStream.Size > 0 then
|
|
begin
|
|
GetMem(TempInfo, sizeof(TTrialBaseInfo));
|
|
try
|
|
TempIStream.Read(TempInfo^, sizeof(TTrialBaseInfo));
|
|
try
|
|
if TempInfo.FirstRun <> '' then
|
|
begin
|
|
DateBase := strtoint(TempInfo.FirstRun);
|
|
DecodeDate(DateBase, SysYear, SysMonth, SysDay);
|
|
DateBase := EncodeDate(SysYear + 20, SysMonth, SysDay);
|
|
BaseFirstDateTr := DateTimeToStrU(DateBase);
|
|
BaseInfo.FirstRun := BaseFirstDateTr;
|
|
end;
|
|
except
|
|
end;
|
|
|
|
try
|
|
if TempInfo.LastRun <> '' then
|
|
begin
|
|
DateBase := strtoint(TempInfo.LastRun);
|
|
DecodeDate(DateBase, SysYear, SysMonth, SysDay);
|
|
DateBase := EncodeDate(SysYear + 10, SysMonth, SysDay);
|
|
BaseLastDateTr := DateTimeToStrU(DateBase);
|
|
BaseInfo.LastRun := BaseLastDateTr;
|
|
end;
|
|
except
|
|
end;
|
|
BaseInfo.NumberRunTr := TempInfo.NumberRunTr XOR $BB;
|
|
except
|
|
end;
|
|
FreeMem(TempInfo)
|
|
end;
|
|
end;
|
|
finally
|
|
TempIStream.Free;
|
|
end;
|
|
except
|
|
end;
|
|
{$IF Defined(SCS_PANDUIT) or Defined(SCS_PE)}
|
|
if RegFirstDateTr <> '' then
|
|
BaseInfo.FirstRun := RegFirstDateTr;
|
|
if RegLastDateTr <> '' then
|
|
BaseInfo.LastRun := RegLastDateTr;
|
|
{$IFEND}
|
|
end;
|
|
|
|
procedure GetBaseFirstDateTr;
|
|
var
|
|
SysYear, SysMonth, SysDay: word;
|
|
TempIStream: TMemoryStream;
|
|
TempInfo: PTrialBaseInfo;
|
|
begin
|
|
GetBaseInfo;
|
|
end;
|
|
|
|
procedure SetBaseFirstDateTr;
|
|
begin
|
|
BaseInfo.NumberRunTr := BaseInfo.NumberRunTr - 1;
|
|
BaseInfo.FirstRun := DateToStrU(now);
|
|
SetBaseNumRun(True);
|
|
end;
|
|
|
|
procedure SetBaseLastDateTr;
|
|
var
|
|
DateBase: TDateTime;
|
|
SysYear, SysMonth, SysDay: word;
|
|
begin
|
|
BaseInfo.NumberRunTr := BaseInfo.NumberRunTr - 1;
|
|
BaseInfo.LastRun := DateToStrU(now);
|
|
SetBaseNumRun(True);
|
|
end;
|
|
|
|
procedure GetAllCurrentDateTr;
|
|
var s: PChar;
|
|
str1: string;
|
|
Buffer: array[0..127] of Char;
|
|
i: integer;
|
|
sr: TSearchRec;
|
|
DateF: TDateTime;
|
|
DateSys: TDateTime;
|
|
SysYear, SysMonth, SysDay: word;
|
|
DateFS :SystemTime;
|
|
begin
|
|
Buffer := 'c:\windows\';
|
|
s := Buffer;
|
|
i := SizeOf(Buffer);
|
|
GetWindowsDirectory(s, i);
|
|
str1 := s;
|
|
{$IF Defined(SCS_PANDUIT) or Defined(SCS_PE)}
|
|
str1 := str1 + '\' + 'system .ini';
|
|
{$ELSE}
|
|
str1 := str1 + '\' + 'system.ini';
|
|
{$IFEND}
|
|
if FindFirst(str1, faAnyFile, sr) = 0 then
|
|
begin
|
|
FileTimeToSystemTime(sr.FindData.ftLastAccessTime, DateFS);
|
|
if (DateFS.wMinute = 0) AND (DateFS.wSecond = 0) then
|
|
DateF := EncodeDate(DateFS.wYear, DateFS.wMonth, DateFS.wDay) + 1
|
|
else
|
|
DateF := EncodeDate(DateFS.wYear, DateFS.wMonth, DateFS.wDay);
|
|
end;
|
|
FindClose(sr);
|
|
DateSys := now;
|
|
DecodeDate(DateSys, SysYear, SysMonth, SysDay);
|
|
DateSys := EncodeDate(SysYear, SysMonth, SysDay);
|
|
SystemCurrentDateTr := DateTimeToStrU(DateSys);
|
|
FileCurrentDateTr := SystemCurrentDateTr;
|
|
|
|
{$IF Defined(SCS_PANDUIT) or Defined(SCS_PE)}
|
|
GetBaseLastDateTr;
|
|
GetFileLastDateTr;
|
|
if RegFirstDateTr <> '' then
|
|
BaseInfo.FirstRun := RegFirstDateTr;
|
|
if RegLastDateTr <> '' then
|
|
BaseInfo.LastRun := RegLastDateTr;
|
|
GetRegLastDateTr;
|
|
{$ELSE}
|
|
GetBaseLastDateTr;
|
|
GetFileLastDateTr;
|
|
GetRegLastDateTr;
|
|
{$IFEND}
|
|
end;
|
|
|
|
procedure GetRegFirstDateTr;
|
|
var
|
|
Reg: TRegistry;
|
|
DateReg: TDateTime;
|
|
str1: string;
|
|
SysYear, SysMonth, SysDay: word;
|
|
begin
|
|
RegFirstDateTr := '';
|
|
Reg := TRegistry.Create;
|
|
try
|
|
Reg.RootKey := RegRootKey; //HKEY_USERS;
|
|
if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion',true) then
|
|
begin
|
|
try
|
|
{$IF Defined(SCS_PANDUIT) or Defined(SCS_PE)}
|
|
str1 := Reg.ReadString('D_S');
|
|
{$ELSE}
|
|
str1 := Reg.ReadString('DS');
|
|
{$IFEND}
|
|
if str1 <> '0' then
|
|
begin
|
|
DateReg := strtoint(str1);
|
|
DecodeDate(DateReg, SysYear, SysMonth, SysDay);
|
|
DateReg := EncodeDate(SysYear + 30, SysMonth, SysDay);
|
|
RegFirstDateTr := DateTimeToStrU(DateReg);
|
|
end
|
|
except
|
|
SetErrorMode(0);
|
|
end;
|
|
end
|
|
finally
|
|
Reg.CloseKey;
|
|
Reg.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure GetRegLastDateTr;
|
|
var Reg: TRegistry;
|
|
DateReg: TDateTime;
|
|
str1: string;
|
|
SysYear, SysMonth, SysDay: word;
|
|
begin
|
|
RegLastDateTr := '';
|
|
Reg := TRegistry.Create;
|
|
try
|
|
Reg.RootKey := RegRootKey; //HKEY_USERS;
|
|
if Reg.OpenKey('\SOFTWARE\Microsoft\Windows',true) then
|
|
begin
|
|
try
|
|
{$IF Defined(SCS_PANDUIT) or Defined(SCS_PE)}
|
|
str1 := Reg.ReadString('Port_Nt');
|
|
{$ELSE}
|
|
str1 := Reg.ReadString('PortNt');
|
|
{$IFEND}
|
|
if str1 <> '0' then
|
|
begin
|
|
DateReg := strtoint(str1);
|
|
DecodeDate(DateReg, SysYear, SysMonth, SysDay);
|
|
DateReg := EncodeDate(SysYear + 35, SysMonth, SysDay);
|
|
RegLastDateTr := DateTimeToStrU(DateReg);
|
|
end
|
|
except
|
|
SetErrorMode(0);
|
|
end;
|
|
end
|
|
finally
|
|
Reg.CloseKey;
|
|
Reg.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure SetRegFirstDateTr;
|
|
var Reg: TRegistry;
|
|
DateReg: TDateTime;
|
|
SysYear, SysMonth, SysDay: word;
|
|
begin
|
|
Reg := TRegistry.Create;
|
|
DateReg := now;
|
|
DecodeDate(DateReg, SysYear, SysMonth, SysDay);
|
|
DateReg := EncodeDate(SysYear-30, SysMonth, SysDay);
|
|
try
|
|
Reg.RootKey := RegRootKey; //HKEY_USERS;
|
|
if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion',true) then
|
|
begin
|
|
try
|
|
{$IF Defined(SCS_PANDUIT) or Defined(SCS_PE)}
|
|
Reg.WriteString('D_S', Floattostr(DateReg))
|
|
{$ELSE}
|
|
Reg.WriteString('DS', Floattostr(DateReg))
|
|
{$IFEND}
|
|
except
|
|
SetErrorMode(0);
|
|
end;
|
|
end
|
|
finally
|
|
Reg.CloseKey;
|
|
Reg.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure SetRegLastDateTr;
|
|
var Reg: TRegistry;
|
|
DateReg: TDateTime;
|
|
SysYear, SysMonth, SysDay: word;
|
|
begin
|
|
Reg := TRegistry.Create;
|
|
DateReg := now;
|
|
DecodeDate(DateReg, SysYear, SysMonth, SysDay);
|
|
DateReg := EncodeDate(SysYear-35, SysMonth, SysDay);
|
|
try
|
|
Reg.RootKey := RegRootKey; //HKEY_USERS;
|
|
if Reg.OpenKey('\SOFTWARE\Microsoft\Windows',true) then
|
|
begin
|
|
try
|
|
{$IF Defined(SCS_PANDUIT) or Defined(SCS_PE)}
|
|
Reg.WriteString('Port_Nt', Floattostr(DateReg))
|
|
{$ELSE}
|
|
Reg.WriteString('PortNt', Floattostr(DateReg))
|
|
{$IFEND}
|
|
except
|
|
SetErrorMode(0);
|
|
end;
|
|
end
|
|
finally
|
|
Reg.CloseKey;
|
|
Reg.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure GetAllFirstDateTr;
|
|
begin
|
|
GetRegFirstDateTr;
|
|
GetBaseFirstDateTr;
|
|
GetFileFirstDateTr;
|
|
end;
|
|
|
|
procedure LogAllDate;
|
|
var
|
|
Logs: TStringList;
|
|
begin
|
|
Logs := TStringList.Create;
|
|
GetAllFirstDateTr;
|
|
Logs.Add('FdfR - ' + RegFirstDateTr);
|
|
Logs.Add('FdfT - ' + BaseInfo.FirstRun);
|
|
Logs.Add('FdfW - ' + FileFirstDateTr);
|
|
Logs.SaveToFile(GetExeDir + '\runlog.log');
|
|
|
|
Logs.Add('NorfRaT - ' + inttostr(GetNumRunTr));
|
|
Logs.SaveToFile(GetExeDir + '\runlog.log');
|
|
|
|
GetAllCurrentDateTr;
|
|
|
|
Logs.Add('CdfSI - ' + FileCurrentDateTr);
|
|
Logs.Add('CdoO - ' + SystemCurrentDateTr);
|
|
Logs.Add('LdfR - ' + RegLastDateTr);
|
|
Logs.Add('LdfT - ' + BaseInfo.LastRun);
|
|
Logs.Add('LdfT - ' + FileLastDateTr);
|
|
Logs.SaveToFile(GetExeDir + '\runlog.log');
|
|
Logs.Free;
|
|
end;
|
|
|
|
{$IF Defined(TRIAL_SCS) or Defined(PROCAT_SCS)}
|
|
function GetAllDate: string;
|
|
var
|
|
Logs: TStringList;
|
|
begin
|
|
result := '';
|
|
try
|
|
Logs := TStringList.Create;
|
|
GetAllFirstDateTr;
|
|
Logs.Add('%0dRegistry first - ' + RegFirstDateTr);
|
|
Logs.Add('%0dBase first - ' + BaseInfo.FirstRun);
|
|
Logs.Add('%0dFile first - ' + FileFirstDateTr);
|
|
Logs.Add('%0dRun number - ' + inttostr(GetNumRunTr));
|
|
GetAllCurrentDateTr;
|
|
Logs.Add('%0dSystem file current date - ' + FileCurrentDateTr);
|
|
Logs.Add('%0dSystem current date - ' + SystemCurrentDateTr);
|
|
Logs.Add('%0dRegistry last date - ' + RegLastDateTr);
|
|
Logs.Add('%0dBase last date - ' + BaseInfo.LastRun);
|
|
Logs.Add('%0dFile last date - ' + FileLastDateTr);
|
|
result := Logs.Text;
|
|
Logs.Free;
|
|
except
|
|
result := 'AV on getalldate';
|
|
end;
|
|
end;
|
|
{$IFEND}
|
|
|
|
end.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|