expertcad/SRC/Main/U_MessEnd.pas
2025-05-12 10:07:51 +03:00

406 lines
11 KiB
ObjectPascal
Raw Permalink Blame History

unit U_MessEnd;
interface
uses
Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxLookAndFeelPainters, StdCtrls, cxButtons, cxControls,
FastStrings, Registry, ShellAPI, cxContainer, cxEdit, cxTextEdit, cxMaskEdit, siComp, siLngLnk,
cxGraphics, cxLookAndFeels, Menus, Buttons, clipbrd;
type
TF_MessEnd = class(TForm)
bOK: TcxButton;
bCancel: TcxButton;
lbMessage: TLabel;
lng_Forms: TsiLangLinked;
Edit1: TEdit;
Edit2: TEdit;
LabelMess2: TLabel;
Label5: TLabel;
Label2: TLabel;
Label1: TLabel;
lblCaptionProgID: TLabel;
lblProgID: TEdit;
LabelMess3: TLabel;
Label3: TLabel;
BitBtn1: TBitBtn;
procedure bCancelClick(Sender: TObject);
procedure Label5Click(Sender: TObject);
procedure Label3Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
function ShowTrialError(aErrorCode: integer): Boolean;
function GetReqCode: string;
procedure CheckCode(aInStr, aCode: string);
var
F_MessEnd: TF_MessEnd;
implementation
uses U_BaseCommon, U_BaseSettings, U_Constants, USCS_Main, U_ProtectionCommon, U_Common,
{$IF Not Defined(SCS_SPA)}
{$IF Defined(PROCAT_SCS) and Not Defined(TRIAL_SCS)}
U_ProtRutinP,
{$ELSE}
U_ProtRutin,
{$IFEND}
{$IFEND}
{$IF Defined (SCS_SPA) AND Not Defined(TRIAL_SCS)}
U_ProtRutinSPA,
{$IFEND}
{$IF Defined (SCS_SPA) AND Defined(TRIAL_SCS)}
U_ProtRutin,
{$IFEND}
U_Protection;
{$R *.dfm}
procedure OpenMail(s: string='');
var
SHI : TShellExecuteInfo;
tmpstr: string;
begin
try
ZeroMemory(@SHI, sizeof(SHI));
SHI.cbSize := sizeof(SHI);
SHI.fMask := SEE_MASK_NOCLOSEPROCESS;
SHI.Wnd := Application.Handle;
SHI.lpVerb := PChar('Open');
if s = '' then
SHI.lpFile := PChar('mailto:')
else
begin
tmpstr := 'mailto:' + s;
SHI.lpFile := PChar(tmpstr);
end;
SHI.lpParameters := nil;
SHI.lpDirectory := nil;
ShellExecuteEx(@SHI);
except
end;
end;
function GetMess(amess: string): string;
var
i: integer;
begin
result := '';
for i := length(amess) downto 1 do
begin
result := result + amess[i];
// result := result + chr(($5C XOR ord(amess[i])));
end;
end;
function ContinueTrial2: string;
var
InputStr: string;
Req: string;
TimeStr: string;
begin
result := '';
try
Randomize;
//TimeStr := DateTimeToStr(Now);
//ShowMessage(TimeStr);
DateTimeToString(TimeStr, 'dd.MM.yyyy H:mm:ss', Now);
//ShowMessage(TimeStr);
while Pos(':', TimeStr) > 0 do
delete(TimeStr, Pos(':', TimeStr), 1);
while Pos('.', TimeStr) > 0 do
delete(TimeStr, Pos('.', TimeStr), 1);
while Pos(' ', TimeStr) > 0 do
delete(TimeStr, Pos(' ', TimeStr), 1);
while Pos('\', TimeStr) > 0 do
delete(TimeStr, Pos('\', TimeStr), 1);
while Pos('/', TimeStr) > 0 do
delete(TimeStr, Pos('/', TimeStr), 1);
TimeStr := GetMess(TimeStr);
Req := inttostr(Random(99)) + TimeStr + inttostr(Random(119));
Result := Req;
except
end;
end;
function GetReqCode: string;
var
InputStr: string;
Req: string;
Reg: TRegistry;
key, text, longkey, resstr: string;
i : integer;
toto, c : char;
begin
result := '';
{$IF Defined(SCS_PE) or Defined(SCS_PANDUIT) or Defined(BASEADM_SCS)}
longkey := '';
resstr := '';
key := 'cableproj';
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
Req := '';
if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion') then
begin
Req := Reg.ReadString('GUI2');
text := Req;
for i := 0 to (length(text) div length(key)) do
longkey := longkey + key;
for i := 1 to length(text) do
begin
toto := chr((ord(text[i]) xor ord(longkey[i])));
resstr := resstr + toto;
end;
Req := resstr;
end
else
begin
Req := ContinueTrial2;
end;
finally
Reg.Free;
end;
if Req = '' then
Req := ContinueTrial2;
result := Req;
longkey := '';
text := Req;
resstr := '';
for i := 0 to (length(text) div length(key)) do
longkey := longkey + key;
for i := 1 to length(text) do
begin
toto := chr((ord(text[i]) xor ord(longkey[i])));
resstr := resstr + toto;
end;
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion', True) then
begin
Reg.WriteString('GUI2', resstr);
end;
finally
Reg.Free;
end;
{$ELSE}
Req := ContinueTrial2;
result := Req;
{$IFEND}
{$IF Defined(PROCAT_SCS) and Not Defined(TRIAL_SCS)}
Req := FastReplace(Req, '-', '');
insert('-', Req, 5);
insert('-', Req, 10);
insert('-', Req, 15);
result := Req;
{$IFEND}
end;
procedure CheckCode(aInStr, aCode: string);
var
InputStr: string;
Req: string;
Reg: TRegistry;
key, text, longkey, resstr: string;
i : integer;
toto, c : char;
temps0: string;
temps: string;
temps1: string;
begin
Req := aInStr;
Req := FastReplace(Req, '-', '');
{$IF Defined(SCS_PE) or Defined(SCS_PANDUIT) or Defined(BASEADM_SCS)}
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion', True) then
begin
Reg.WriteString('GUI2', '');
end;
finally
Reg.Free;
end;
{$IFEND}
InputStr := aCode;
if InputStr <> '' then
begin
{$IF Defined(PROCAT_SCS) and Not Defined(TRIAL_SCS)}
temps0 := '1111';
temps := '1111';
temps1 := '0';
if pos('-', InputStr) > 0 then
begin
temps0 := copy(InputStr, 1, pos('-', InputStr) - 1);
temps := copy(InputStr, pos('-', InputStr) + 1, $FFFFF);
if pos('-', temps) > 0 then
begin
temps1 := copy(temps, pos('-', temps) + 1, $FFFFF);
temps := copy(temps, 1, pos('-', temps) - 1);
end;
end;
if CRC32(Req, 1) = temps0 then
begin
if CRC32(CRC32(Req, 1) + temps + '1978', 1) = temps1 then
begin
SetAllFirstDateTr1;
SetDays(temps);
if ProgramRegisterPro then
begin
if IsMayRunTr then
begin
GReadOnlyMode := False;
GSCSIni.NB.DisableEdit := False;
end;
WriteNBIni(GSCSIni.NB);
end;
end;
end;
{$ELSE}
if CRC32(Req, 1) = InputStr then
begin
SetAllFirstDateTr1;
end;
{$IFEND}
end;
end;
function ShowTrialError(aErrorCode: integer): Boolean;
var
InputStr: string;
Req: string;
Reg: TRegistry;
key, text, longkey, resstr: string;
i : integer;
toto, c : char;
temps0: string;
temps: string;
temps1: string;
liccode: string;
begin
if not Assigned(F_MessEnd) then
Application.CreateForm(TF_MessEnd, F_MessEnd);
{$IF Defined(SCS_PE) or Defined(SCS_PANDUIT) or Defined(BASEADM_SCS)}
F_MessEnd.label1.Visible := False;
{$IFEND}
{$IF Defined(PROCAT_SCS) and Not Defined(TRIAL_SCS)}
liccode := GLicProgCode;
insert('-', liccode, 5);
insert('-', liccode, 10);
insert('-', liccode, 15);
liccode := liccode + '-' + GetDateID;
liccode := ProgID.Data1 + '-' + ProgID.Data2 + '-' +
ProgID.Data3 + '-' + ProgID.Data4 + '-' + GetDateID;
liccode := FormatForUser(liccode);
F_MessEnd.lblProgID.Text := liccode;
{$ELSE}
F_MessEnd.lblCaptionProgID.Visible := False;
F_MessEnd.lblProgID.Visible := False;
{$IFEND}
{$IF Defined(TRIAL_SCS) and Defined(SCS_PE) and Not Defined(PROCAT_SCS)}
F_MessEnd.LabelMess3.Visible := True;
F_MessEnd.LabelMess2.Visible := False;
F_MessEnd.lbMessage.Visible := False;
{$IFEND}
Req := GetReqCode;
F_MessEnd.Edit1.Text := Req;
FSCS_Main.aCopy.ShortCut := 0;
FSCS_Main.aPaste.ShortCut := 0;
{$IF Defined(PROCAT_SCS) and Not Defined(TRIAL_SCS)}
GReadOnlyMode := True;
GSCSIni.NB.DisableEdit := True;
{$IFEND}
if F_MessEnd.ShowModal = mrok then
begin
CheckCode(Req, F_MessEnd.Edit2.Text);
end;
FreeAndNil(F_MessEnd);
FSCS_Main.aCopy.ShortCut := 16451;
FSCS_Main.aPaste.ShortCut := 16470;
end;
procedure TF_MessEnd.bCancelClick(Sender: TObject);
begin
try
Close;
except
end;
end;
procedure TF_MessEnd.Label5Click(Sender: TObject);
var
astr: string;
trialstr: string;
begin
trialstr := '';
{$IF Not Defined(PROCAT_SCS)}
trialstr := 'trial';
{$IFEND}
{$IF Defined(SCS_SPA)}
astr := 'office@telcocad.net?subject=TelcoCad prolongation code request&body=Code = ' + Edit1.Text + '%0dReg information%0d' +
GetAllDate + '%0d';
{$ELSE}
{$IF Defined(ES_GRAPH_SC)}
astr := 'office@expertsoft.com.ua?subject=SC GRAPH MODULE ' + trialstr + ' prolongation code request&body=Code = ' + Edit1.Text + '%0dTrial information%0d' +
GetAllDate + '%0d';
{$ELSE}
{$IF Defined(SCS_PANDUIT)}
astr := 'roman.leleko@gmail.com?subject=Panduit Network CAD prolongation code request&body=Licence = ' + F_MessEnd.lblProgID.Text + '%0dCode = ' + Edit1.Text + '%0dDate information%0d' +
GetAllDate + '%0d';
{$ELSE}
{$IF Defined(SCS_PE)}
astr := 'office@cableproject.net?subject=CableProject CAD ' + trialstr + ' prolongation code request&body=Licence = ' + F_MessEnd.lblProgID.Text + '%0dCode = ' + Edit1.Text + '%0dTrial information%0d' +
GetAllDate + '%0d';
{$ELSE}
astr := 'office@expertsoft.com.ua?subject=ExpertCAD ' + trialstr + ' prolongation code request&body=Licence = ' + F_MessEnd.lblProgID.Text + '%0dCode = ' + Edit1.Text + '%0dTrial information%0d' +
GetAllDate + '%0d';
{$IFEND}
{$IFEND}
{$IFEND}
{$IFEND}
OpenMail(astr);
end;
procedure TF_MessEnd.BitBtn1Click(Sender: TObject);
begin
Clipboard.Open;
Clipboard.AsText := Edit1.Text;
Clipboard.Close;
end;
procedure TF_MessEnd.Label3Click(Sender: TObject);
begin
Label5Click(sender);
{$IF Defined(TRIAL_SCS) and Not Defined(PROCAT_SCS)}
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
{$ELSE}
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
{$IFEND}
end;
end.