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; 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; begin 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.Show; // F_Splash.Refresh; 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_LNG, F_LNG); F_LNG.siLangDisp.ActiveLanguage := 7; 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; GProtectionType := GetProtectionType; // !!!!!! П О Д К Л Ю Ч Е Н И Е К Б А З А М GCanRemotePath := false; if Not ConnecToNBWizard((ParamExists('/r') or GetBoolFromRegistry(pnShowLicenceType, False)), false, false, GCanRemotePath) then ExitProcess(0); F_ProjMan.ConnectToBase; 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.ShowModal; //ExitProcess(0); end; end; end.