{$UNDEF CLR} program ExpertSCS; uses Forms, ShellApi, ActiveX, ShlObj, Registry, Windows, Dialogs, Messages, SysUtils, Classes, Graphics, ActnList, U_Common_Classes in 'Main\U_Common_Classes.pas', U_CAD in 'Main\U_CAD.pas' {F_CAD}, U_IncOn in 'Main\U_IncOn.pas' {F_IncOn}, USCS_Main in 'Main\USCS_Main.pas' {FSCS_Main}, U_Navigator in 'Main\U_Navigator.pas' {F_Navigator}, U_Scale in 'Main\U_Scale.pas' {F_Scale}, U_ActiveCurrency in 'SCSNormBase\U_ActiveCurrency.pas' {F_ActiveCurrency}, U_AddComponent in 'SCSNormBase\U_AddComponent.pas' {F_AddComponent}, U_AddInterface in 'SCSNormBase\U_AddInterface.pas' {F_AddInterface}, U_Animate in 'SCSNormBase\U_Animate.pas' {F_Animate}, U_AnswerToQuast in 'SCSNormBase\U_AnswerToQuast.pas' {F_AnswerToQuast}, U_CanDelete in 'SCSNormBase\U_CanDelete.pas' {F_CanDelete}, U_CaseForm in 'SCSNormBase\U_CaseForm.pas' {F_CaseForm}, U_Connect in 'SCSNormBase\U_Connect.pas' {F_Connect}, U_ImageShow in 'SCSNormBase\U_ImageShow.pas' {F_ImageShow}, U_InputBox in 'SCSNormBase\U_InputBox.pas' {F_InputBox}, U_MakeCurrency in 'SCSNormBase\U_MakeCurrency.pas' {F_MakeCurrency}, U_MakeProperty in 'SCSNormBase\U_MakeProperty.pas' {F_MakeProperty}, U_NDS in 'SCSNormBase\U_NDS.pas' {F_NDS}, Unit_DM_SCS in 'SCSNormBase\Unit_DM_SCS.pas' {DM: TDataModule}, U_ESCadClasess in 'CadEngine\U_ESCadClasess.pas', U_Common in 'Main\U_Common.pas', U_GridStep in 'Main\U_GridStep.pas' {F_GridStep}, U_SCSClasses in 'SCSNormBase\U_SCSClasses.pas', U_SCSComponent in 'SCSNormBase\U_SCSComponent.pas', U_Layers in 'Main\U_Layers.pas' {F_LayersDialog}, U_NewLayer in 'Main\U_NewLayer.pas' {F_NewLayer}, U_MAIN in 'SCSNormBase\U_MAIN.pas' {F_MAIN}, U_SizePos in 'Main\U_SizePos.pas' {F_SizePos}, U_SCSEngineTest in 'SCSEngine\U_SCSEngineTest.pas', U_OrtholineParams in 'Main\U_OrtholineParams.pas' {F_OrthoLineParams}, U_LoadColor in 'Main\U_LoadColor.pas' {F_LoadColor}, U_BaseCommon in 'SCSNormBase\U_BaseCommon.pas', U_Norms in 'SCSNormBase\U_Norms.pas' {F_Norms}, U_MakeNorm in 'SCSNormBase\U_MakeNorm.pas' {F_MakeNorm}, U_Splash in 'Main\U_Splash.pas' {F_Splash}, U_ChoiceConnectSide in 'SCSNormBase\U_ChoiceConnectSide.pas' {F_ChoiceConnectSide}, U_ResourceReport in 'SCSNormBase\U_ResourceReport.pas' {F_ResourceReport}, U_BaseSettings in 'SCSNormBase\U_BaseSettings.pas', U_SCSObjectsProp in 'Main\U_SCSObjectsProp.pas' {F_SCSObjectsProp}, U_InterfacesAutoTrace in 'Main\U_InterfacesAutoTrace.pas' {F_InterfacesAutoTrace}, U_InterfaceInfo in 'SCSNormBase\U_InterfaceInfo.pas' {F_InterfaceInfo}, U_MasterNewList in 'Main\U_MasterNewList.pas' {F_MasterNewList}, U_MakeEditComponentType in 'SCSNormBase\U_MakeEditComponentType.pas' {F_MakeEditComponentType}, U_RaiseHeight in 'Main\U_RaiseHeight.pas' {F_RaiseHeight}, U_MarkMask in 'SCSNormBase\U_MarkMask.pas' {F_MarkMask}, U_ComponTypesMarkMask in 'SCSNormBase\U_ComponTypesMarkMask.pas' {F_ComponTypesMarkMask}, U_AutoTraceType in 'Main\U_AutoTraceType.pas' {F_AutoTraceType}, U_MakeEditInterfaceAccordance in 'SCSNormBase\U_MakeEditInterfaceAccordance.pas' {F_MakeEditInterfaceAccordance}, U_BlockEditor in 'Main\U_BlockEditor.pas' {F_BlockEditor}, U_ConnectComplWith in 'SCSNormBase\U_ConnectComplWith.pas' {F_ConnectComplWith}, U_MakeEditObjectIcons in 'SCSNormBase\U_MakeEditObjectIcons.pas' {F_MakeEditObjectIcons}, U_MakeEditInterfNorm in 'SCSNormBase\U_MakeEditInterfNorm.pas' {F_MakeEditInterfNorm}, U_Progress in 'Main\U_Progress.pas' {F_Progress}, U_ProtectionBase in 'Protection\U_ProtectionBase.pas', U_ProtectionCommon in 'Protection\U_ProtectionCommon.pas', U_Protection in 'Protection\U_Protection.pas', {$IF Not Defined(SCS_SPA) or Defined(TRIAL_SCS) or Defined(PROCAT_SCS)} {$IF Defined(TRIAL_SCS)} U_ProtRutin in 'Protection\U_ProtRutin.pas', {$ELSE} U_ProtRutinP in 'Protection\U_ProtRutinP.pas', {$IFEND} {$ELSE} {$IF Defined (SCS_SPA)} U_ProtRutinSPA in 'Protection\U_ProtRutinSPA.pas', {$IFEND} {$IFEND} U_Registration in 'Protection\U_Registration.pas', U_USB in 'Protection\U_USB.pas', Ioctl in 'Protection\Ioctl.pas', U_ImportDXF in 'CadEngine\U_ImportDXF.pas', U_ExportDXF in 'CadEngine\U_ExportDXF.pas', LoadDXF in 'CadEngine\LoadDXF.pas', U_ObjectParams in 'SCSNormBase\U_ObjectParams.pas' {F_ObjectParams}, U_BaseOptions in 'SCSNormBase\U_BaseOptions.pas' {F_BaseOptions}, U_ComponDesignWizard in 'Main\U_ComponDesignWizard.pas' {F_ComponDesignWizard}, U_BaseUpdate in 'SCSNormBase\U_BaseUpdate.pas', U_MakeEditCrossConnection in 'SCSNormBase\U_MakeEditCrossConnection.pas' {F_MakeEditCrossConnection}, U_MakeEditPortInterfRel in 'SCSNormBase\U_MakeEditPortInterfRel.pas' {F_MakeEditPortInterfRel}, U_frOLEExl in 'SCSNormBase\U_frOLEExl.pas' {frOLEExcelSet}, U_Preview in 'SCSNormBase\U_Preview.pas' {F_Preview}, U_ProgressExp in 'SCSNormBase\U_ProgressExp.pas' {F_ProgressExp}, U_DimLineDialog in 'Main\U_DimLineDialog.pas' {F_DimLineDialog}, fplan in '..\PowerCAD30\Plugin Source\FPLAN\fplan.pas', U_SmetaExport in 'SCSNormBase\U_SmetaExport.pas' {F_SmetaExport}, U_MakeEditSupplyKind in 'SCSNormBase\U_MakeEditSupplyKind.pas' {F_MakeEditSupplyKind}, U_MakeEditProducer in 'SCSNormBase\U_MakeEditProducer.pas' {F_MakeEditProducer}, U_MakeEditInterface in 'SCSNormBase\U_MakeEditInterface.pas' {F_MakeEditInterface}, U_MakeEditPropRel in 'SCSNormBase\U_MakeEditPropRel.pas' {F_MakeEditPropRel}, U_MakeEditObjCurrency in 'SCSNormBase\U_MakeEditObjCurrency.pas' {F_MakeEditObjCurrency}, U_ConfiguratorUpdateInfo in 'SCSNormBase\U_ConfiguratorUpdateInfo.pas' {F_ConfiguratorUpdateInfo}, U_ReportForm in 'SCSNormBase\U_ReportForm.pas' {F_ReportForm}, {$IF Defined (SCS_RF)} U_AboutRF in 'Main\U_AboutRF.pas' {F_About}, {$ELSE} U_About in 'Main\U_About.pas' {F_About}, {$IFEND} {$IF Defined(TRIAL_SCS) or Defined(PROCAT_SCS) or Defined(SCS_SPA)} U_MessEnd in 'Main\U_MessEnd.pas' {F_MessEnd}, {$IFEND} U_UpdateNormBaseDialog in 'SCSNormBase\U_UpdateNormBaseDialog.pas' {F_UpdateNormBaseDialog}, U_FindParams in 'SCSNormBase\U_FindParams.pas' {F_FindParams}, U_ImportDBF in 'SCSNormBase\U_ImportDBF.pas' {F_ImportDBF}, U_MasterCableCanalTracing in 'SCSNormBase\U_MasterCableCanalTracing.pas' {F_MasterCableCanalTracing}, U_SCSLists in 'SCSNormBase\U_SCSLists.pas', U_ChooseComponTypes in 'Main\U_ChooseComponTypes.pas' {F_ChooseComponTypes}, U_ProjectPlan in 'Main\U_ProjectPlan.pas', U_FloatPanel in 'Main\U_FloatPanel.pas' {F_FloatPanel}, U_EndPoints in 'Main\U_EndPoints.pas' {F_EndPoints}, U_CadNormsProp in 'Main\U_CadNormsProp.pas' {F_CadNormsProp}, U_CadNormsList in 'Main\U_CadNormsList.pas' {F_CadNormsList}, U_TrunkSCS in 'Main\U_TrunkSCS.pas', U_Constants in 'Main\U_Constants.pas', U_DXFEngineSCS in 'Main\U_DXFEngineSCS.pas', U_ChooseDesignBoxParams in 'Main\U_ChooseDesignBoxParams.pas' {F_ChooseDesignBoxParams}, U_ChooseSCSObjectsProp in 'Main\U_ChooseSCSObjectsProp.pas' {F_ChooseSCSObjectsProp}, U_AutoTraceConnectOrder in 'Main\U_AutoTraceConnectOrder.pas' {F_AutoTraceConnectOrder}, U_CreateRaiseQuery in 'Main\U_CreateRaiseQuery.pas' {F_CreateRaiseQuery}, U_PrintLists in 'Main\U_PrintLists.pas' {F_PrintLists}, U_FilterConfigurator in 'SCSNormBase\U_FilterConfigurator.pas' {F_FilterConfigurator}, U_BlockParams in 'Main\U_BlockParams.pas' {F_BlockParams}, U_ProtectionBaseParams in 'Protection\U_ProtectionBaseParams.pas' {F_ProtectionBaseParams}, U_CurrencyPreparer in 'SCSNormBase\U_CurrencyPreparer.pas' {F_CurrencyPreparer}, U_MasterUpdatePrice in 'SCSNormBase\U_MasterUpdatePrice.pas' {F_MasterUpdatePrice}, U_BackUpBase in 'SCSNormBase\U_BackUpBase.pas' {F_BackUpBase}, U_IBDUP in 'SCSNormBase\U_IBDUP.pas', U_Kalc in 'SCSNormBase\U_Kalc.pas' {F_Kalc}, U_Kalc_DM in 'SCSNormBase\U_Kalc_DM.pas' {Kalc_DM}, U_LoginUser in 'SCSNormBase\U_LoginUser.pas' {F_LoginUser}, U_UsersEditor in 'SCSNormBase\U_UsersEditor.pas' {F_UsersEditor}, U_MakeEditPass in 'SCSNormBase\U_MakeEditPass.pas' {F_MakeEditPass}, U_LNG in 'Main\U_LNG.pas' {F_LNG}, U_BaseConstants in 'SCSNormBase\U_BaseConstants.pas', U_UserInfo in 'SCSNormBase\U_UserInfo.pas' {F_UserInfo}, U_BaseConnectParams in 'SCSNormBase\U_BaseConnectParams.pas' {F_BaseConnectParams}, U_MakeMarkPage in 'SCSNormBase\U_MakeMarkPage.pas' {F_MakeMarkPage}, U_PEAutoTraceDialog in 'SCSNormBase\U_PEAutotraceDialog.pas' {F_PEAutotraceDialog}, U_PECommon in 'SCSNormBase\U_PECommon.pas', U_PEDialogEqChoice in 'SCSNormBase\U_PEDialogEqChoice.pas' {F_PEDialogEqChoice}, U_PEGetBox in 'SCSNormBase\U_PEGetBox.pas' {F_PEGetBox}, U_ItemsSelector in 'SCSNormBase\U_ItemsSelector.pas' {F_ItemsSelector}, U_ChooseListForTrunk in 'Main\U_ChooseListForTrunk.pas' {F_ChooseListForTrunk}, U_MasterComplCommon in 'SCSNormBase\U_MasterComplCommon.pas', U_ParamMasterCompl in 'SCSNormBase\U_ParamMasterCompl.pas' {F_ParamMasterCompl}, U_Master_compl in 'SCSNormBase\U_Master_compl.pas' {F_MasterCompl}, Form3d_Save in '..\PowerCAD30\Units\Form3d_Save.pas' {frm3D_Save}, U_HouseClasses in 'CadEngine\U_HouseClasses.pas', U_MasterDefectAct in 'SCSNormBase\U_MasterDefectAct.pas' {F_MasterDefectAct}, U_MakeUpdateBlock in 'SCSNormBase\U_MakeUpdateBlock.pas' {F_MakeUpdateBlock}, U_MasterNewListLite in 'Main\U_MasterNewListLite.pas' {F_MasterNewListLite}, U_ChoiceComponType in 'SCSNormBase\U_ChoiceComponType.pas' {F_ChoiceComponType}, U_ConfGroups in 'SCSNormBase\U_ConfGroups.pas' {F_ConfGroups}, U_ArchCommon in 'Arch\U_ArchCommon.pas', U_ArchRoomParams in 'Arch\U_ArchRoomParams.pas' {F_ArchRoomParams}, U_ArchWndDoorParams in 'Arch\U_ArchWndDoorParams.pas' {F_ArchWndDoorParams}, U_ArchNicheParams in 'Arch\U_ArchNicheParams.pas' {F_ArchNicheParams}, U_ArchWallParams in 'Arch\U_ArchWallParams.pas' {F_ArchWallParams}, U_ArchBalconyParams in 'Arch\U_ArchBalconyParams.pas' {F_ArchBalconyParams}, U_ArchClasses in 'Arch\U_ArchClasses.pas', U_ArchStroyCalc in 'Arch\U_ArchStroyCalc.pas', U_MakeEditGuideFile in 'SCSNormBase\U_MakeEditGuideFile.pas' {F_MakeEditGuideFile}, U_GuideFileList in 'SCSNormBase\U_GuideFileList.pas' {F_GuideFileList}, U_SCSInterfPath in 'SCSNormBase\U_SCSInterfPath.pas', U_InputRange in 'SCSNormBase\U_InputRange.pas' {F_InputRange}, U_MasterComponToCAD in 'SCSNormBase\U_MasterComponToCAD.pas' {F_MasterComponToCAD}, U_DMCommon in 'SCSNormBase\U_DMCommon.pas' {DMCommon}, PsAPI, TlHelp32, {U_Arch3D in 'Arch\U_Arch3D.pas',} U_Arch3DNew in 'Arch\U_Arch3DNew.pas', U_ObjsProp in 'SCSNormBase\U_ObjsProp.pas' {F_ObjsProp}, U_CADObjectView in 'Main\U_CADObjectView.pas' {F_CADObjectView}, U_PDFView in 'Main\U_PDFView.pas', {F_PDFView} U_HintBar in 'Main\U_HintBar.pas' {F_HintBar}, U_HintW in 'Main\U_HintW.pas' {F_HintW}, U_ReindexMaster in 'Main\U_ReindexMaster.pas' {F_ReindexMaster}, U_InputRadio in 'SCSNormBase\U_InputRadio.pas' {F_InputRadio}, U_InputMark in 'SCSNormBase\U_InputMark.pas' {F_InputMark}, U_NormsGroups in 'SCSNormBase\U_NormsGroups.pas' {F_NormsGroups}, U_NormsComplete in 'SCSNormBase\U_NormsComplete.pas' {F_NormsComplete}, U_ChooseComponTypesForReport in 'Main\U_ChooseComponTypesForReport.pas', {параметры отчета "Координаты рабочих мест"} U_ProjectRev in 'SCSNormBase\U_ProjectRev.pas', {F_ProjectRev} //Tolik -- 12/01/2017 -- U_CheckWinVer in 'Main\U_CheckWinVer.pas', // для определения версии винды U_SetTransparency in 'Main\U_SetTransparency.pas', // задать прозрачность линейных объектов на 3Д модели U_SelLists in 'Main\U_SelLists.pas', U_RasterImageSettings in 'Main\U_RasterImageSettings.pas' {/Tolik 29/01/2020}, U_ExpXlsX in 'SCSNormBase\U_ExpXlsX.pas' {/}, U_PortsReIndex in 'SCSNormBase\U_PortsReIndex.pas' {F_PortsReIndex}, U_ELCommon in 'Main\U_ELCommon.pas'; // // //Заметки по переводу на др языки: //Строки в модулях U_Protection, U_ProtectionCommon, U_ProtectionBase переводятся отдельно const {$IF Defined(SCS_PE)} ErrorProt = '!rorrE'; {$ELSE} ErrorProt = '!анешреваз тедуб ыммаргорп атобаР .иисрев лаирт еыннад еынткерокеН'; {$IFEND} // ErrorProt1 = 'Некоректные данные триал-версии. Работа программы будет завершена!'; // EndPeriod1 = 'Период работы испытательного срока программы истек!'; // EndNumRun1 = 'Количество запусков программы на сегодня истекло!'; 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; buff: PAnsiChar; // vHandle : Cardinal; vMaskProcess, vMaskSystem : cardinal; i: integer; Action: TAction; CurrServerName, CurrLocalPath: string; GCanRemotePath: Boolean; //09.11.2007 isUAC: integer; tmplist: TStrings; COldTick, CCurrTick: Cardinal; {$IF Defined(TRIAL_SCS)} {$R expertscstrialicon.res} {$R expertscstrial.res} {$ELSE} {$IF Defined(ES_GRAPH_SC)} {$R expertarhicon.res} {$R expertarh.res} {$ELSE} {$R expertscsicon.res} {$R expertscs.res} {$IFEND} {$IFEND} procedure GetProcessList(var sl: TStrings); var pe: TProcessEntry32; ph, snap: THandle; //дескрипторы процесса и снимка mh: hmodule; //дескриптор модуля procs: array[0..$FFF] of dword; //массив для хранения дескрипторов процессов count, cm: cardinal; //количество процессов i: integer; ModName: array[0..max_path] of char; //имя модуля begin sl.Clear; if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then begin //если это Win9x snap := CreateToolhelp32Snapshot(th32cs_snapprocess, 0); if integer(snap) = -1 then begin exit; end else begin pe.dwSize := sizeof(pe); if Process32First(snap, pe) then repeat sl.Add(string(pe.szExeFile)); until not Process32Next(snap, pe); end; end else begin //Если WinNT/2000/XP if not EnumProcesses(@procs, sizeof(procs), count) then begin exit; end; for i := 0 to count div 4 - 1 do begin ph := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, false, procs[i]); if ph > 0 then begin EnumProcessModules(ph, @mh, 4, cm); GetModuleFileNameEx(ph, mh, ModName, sizeof(ModName)); sl.Add(string(ModName)); CloseHandle(ph); end; end; end; end; 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; { procedure SetLocaleInternationalSettings; begin DecimalSeparator := ','; DateSeparator := '.'; ShortDateFormat := 'dd.MM.yyyy'; ThousandSeparator := ' '; 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 RemoveFontResourceEx(FontName, 0, 0) then // Dont work in 98 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; GReadOnlyMode := False; ProgramRegisterPro := ProgProtection.CheckIsVerls(PRO); ProgramRegisterTrial := ProgProtection.CheckIsVerls(TRIAL); if ProgramRegisterTrial then begin GReadOnlyMode := True; ProgramRegisterPro := True; end; 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; procedure DeleteShortCut; var temp: string; Reg: TRegistry; DesktopPath: string; StartMenuPath: string; LnkFileName: string; LnkNewFileName: string; begin {$IF NOT Defined(ES_GRAPH_SC)} //удаляем иконку Триала с рабочего стола и из Пуска //********************************************************************************** try temp := GetDeskTopPath(CSIDL_DESKTOPDIRECTORY); LnkFileName := temp + cDpr_Mes3; if FileExists(Pchar(LnkFileName)) then begin FileSetAttr(LnkFileName, faArchive); DeleteFile(Pchar(LnkFileName)); end; except end; try temp := GetDeskTopPath(CSIDL_COMMON_DESKTOPDIRECTORY); LnkFileName := temp + cDpr_Mes3; if FileExists(Pchar(LnkFileName)) then begin FileSetAttr(LnkFileName, faArchive); DeleteFile(Pchar(LnkFileName)); end; except end; try temp := GetDeskTopPath(CSIDL_COMMON_STARTMENU); LnkFileName := temp + cDpr_Mes4; if FileExists(Pchar(LnkFileName)) then begin FileSetAttr(LnkFileName, faArchive); DeleteFile(Pchar(LnkFileName)); end; except end; try temp := GetDeskTopPath(CSIDL_STARTMENU); LnkFileName := temp + cDpr_Mes4; if FileExists(Pchar(LnkFileName)) then begin FileSetAttr(LnkFileName, faArchive); DeleteFile(Pchar(LnkFileName)); end; except end; try temp := GetDeskTopPath(CSIDL_STARTMENU); LnkFileName := temp + cDpr_Mes5; if FileExists(Pchar(LnkFileName)) then begin FileSetAttr(LnkFileName, faArchive); DeleteFile(Pchar(LnkFileName)); end; except end; try temp := GetDeskTopPath(CSIDL_COMMON_STARTMENU); LnkFileName := temp + cDpr_Mes5; if FileExists(Pchar(LnkFileName)) then begin FileSetAttr(LnkFileName, faArchive); DeleteFile(Pchar(LnkFileName)); end; except end; {$IFEND} end; procedure RegisterFileType(ext, FileNameFull: string); var reg: TRegistry; FileName: string; begin reg:=TRegistry.Create; try try FileName := copy(FileNameFull, 1, pos('%', FileNameFull) - 3); except FileName := FileNameFull; end; try with reg do begin RootKey:=HKEY_CLASSES_ROOT; OpenKey('.' + ext, True); WriteString('', ext + 'file'); CloseKey; CreateKey(ext + 'file'); OpenKey(ext + 'file\DefaultIcon', True); WriteString('', FileName + ',0'); CloseKey; OpenKey(ext + 'file\shell\open\command', True); WriteString('', FileNameFull); end; except end; finally Reg.CloseKey; Reg.Free; 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; procedure ContinueTrial; var InputStr: string; Req: string; TimeStr: string; begin Randomize; //TimeStr := DateTimeToStr(Now); DateTimeToString(TimeStr, 'dd.MM.yyyy H:mm:ss', Now); 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)); InputStr := InputBox(GetMess(InpKod), Req, ''); if InputStr <> '' then begin if CRC32(Req, 1) = InputStr then begin SetAllFirstDateTr1; end; end; 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; begin GDatabaseName := ''; GLicExt := '.lic'; //DefFontData.Name := 'GOST'; DefFontData.Name := 'Arial'; // DefFontData.Name := 'Courier New'; // 'Arial'; // DefFontData.Name := 'MS Sans Serif'; //DefFontData.Name := 'Verdana'; //DefFontData.Name := 'Times New Roman'; COldTick := GetTickCount; // ShowMessage('1'); IsVista := False; // Tolik 23/02/2017 -- if U_CheckWinVer.Win32MajorVersionReal < 6 then U_Common.isWinLowThenWin7 := True else begin if U_CheckWinVer.Win32MajorVersionReal = 10 then U_Common.isWin10 := True; end; U_Common.GUserObjectsQuota := U_Common.GetUserObjectsQuota; // // // if ParamStr(1) = '/VISTA' then // IsVista := True; if DetectWinVersion = wvVista then IsVista := True; GExitProgEx := False; //system.IsMultiThread := false; system.IsMultiThread := true; OpenFileAtStart := ''; GNowOpen := False; GIsProgress := False; try if ParamCount > 0 then begin OpenFileAtStart := Paramstr(1); // showmessage(OpenFileAtStart); if Not FileExists(OpenFileAtStart) then OpenFileAtStart := ''; end; except end; {$IF Defined(SCS_PE) or Defined(FLASH_SCS) or Defined(TRIAL_SCS) or Defined(ES_GRAPH_SC)} try if ParamExists('/remove_fonts') then RemoveFonts; except end; {$ELSE} try // на 8.1 и 10-ке у некоторых пользователей вызывает полное зависание запуска - даже в приложениях не появляется {TODO} //Найти такую систему и разобраться какого оно внутри виснет} if not ParamExists('/not_remove_fonts') then begin if (OpenFileAtStart = '') then begin RemoveFonts; end; end; except end; {$IFEND} {$IF Defined(FLASH_SCS)} HMutexSCS := CreateMutex(nil, False, 'OneCopyExpertSCSF' + VersionEXE); {$ELSE} HMutexSCS := CreateMutex(nil, False, 'OneCopyExpertSCS' + VersionEXE); {$IFEND} // ShowMessage('2'); Application.Initialize; // ShowMessage('3'); if WaitForSingleObject(hMutexSCS,0) <> wait_TimeOut then begin try //SetInternationalSettings; 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; SetCurrentDir(ExeDir); try // Tolik 24/06/2019 -- s := GetEnvironmentVariable('tmp'); if s <> '' then if not DirectoryExists(s, true) then ForceDirectories(s); s := GetEnvironmentVariable('temp'); if s <> '' then if not DirectoryExists(s, true) then ForceDirectories(s); { 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 // Tolik 24/06/2019 -- // freemem(buff); end; try {$IF Not Defined(ES_GRAPH_SC)} RegisterFileType('scs', Application.ExeName + ' "%1"'); {$IFEND} except end; {$IF Defined(SCS_PE) or Defined(SCS_PANDUIT)} try // БЛЯ - НЕЛЬЗЯ manifest чтобы был - ломается работа переключателей на нижней панели КАДа DeleteFile(Application.ExeName + '.manifest'); except end; {$IFEND} TempDir := ''; IDESerialG := ''; DateID := GetDateID; ProgProtection := TProtection.Create; ProgID := StrToProgID('1111111111111111'); NtOS := (Win32Platform = VER_PLATFORM_WIN32_NT); { FOR NO_CODE VER (NOT FINAL DEF) if (Trunc(now) > 41973) or (Trunc(now) < 41920) then begin ExitProcess(0); end; } F_Splash := TF_Splash.Create(F_Splash); F_Splash.ProgressBar.Max := 39; F_Splash.ProgressBar.Step := 1; F_Splash.lbVersion.Caption := 'v.' + VersionEXE; { FOR NO_CODE VER (NOT FINAL DEF) F_Splash.lbWorkVersion.Width := 0; F_Splash.lbWorkVersion.Height := 0; F_Splash.lbWorkVersion.Top := -1000; F_Splash.lbWorkVersion.Left := -1000; //41921 - 09.10.2014; //41973 - 30.11.2014; //ShowMessage(IntToStr(Trunc(now))); Randomize; if Trunc(now) > 41974 then begin GReadOnlyMode := True; DeleteFile(Application.ExeNAme + '.lic'); GLicExt := GLicExt + IntToStr(Random(1000)); // ExitProcess(0); end else GReadOnlyMode := False; } F_Splash.Show; F_Splash.Refresh; {$IF Defined(TELECOM)} Application.Title := 'Эксперт-Телеком'; {$ELSEIF Defined(SCS_PE) or Defined(SCS_PANDUIT)} {$IF Defined(SCS_PANDUIT)} Application.Title := 'Panduit Network CAD'; {$ELSE} Application.Title := 'CableProject CAD'; {$IFEND} {$ELSE} {$IF Defined(SCS_SPA)} Application.Title := 'TelcoCAD'; {$ELSE} {$IF DEFINED(OEM_NIKOMAX)} Application.Title := 'Эксперт-СКС NIKOMAX'; {$ELSE} Application.Title := 'Эксперт-СКС'; {$IFEND} {$IFEND} {$IFEND} Application.HelpFile := 'HELP\HELP.HLP'; Reg := TRegistry.Create; try Reg.RootKey := HKEY_LOCAL_MACHINE; if Reg.OpenKeyReadOnly('SOFTWARE\Yaffil') then begin TempPath := ''; TempPath := Reg.ReadString('RootDirectory'); if TempPath <> '' then begin if TempPath[length(TempPath)] <> '\' then TempPath := TempPath + '\'; if Not FileExists(TempPath + 'UDF\SCSDB.dll') then begin try if Not CopyFile(PChar(ExeDir + '\SCSDB.dll'), PChar(TempPath + 'UDF\SCSDB.dll'), True) then ;//ShowMessage(cDpr_Mes1); except //ShowMessage(cDpr_Mes1); end; end; end; end; finally Reg.Free; end; Reg := TRegistry.Create; try Reg.RootKey := HKEY_LOCAL_MACHINE; if Reg.OpenKeyReadOnly('SOFTWARE\FirebirdSQL\Firebird\CurrentVersion') then begin TempPath := ''; TempPath := Reg.ReadString('RootDirectory'); if TempPath <> '' then begin if TempPath[length(TempPath)] <> '\' then TempPath := TempPath + '\'; if Not FileExists(TempPath + 'UDF\SCSDB.dll') then begin try if Not CopyFile(PChar(ExeDir + '\SCSDB.dll'), PChar(TempPath + 'UDF\SCSDB.dll'), True) then ;//ShowMessage(cDpr_Mes1); except //ShowMessage(cDpr_Mes1); end; end; end; end; finally Reg.Free; end; Reg := TRegistry.Create; try Reg.RootKey := HKEY_LOCAL_MACHINE; if Reg.OpenKeyReadOnly('SOFTWARE\Firebird Project\Firebird Server\Instances') then begin TempPath := ''; TempPath := Reg.ReadString('DefaultInstance'); if TempPath <> '' then begin if TempPath[length(TempPath)] <> '\' then TempPath := TempPath + '\'; if Not FileExists(TempPath + 'UDF\SCSDB.dll') then begin try if Not CopyFile(PChar(ExeDir + '\SCSDB.dll'), PChar(TempPath + 'UDF\SCSDB.dll'), True) then ;//ShowMessage(cDpr_Mes1); except //ShowMessage(cDpr_Mes1); end; end; end; end; finally Reg.Free; end; (*Method 3 - Using Registry Editor Run Registry Editor by typing “regedit” in Start Search or command prompt. In Registry Editor, navigate to the following registry key: HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\ CurrentVersion\Policies\System Locate the following DWORD registry subkey in the right pane: EnableLUA Right click and choose modify or double click on EnableLUA to modify the setting. On valud prompt, set the new value to 0. Exit from Registry Editor. Restart the computer. To enable the UAC again, simply change back the value of EnableLUA to 1. *) (* try ExtractFromExe(HInstance, $4, U_USB.GetTempDir + '\GDI.REG'); except end; ShellExecute(0, PChar('open'), PChar('regedit.exe'), PChar('/s ' + U_USB.GetTempDir + '\GDI.REG'), PChar(U_USB.GetTempDir), SW_HIDE); *) 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 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 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; 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; try ShellExecute(0, PChar('open'), PChar('regedit.exe'), PChar(U_USB.GetTempDir + '\GDI.REG'), PChar(U_USB.GetTempDir), SW_SHOWNORMAL); except end; 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; try ShellExecute(0, PChar('open'), PChar('regedit.exe'), PChar(U_USB.GetTempDir + '\GDI.REG'), PChar(U_USB.GetTempDir), SW_SHOWNORMAL); except end; end; 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 showmessage('Need change parameter GDIProcessHandleQuota in registry' + #13#10 + ' with Administration privileges!'); NtOS := (Win32Platform = VER_PLATFORM_WIN32_NT); if ParamExists('/1') then begin try system.IsMultiThread := false; 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# GSCSIni.Environments := ReadEnvironments; //08.09.//#From Oleg# StartUpProgress; Application.CreateForm(TFSCS_Main, FSCS_Main); Application.CreateForm(TF_MasterNewListLite, F_MasterNewListLite); //Application.CreateForm(TF_PortsReIndex, F_PortsReIndex); 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_LNG, F_LNG); // {$I Inc\DelphiCrcBegin.inc} for i := 0 to FSCS_Main.ActionManager.ActionCount - 1 do begin Action := TAction(FSCS_Main.ActionManager.Actions[i]); Action.Enabled := False; end; // {$I Inc\DelphiCrcEnd.inc} {$IF Defined(SCS_PE)} F_LNG.siLangDisp.ActiveLanguage := 3; {$ELSE} {$IF Defined(SCS_SPA)} F_LNG.siLangDisp.ActiveLanguage := 6; {$ELSE} {$IF Defined(SCS_UKR)} F_LNG.siLangDisp.ActiveLanguage := 2; {$ELSE} F_LNG.siLangDisp.ActiveLanguage := 1; {$IFEND} {$IFEND} {$IFEND} //16.08.2012 Если изменился язык, сбрасываем FHandle контролов главной формы, // так как на смене языка происходит событие TextChange, в котором вызывается CreateHandle, // но размеры, например для TToolButton с FropDownMenu, не определяются из-за FUpdateCount > 0 // который увеличивается в BeginUpdate в самом начале вызова события TextChange // После сброса FHandle, он заново будет переопределен вместе с определением размеров, так как FUpdateCount будет = 0 // Для форм НБ и МП, сброс идет автоматом на присоении формам Parent-а if F_LNG.siLangDisp.ActiveLanguage <> F_LNG.siLangDisp.DefaultLanguage then FSCS_Main.RecreateHandle; F_Splash.lbVersion.Caption := 'v.' + VersionEXE; {$IF Defined(TRIAL_SCS)} {$IF Defined(SCS_PE)} FSCS_Main.Caption := ApplicationName + cMain_Mes2 + ' ' + versionEXE + cMain_Mes3 + DateEXEPE + ' Trial)'; {$ELSE} FSCS_Main.Caption := ApplicationName + cMain_Mes2 + ' ' + versionEXE + cMain_Mes3 + DateEXE + ' Trial)'; {$IFEND} {$ELSE} {$IF Defined(SCS_PE)} FSCS_Main.Caption := ApplicationName + cMain_Mes2 + ' ' + versionEXE + cMain_Mes3 + DateEXEPE + ')'; {$ELSE} FSCS_Main.Caption := ApplicationName + cMain_Mes2 + ' ' + versionEXE + cMain_Mes3 + DateEXE + ')'; {$IFEND} {$IFEND} 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_Navigator, F_Navigator); 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); StartUpProgress; Application.CreateForm(TDMCommon, DMCommon); //DMCommon := TDMCommon.Create(Application); 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; (* Commented 09.11.2007 By Oleg {$IF NOT Defined (TRIAL_SCS)} if ParamExists('/r') or GetBoolFromRegistry(pnShowLicenceType, False) then CheckProtectionBase(true); {$IFEND} *) // ExtractServerName(F_NormBase.DM.Database_SCS.DBName, CurrServerName, CurrLocalPath); // if CurrServerName = '' then // GProtectionType := ltLocal // else // begin GProtectionType := GetProtectionType; // end; {$IF Defined (TRIAL_SCS)} GProtectionType := ltLocal; {$IFEND} // !!!!!! П О Д К Л Ю Ч Е Н И Е К Б А З А М {$IF Defined (TRIAL_SCS)} GCanRemotePath := false; {$ELSE} GCanRemotePath := true; {$IFEND} tmplist := TStringList.Create; try GetProcessList(tmplist); if Pos('wcscheduler.exe', AnsiLowerCase(tmplist.Text)) > 0 then begin MessageModal(cWarningSlow, cWarningSlowCap, MB_OK or MB_ICONWARNING); end; tmplist.Free; except end; {$IF Defined (TRIAL_SCS) and Defined(SCS_PE)} if Not ConnecToNBWizard((ParamExists('/r')), false, false, GCanRemotePath) then ExitProcess(0); {$ELSE} {$IF Defined(FLASH_SCS)} if Not ConnecToNBWizard((ParamExists('/r') or GSCSIni.NB.AutoShowParams), false, false, GCanRemotePath) then ExitProcess(0); {$ELSE} if Not ConnecToNBWizard((ParamExists('/r') or GetBoolFromRegistry(pnShowLicenceType, False)), false, false, GCanRemotePath) then ExitProcess(0); {$IFEND} {$IFEND} F_ProjMan.ConnectToBase; // Commented 31.10.2007 By OLEG { if GProtectionType <> ltLocal then begin while AnsiLowerCase(F_NormBase.DM.Database_SCS.DatabaseName) <> AnsiLowerCase(GetStrFromRegistry(pnServerNameNB, '') + ':' + GetStrFromRegistry(pnLocalPathToNB, '')) do begin // F_NormBase.DM.Database_SCS.Close; GDatabaseName := GetStrFromRegistry(pnServerNameNB, '') + ':' + GetStrFromRegistry(pnLocalPathToNB, ''); ChoiceNBPath; end; end;} // INSERTED By OLEG {if GProtectionType <> ltLocal then begin while (GProtectionType <> ltLocal) and (AnsiLowerCase(F_NormBase.DM.Database_SCS.DatabaseName) <> AnsiLowerCase(GetStrFromRegistry(pnServerNameNB, '') + ':' + GetStrFromRegistry(pnLocalPathToNB, ''))) do begin // F_NormBase.DM.Database_SCS.Close; GDatabaseName := GetStrFromRegistry(pnServerNameNB, '') + ':' + GetStrFromRegistry(pnLocalPathToNB, ''); ChoiceNBPath; GProtectionType := GetProtectionType; end; end;} {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcBegin.inc} {$IFEND} {$IF Defined (FINAL_SCS)} GReadOnlyMode := False; ProgramRegisterPro := false; ProgramRegisterTrial := false; ProgID := ProgProtection.GenProgID; //showmessage(ProgIDToStr(ProgID)); ProgramRegisterPro := ProgProtection.CheckIsVer(PRO); ProgramRegisterTrial := ProgProtection.CheckIsVer(TRIAL); if ProgramRegisterTrial then begin GReadOnlyMode := True; ProgramRegisterPro := True; end; GLicProgCode := ProgIDToStr(ProgID); GLicUserCode := '34291432'; {$ELSE} ProgramRegisterTrial := False; ProgramRegisterPro := True; GLicProgCode := ProgIDToStr(ProgID); GLicUserCode := '34291432'; {$IFEND} {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcEnd.inc} {$IFEND} (* Commented 09.11.2007 By OLEG {$IF Defined (FINAL_SCS) AND Not Defined(TRIAL_SCS)} if Not ProgramRegisterPro then begin if ParamExists('/r') or GetBoolFromRegistry(pnShowLicenceType, False) then else CheckProtectionBase(true); end; {$IFEND}*) //{$IF (Defined (FINAL_SCS) AND Not Defined(TRIAL_SCS)) or (Defined(PROCAT_SCS) and not Defined(SCS_PANDUIT)) } {$IF (Defined (FINAL_SCS) AND Not Defined(TRIAL_SCS)) or (Defined(PROCAT_SCS)) } try (* if TempList = nil then TempList := TStringList.Create; TempList.Add('0'); *) RaiseException(EXCEPTION_INT_DIVIDE_BY_ZERO ,0, 0, 0); except TryHex; end; {$IFEND} {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcBegin.inc} {$IFEND} {$IF Defined(FINAL_SCS)} ProgProtection.CheckIsVerls(PRO); {$IFEND} { FOR NO_CODE VER (NOT FINAL DEF) ConnCount := 63; ConnCount := (ConnCount SHL 6) + ConnCount; ConnCount := ConnCount XOR $1978; } ConnCount := ConnCount XOR $1978; ConnCount := ConnCount SHR 6; ConnCount := ConnCount AND $0000ffff; {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcEnd.inc} {$IFEND} // ShowMessage(inttostr(ConnCount)); {$IF Not Defined (FINAL_SCS)} Application.CreateForm(TF_ImportDBF, F_ImportDBF); {$IFEND} {$IF Defined (FINAL_SCS)} // FSCS_Main.Button1.Visible := False; {$IFEND} StartUpProgress; for i := 0 to FSCS_Main.ActionManager.ActionCount - 1 do begin Action := TAction(FSCS_Main.ActionManager.Actions[i]); Action.Enabled := True; end; FSCS_Main.aOpenProject.Execute; // {$I Inc\DelphiCrcBegin.inc} for i := 0 to FSCS_Main.ActionManager.ActionCount - 1 do begin Action := TAction(FSCS_Main.ActionManager.Actions[i]); Action.Enabled := False; end; // {$I Inc\DelphiCrcEnd.inc} // 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; //Application.OnSettingChange := F_ProjMan.SettingChangeEventHandler; F_Splash.ProgressBar.Position := F_Splash.ProgressBar.Max; {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcBegin.inc} {$IFEND} if GProtectionType <> ltLocal then begin ProgProtection.CheckIsVerls(PRO); ConnCount := ConnCount XOR $1978; ConnCount := ConnCount SHR 6; ConnCount := ConnCount AND $0000ffff; // Inserted 09.11.2007 By Oleg {$IF Not Defined (FINAL_SCS)} ConnCount := GetCurrConnectionCount; {$IFEND} if GetCurrConnectionCount > ConnCount then ExitProcess(0); end; {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcEnd.inc} {$IFEND} //*** Сервер лицензирования if Not IsVista then begin BuildFHash; end; {$IF Defined (TRIAL_SCS)} begin BaseInfo.FirstRun := ''; BaseInfo.LastRun := ''; BaseInfo.NumberRunTr := 0; ISFirstRun := False; LogAllDate; if IsFirstRunTr then begin SetAllFirstDateTr; IsFirstRun := True; end; if NOT IsAllOkTr then begin ShowTrialError(1); TimerClose.Enabled := True; end; if IsTrialPeriodEndTr then begin ShowTrialError(2); TimerClose.Enabled := True; end; if NOT IsMayRunTr then begin ShowTrialError(3); TimerClose.Enabled := True; end; if TimerClose.Enabled then sleep(400) else TimerSave.Enabled := True; end; {$IFEND} {$IF Defined (PROCAT_SCS)} if Not GReadOnlyMode then begin BaseInfo.FirstRun := ''; BaseInfo.LastRun := ''; BaseInfo.NumberRunTr := 0; ISFirstRun := False; LogAllDate; //if IsFirstRunTr then //begin // SetAllFirstDateTr; // IsFirstRun := True; //end; if NOT IsAllOkTr then begin ShowTrialError(1); //TimerClose.Enabled := True; if Not ProgramRegisterPro or Not IsMayRunTr then GReadOnlyMode := True; end else if IsTrialPeriodEndTr then begin ShowTrialError(2); //TimerClose.Enabled := True; if Not ProgramRegisterPro or Not IsMayRunTr then GReadOnlyMode := True; end else if NOT IsMayRunTr then begin ShowTrialError(3); //TimerClose.Enabled := True; if Not ProgramRegisterPro or Not IsMayRunTr then GReadOnlyMode := True; end; if TimerClose.Enabled then sleep(400) else TimerSave.Enabled := True; end; {$IFEND} {$IF Not Defined (TRIAL_SCS) and Defined(SCS_SPA) and Defined(FINAL_SCS)} if (ProgramRegisterPro) or (ProgramRegisterTrial) then begin BaseInfo.FirstRun := ''; BaseInfo.LastRun := ''; BaseInfo.NumberRunTr := 0; ISFirstRun := False; LogAllDate; if IsFirstRunTr then begin SetAllFirstDateTr; IsFirstRun := True; end; if NOT IsAllOkTr then begin ShowTrialError(1); TimerClose.Enabled := True; end; if IsTrialPeriodEndTr then begin ShowTrialError(2); TimerClose.Enabled := True; end; if NOT IsMayRunTr then begin ShowTrialError(3); TimerClose.Enabled := True; end; if TimerClose.Enabled then sleep(400) else TimerSave.Enabled := True; end; {$IFEND} {$IF Not Defined (TRIAL_SCS)} DeleteShortCut; {$IFEND} if Assigned(F_Splash) then FreeAndNil(F_Splash); // if Ntos then // begin // vHandle := FSCS_Main.Handle; // SetProcessAffinityMask(vHandle, 1); // or 1 // GetProcessAffinityMask(vHandle, vMaskProcess, vMaskSystem); // showmessage(inttostr(vMaskProcess)); // showmessage(inttostr(vMaskSystem)); // end; // {$I Inc\DelphiCrcBegin.inc} if Not IsVista then begin Source := TMemoryStream.Create; GetMem(buff, 16); try TMemoryStream(Source).LoadFromFile(Application.ExeName + GLicExt); Source.Position := 0; Source.ReadBuffer(buff^, 16); except end; Source.Free; try GetMem(bufflic, 16); GetLic; except bufflic := buff; end; end; {$IF Defined (TRIAL_SCS) or Defined (FINAL_SCS)} if IsVista then begin for i := 0 to FSCS_Main.ActionManager.ActionCount - 1 do begin Action := TAction(FSCS_Main.ActionManager.Actions[i]); Action.Enabled := True; end; end else begin for i := 0 to FSCS_Main.ActionManager.ActionCount - 1 do begin try Action := TAction(FSCS_Main.ActionManager.Actions[i + (ord(buff[i mod 16]) XOR $3A) - Digest[i mod 16]]); if (inttostr((ord(buff[i mod 16]) - (Digest[i mod 16] XOR $3A))) + inttostr((ord(buff[(i + 1) mod 16]) - (Digest[(i + 1) mod 16] XOR $3A)))) = '00' then Action.Enabled := (ord(buff[i mod 16]) - (Digest[i mod 16] XOR $3A) = 0); except end; end; end; // for i := 0 to FSCS_Main.ActionManager.ActionCount - 1 do // begin // Action := TAction(FSCS_Main.ActionManager.Actions[i]); // if Not Action.Enabled then // beep; // end; {$ELSE} for i := 0 to FSCS_Main.ActionManager.ActionCount - 1 do begin Action := TAction(FSCS_Main.ActionManager.Actions[i]); Action.Enabled := True; end; {$IFEND} // FreeMem(buff); // {$I Inc\DelphiCrcEnd.inc} CCurrTick := GetTickCount - COldTick; CCurrTick := GetTickCount - COldTick; F_NormBase.CheckBackUpBase; //#From Oleg# F_ProjMan.CheckBackUpBase; //#From Oleg# { FOR NO_CODE VER (NOT FINAL DEF) if (GLicExt <> '.lic') or (Not FileExists(Application.ExeNAme + '.lic')) then begin for i := 0 to FSCS_Main.ActionManager.ActionCount - 1 do begin Action := TAction(FSCS_Main.ActionManager.Actions[i]); Action.Enabled := False; end; end; } // ReportMemoryLeaksOnShutdown := DebugHook <> 0; // Tolik 11/12/2019 -- рапортует об утечках памяти при закрытии приложения Application.Run; ExitProcess(0); //01.04.2009 WriteControls(GSCSIni.Controls); //#From Oleg# end else begin SetLength(ModuleName, 200); GetModuleFileName(HInstance, PChar(ModuleName), length(ModuleName)); ModuleName := PChar(ModuleName); FoundWnd := 0; EnumWindows(@EnumWndProc, 0); if FoundWnd <> 0 then begin if OpenFileAtStart <> '' then begin cd.cbData := Length(OpenFileAtStart) + 1; cd.lpData := PChar(OpenFileAtStart); SendMessage(FoundWnd, WM_COPYDATA, 0, LParam(@cd)); end else begin if not IsWindowVisible(FoundWnd) then SendMessage(FoundWnd, WM_USER, 0, 0); end; SetForegroundWindow(foundWnd); end; ExitProcess(0); end; end.