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

612 lines
18 KiB
ObjectPascal
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

unit U_LibCommon;
interface
uses
Windows, Forms, StdCtrls, Classes, ComCtrls, Controls, DrawEngine, PCTypesUtils, SysUtils, Dialogs,
U_DimLineDialog, U_LNG, U_BlockParams, U_CreateRaiseQuery, U_ChooseListForTrunk, U_BaseSettings, ShellApi, ActnList, ActiveX, ShlObj, Registry, Contnrs, DrawObjects, PCDrawBox, PCDrawing, PowerCad, Graphics, U_Cad, U_ESCadClasess, U_SCSLists, U_SCSComponent,
U_RaiseHeight, U_InterfacesAutoTrace, U_LoadColor, U_OrthoLineParams, U_SizePos, U_NewLayer, U_GridStep, U_Scale, U_IncOn, U_ComponDesignWizard, U_FloatPanel,
U_PEGetBox, U_PEDialogEqChoice, U_PEAutotraceDialog, U_BlockEditor, U_ProtectionBase,
U_ChooseSCSObjectsProp, U_CadNormsList, U_CadNormsProp, Form3d_Save, U_USB, U_ProtectionCommon, U_SCSEngineTest, U_Common, U_BaseCommon, U_Progress, U_Splash, Math, U_Navigator, Messages, LibJpeg, ClipBrd, ExtCtrls, U_HouseClasses;
//type
function InitCommon({var ANBConst: TNBConst; }ParentWin: THandle = 0): boolean; stdcall;
//
//Çàìåòêè ïî ïåðåâîäó íà äð ÿçûêè:
//Ñòðîêè â ìîäóëÿõ U_Protection, U_ProtectionCommon, U_ProtectionBase ïåðåâîäÿòñÿ îòäåëüíî
const
ErrorProt = '!àíåøðåâàç òåäóá ûììàðãîðï àòîáàÐ .èèñðåâ ëàèðò åûííàä åûíòêåðîêåÍ';
var
Source: TStream;
si: TSystemInfo;
ModuleName: string;
FoundWnd: THandle;
HMutexSCS: THandle;
TempList: TStringList;
TempList1: TStringList;
ts: TTimeStamp;
Reg: TRegistry;
TempPath: string;
s, TempFolder, tempstr: string;
buff: PChar;
vHandle : Cardinal;
vMaskProcess, vMaskSystem : cardinal;
i: integer;
Action: TAction;
CurrServerName, CurrLocalPath: string;
GCanRemotePath: Boolean; //09.11.2007
isUAC: integer;
implementation
uses USCS_Main, Menus, U_main, U_MasterNewList, U_MasterNewListLite, U_AutoTraceType, U_Layers, FPlan, U_SCSObjectsProp,
cxMemo, U_ChooseComponTypes, U_EndPoints, U_TrunkSCS, U_Constants, U_ChooseDesignBoxParams,
U_AutoTraceConnectOrder, U_Protection, cxCheckBox, U_PrintLists, U_ImportDXF;
procedure ExtractFromExe(Instance: THandle; ResID: Integer; FileName: string);
var
ResStream: TResourceStream; // Îáúåêò - ïîòîê ðåñóðñîâ
FileStream: TFileStream;
begin
try
try
ResStream := TResourceStream.CreateFromID(Instance, Resid, RT_RCDATA);
FileStream := TFileStream.Create(FileName, fmCreate);
try
FileStream.CopyFrom(ResStream, 0);
finally
FreeAndNil(FileStream);
end;
finally
FreeAndNil(ResStream);
end;
except
on E:Exception do
begin
DeleteFile(FileName);
end;
end;
end;
procedure SetInternationalSettings;
var
sDecimal: string;
sDate: string;
sShortDate: string;
flag: boolean;
sThousand: string;
Reg: TRegistry;
begin
flag := false;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('\Control Panel\International',true) then
begin
try
sDecimal := Reg.ReadString('sDecimal');
sDate := Reg.ReadString('sDate');
sShortDate := Reg.ReadString('sShortDate');
sThousand := Reg.ReadString('sThousand');
if (not(sDecimal = ','))
or (not(sDate = '.'))
or (not(sShortDate = 'dd.MM.yyyy'))
or (not(sThousand = ' ')) then
begin
Reg.WriteString('sDecimal',',');
Reg.WriteString('sDate','.');
Reg.WriteString('sShortDate','dd.MM.yyyy');
Reg.WriteString('sThousand',' ');
flag := true;
end;
except
// ExitProcess(1);
ShowMessage(cDpr_Mes2);
//halt;
end;
end;
finally
// if flag then
// ExitProcess(1);
Reg.CloseKey;
Reg.Free;
end;
end;
end;
function RemoveFonts: boolean;
var
FontList: TStringList;
buff: PChar;
i: integer;
RemoveStatus: boolean;
LastError: DWORD;
FontName: PChar;
sr: TSearchRec;
begin
FontList := TStringList.Create;
FontList.Add('ARIALUNI.TTF');
FontList.Add('batang.ttf');
FontList.Add('MSMINCHO.TTF');
FontList.Add('simsun.ttf');
FontList.Add('gost.ttf');
result := false;
GetMem(buff, 255);
GetWindowsDirectory(buff, 255);
for i := 0 to FontList.Count - 1 do
begin
if FontList.Strings[i] = 'gost.ttf' then
begin
if FileExists(buff + '\Fonts\' + FontList.Strings[i]) then
begin
begin
try
if FindFirst(PChar(buff + '\Fonts\' + FontList.Strings[i]), faAnyFile, sr) = 0 then
begin
if sr.Size <> 107744 then
begin
result := true;
FontName := PChar(FontList.Strings[i]);
if Not RemoveFontResource(FontName) then
LastError := GetLastError;
SysUtils.DeleteFile(buff + '\Fonts\' + FontList.Strings[i]);
end;
end;
FindClose(sr);
except
end;
end;
end;
end
else
begin
if FileExists(buff + '\Fonts\' + FontList.Strings[i]) then
begin
result := true;
FontName := PChar(FontList.Strings[i]);
if Not RemoveFontResource(FontName) then
LastError := GetLastError;
SysUtils.DeleteFile(buff + '\Fonts\' + FontList.Strings[i]);
end;
end;
end;
FreeMem(Buff);
if result then
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;
{
function EnumWndProc(hwnd: HWND; i: Integer): Boolean; stdcall;
var
ClassName, WinModuleName: string;
WinIntstance: THandle;
begin
Result := true;
SetLength(ClassName, 100);
GetClassName(hwnd, PChar(ClassName), Length(ClassName));
ClassName := PChar(ClassName);
if ClassName = TFSCS_Main.ClassName then
begin
SetLength(WinModuleName, 200);
WinIntstance := GetWindowLong(hwnd, GWL_HINSTANCE);
GetModuleFileName(WinIntstance, PChar(WinModuleName), Length(WinmoduleName));
WinModuleName := PChar(WinmoduleName);
if WInmoduleName = ModuleName then
begin
FoundWnd := Hwnd;
result := false;
end;
end;
end;
}
procedure TryHex;
begin
if (not ProgramRegisterPro) {and (Not ProgramRegisterTrial)} then
begin
while 234 <> 912 do
begin
MessageBeep(MB_ICONASTERISK);
// if Not ShowRegistration then
// begin
// ExitProcess(1);
// end;
ProgramRegisterPro := ProgProtection.IsVerls(PRO);
ProgramRegisterTrial := ProgProtection.IsVerls(TRIAL);
if ProgramRegisterPro {or ProgramRegisterTrial} then
break;
Application.ProcessMessages;
end;
end;
end;
function GetDeskTopPath(SPECFOLDER: integer): string;
var
Allocator: IMalloc;
SpecialDir: PItemIdList;
FBuf: array[0..MAX_PATH] of Char;
PerDir: string;
begin
result := '';
if SHGetMalloc(Allocator) = NOERROR then
begin
SHGetSpecialFolderLocation(0, SPECFOLDER, SpecialDir);
SHGetPathFromIDList(SpecialDir, @FBuf[0]);
Allocator.Free(SpecialDir);
result := string(FBuf);
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 ShiftDown : Boolean;
var
State : TKeyboardState;
begin
GetKeyboardState(State);
Result := (((State[vk_Shift] and 128) <> 0) AND ((State[VK_CONTROL] and 128) <> 0));
end;
function strtoPchar(s:string):Pchar;
begin
S := S+#0;
result:=StrPCopy(@S[1], S) ;
end;
function ParamExists(AParamValue: string): Boolean;
var
i: integer;
CurrParamValue: String;
begin
Result := false;
if ParamCount > 0 then
for i := 1 to ParamCount do
begin
CurrParamValue := ParamStr(i);
if CurrParamValue = AParamValue then
begin
Result := true;
Break; //// BREAK ////
end;
end;
end;
function InitCommon({var ANBConst: TNBConst; }ParentWin: THandle = 0): boolean; stdcall;
begin
Application.Handle := ParentWin;
if Not Assigned(FSCS_Main) then
begin
GDatabaseName := '';
IsVista := False;
if DetectWinVersion = wvVista then
IsVista := True;
GExitProgEx := False;
system.IsMultiThread:=false;
try
RemoveFonts;
except
end;
OpenFileAtStart := '';
GNowOpen := False;
GIsProgress := False;
//Application.Initialize;
try
SetLocaleInternationalSettings;
except
end;
SetCursors;
try
ExeDir := ExtractFileDir(Application.ExeName);
if ExeDir[Length(ExeDir)] = '\' then
begin
ExeDir := Copy(ExeDir, 1, Length(ExeDir) - 1);
end;
except
end;
ExeDir := ExeDir + '\Graph';
try
getmem(buff,255);
s := '';
if (GetEnvironmentVariable('tmp',buff, 254) >0)
and (DirectoryExists(buff)) then
begin
s := buff;
end;
try
tempfolder := buff;
if tempfolder[length(tempfolder)] <> '\' then
tempfolder := tempfolder + '\';
while tempfolder <> '' do
begin
tempstr := tempstr + copy(tempfolder, 1, pos('\', tempfolder));
delete(tempfolder, 1, pos('\', tempfolder));
if Not DirectoryExists(tempstr) then
CreateDir(tempstr);
end;
except
end;
if (GetEnvironmentVariable('temp',buff, 254) >0)
and (DirectoryExists(buff)) then
begin
s := buff;
end;
try
tempfolder := buff;
if tempfolder[length(tempfolder)] <> '\' then
tempfolder := tempfolder + '\';
while tempfolder <> '' do
begin
tempstr := tempstr + copy(tempfolder, 1, pos('\', tempfolder));
delete(tempfolder, 1, pos('\', tempfolder));
if Not DirectoryExists(tempstr) then
CreateDir(tempstr);
end;
except
end;
finally
freemem(buff);
end;
TempDir := '';
IDESerialG := '';
F_Splash := TF_Splash.Create(F_Splash);
F_Splash.ProgressBar.Max := 38;
F_Splash.ProgressBar.Step := 1;
F_Splash.Label1.Caption := 'v.' + VersionEXE;
F_Splash.Hide;
// F_Splash.Refresh;
F_Progress := TF_Progress.Create(F_Progress);
//F_Progress.Show;
StartUpProgress; Application.CreateForm(TF_LNG, F_LNG);
F_LNG.siLangDisp.ActiveLanguage := 7;
ts := DateTimeToTimeStamp(StrToDateU(DateEXE));
DateID := IntToHex(ts.Date, 5);
DateID := DateID + '5';
ProgProtection := TProtection.Create;
ProgID := StrToProgID('1111111111111111');
NtOS := (Win32Platform = VER_PLATFORM_WIN32_NT);
Application.Title := 'Ãðàôè÷åñêèé ìîäóëü';
Application.HelpFile := 'HELP\HELP.HLP';
isUAC := 0;
if isVista then
begin
Reg := TRegistry.Create;
try
isUAC := 0;
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System') then
begin
isUAC := Reg.ReadInteger('EnableLUA');
end;
finally
Reg.Free;
end;
end;
if isUAC = 0 then
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey('SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows', false) then
begin
Reg.WriteInteger('GDIProcessHandleQuota', 50000);
Reg.WriteInteger('USERProcessHandleQuota', 50000);
end;
finally
Reg.Free;
end;
isUAC := 10000;
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows') then
begin
isUAC := Reg.ReadInteger('GDIProcessHandleQuota');
end;
finally
Reg.Free;
end;
if isUAC < 30000 then
begin
try
ExtractFromExe(HInstance, $4, U_USB.GetTempDir + '\GDI.REG');
except
end;
ShellExecute(0, PChar('open'), PChar('regedit.exe'), PChar(U_USB.GetTempDir + '\GDI.REG'), PChar(U_USB.GetTempDir), SW_SHOWNORMAL);
end;
end
else
begin
isUAC := 10000;
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows') then
begin
isUAC := Reg.ReadInteger('GDIProcessHandleQuota');
end;
finally
Reg.Free;
end;
if isUAC < 30000 then
begin
try
ExtractFromExe(HInstance, $4, U_USB.GetTempDir + '\GDI.REG');
except
end;
ShellExecute(0, PChar('open'), PChar('regedit.exe'), PChar(U_USB.GetTempDir + '\GDI.REG'), PChar(U_USB.GetTempDir), SW_SHOWNORMAL);
end;
end;
NtOS := (Win32Platform = VER_PLATFORM_WIN32_NT);
{if ParamExists('/1') then
begin
try
GetSystemInfo(si);
if si.dwNumberOfProcessors > 1 then
begin
vHandle := GetCurrentProcess;
SetProcessAffinityMask(vHandle, 1); // or 1
GetProcessAffinityMask(vHandle, vMaskProcess, vMaskSystem);
end;
except
end;
end;}
GSCSIni.Controls := ReadControls; //#From Oleg#
StartUpProgress;
Application.CreateForm(TFSCS_Main, FSCS_Main);
Application.CreateForm(TF_MasterNewListLite, F_MasterNewListLite);
FSCS_Main.Left := Screen.WorkAreaRect.Left;
FSCS_Main.Top := Screen.WorkAreaRect.Top;
FSCS_Main.Width := Screen.WorkAreaRect.Right - Screen.WorkAreaRect.Left;
FSCS_Main.Height := Screen.WorkAreaRect.Bottom - Screen.WorkAreaRect.Top;
FSCS_Main.Refresh;
Application.CreateForm(TF_ChooseListForTrunk, F_ChooseListForTrunk);
Application.CreateForm(Tfrm3D_Save, frm3D_Save);
StartUpProgress; Application.CreateForm(TF_CadNormsProp, F_CadNormsProp);
StartUpProgress; Application.CreateForm(TF_CadNormsList, F_CadNormsList);
StartUpProgress; Application.CreateForm(TF_ChooseDesignBoxParams, F_ChooseDesignBoxParams);
StartUpProgress; Application.CreateForm(TF_ChooseSCSObjectsProp, F_ChooseSCSObjectsProp);
StartUpProgress; Application.CreateForm(TF_AutoTraceConnectOrder, F_AutoTraceConnectOrder);
StartUpProgress; Application.CreateForm(TF_CreateRaiseQuery, F_CreateRaiseQuery);
StartUpProgress; Application.CreateForm(TF_PrintLists, F_PrintLists);
StartUpProgress; Application.CreateForm(TF_BlockParams, F_BlockParams);
StartUpProgress; Application.CreateForm(TF_DimLineDialog, F_DimLineDialog);
StartUpProgress; Application.CreateForm(TF_ChooseComponTypes, F_ChooseComponTypes);
StartUpProgress; Application.CreateForm(TF_FloatPanel, F_FloatPanel);
StartUpProgress; Application.CreateForm(TF_EndPoints, F_EndPoints);
StartUpProgress; Application.CreateForm(TF_ComponDesignWizard, F_ComponDesignWizard);
StartUpProgress; Application.CreateForm(TF_LayersDialog, F_LayersDialog);
StartUpProgress; Application.CreateForm(TF_IncOn, F_IncOn);
StartUpProgress; Application.CreateForm(TF_Scale, F_Scale);
StartUpProgress; Application.CreateForm(TF_GridStep, F_GridStep);
StartUpProgress; Application.CreateForm(TF_NewLayer, F_NewLayer);
StartUpProgress; Application.CreateForm(TF_SizePos, F_SizePos);
StartUpProgress; Application.CreateForm(TF_OrthoLineParams, F_OrthoLineParams);
StartUpProgress; Application.CreateForm(TF_LoadColor, F_LoadColor);
StartUpProgress; Application.CreateForm(TF_SCSObjectsProp, F_SCSObjectsProp);
StartUpProgress; Application.CreateForm(TF_InterfacesAutoTrace, F_InterfacesAutoTrace);
StartUpProgress; Application.CreateForm(TF_MasterNewList, F_MasterNewList);
StartUpProgress; Application.CreateForm(TF_RaiseHeight, F_RaiseHeight);
StartUpProgress; Application.CreateForm(TF_AutoTraceType, F_AutoTraceType);
StartUpProgress; Application.CreateForm(TF_BlockEditor, F_BlockEditor);
StartUpProgress; Application.CreateForm(TF_Progress, F_Progress);
// StartUpProgress; Application.CreateForm(TF_Kalc, F_Kalc);
StartUpProgress; Application.CreateForm(TF_PEAutotraceDialog, F_PEAutotraceDialog);
StartUpProgress; Application.CreateForm(TF_PEDialogEqChoice, F_PEDialogEqChoice);
StartUpProgress; Application.CreateForm(TF_PEGetBox, F_PEGetBox);
GCreatedDMAIN := false;
GGDBMode := bkNormBase;
StartUpProgress; Application.CreateForm(TF_MAIN, F_NormBase);
GGDBMode := bkprojectManager;
StartUpProgress; Application.CreateForm(TF_MAIN, F_ProjMan);
F_ProjMan.FNormBase := F_NormBase;
F_ProjMan.FProjectMan := F_ProjMan;
F_NormBase.FNormBase := F_NormBase;
F_NormBase.FProjectMan := F_ProjMan;
end;
GProtectionType := ltLocal; // GetProtectionType;
// !!!!!! Ï Î Ä Ê Ë Þ × Å Í È Å Ê Á À Ç À Ì
GCanRemotePath := false;
if ConnecToNBWizard((ParamExists('/r') or GetBoolFromRegistry(pnShowLicenceType, False)),
false, false, GCanRemotePath) then
begin
F_ProjMan.ConnectToBase;
//F_ProjMan.ConnectToBase(ExeDir + '\Data\pm.dat');
ProgramRegisterTrial := False;
ProgramRegisterPro := True;
GLicProgCode := ProgIDToStr(ProgID);
GLicUserCode := '34291432';
(*
{$IF Defined (FINAL_SCS) AND Not Defined(TRIAL_SCS)}
try
TempList.Add('0');
except
TryHex;
end;
{$IFEND}
*)
StartUpProgress;
FSCS_Main.aOpenProject.Execute;
// Registered & Unregistered Hot Keys
Application.OnActivate := FSCS_Main.FOnAppActivate;
Application.OnDeactivate := FSCS_Main.aUnregHotKeysExecute;
Application.OnMinimize := FSCS_Main.AppMinima;
Application.OnRestore := FSCS_Main.aRegHotKeysExecute;
Application.OnException := FSCS_Main.AppException;
Application.OnIdle := F_ProjMan.IdleEventHandler;
F_Splash.ProgressBar.Position := F_Splash.ProgressBar.Max;
if Assigned(F_Splash) then
FreeAndNil(F_Splash);
//F_NormBase.CheckBackUpBase; //#From Oleg#
//F_ProjMan.CheckBackUpBase; //#From Oleg#
//Application.Run;
FSCS_Main.Show;//Modal;
end;
//ExitProcess(0);
end;
end.