unit kernel; {$mode delphi} {$codepage UTF8} interface uses windows, shlobj, comobj, ActiveX, Classes, SysUtils, FileUtil, Forms, LazFileUtils, dynlibs, LazUTF8Classes, cde_types, Controls, ANBFormatString, cde_lang, ComCtrls, Menus, cde_disc_frame, cde_kernel, InterfaceBase, VCLEx, LCLVersion, cde_dir, SimplyJSON; {stdcall} procedure UpdateDL (var DL: TStringListUTF8); STDCALL; function GetDiscInfo (const ADisc: String): TDiscInfo; STDCALL; procedure CreateShortCut(ShortCutName, Parameters, FileName: String); STDCALL; procedure UpdateLanguage; stdcall; procedure CreateDriveRec (const ADiscIndex: Byte); STDCALL; function FormatStrUDI (const AStr: String; const ADiscInfo: TDiscInfo): String; STDCALL; procedure EjectDrive (const ADrive: WideChar); STDCALL; procedure CloseDrive (const ADrive: WideChar); STDCALL; function GetFrame: Tcde_disc_frm; STDCALL; procedure ShowSettings (const APageIndx: Integer = 0); STDCALL; procedure ShowAboutInfo; STDCALL; function GetDiscState (const ADisc: String): TDiscState; STDCALL; function isDriveWatcherEnabled (const ADrive: WideChar): Boolean; STDCALL; implementation uses cde_MainForm, cde_SettingsForm, cde_AboutForm; procedure UpdateDL (var DL: TStringListUTF8); var DLL: TLibHandle; GetCDDiscs: function: PChar; begin DL.Clear; DLL:= SafeLoadLibrary(CDELib); GetCDDiscs:= GetProcAddress(DLL, 'GetCDDiscs'); DL.Delimiter:= ';'; DL.DelimitedText:= GetCDDiscs; FreeLibrary(DLL); end; function GetDiscInfo (const ADisc: String): TDiscInfo; var DLL: TLibHandle; GetVolumeInfo: function (const ADisc: WideChar): TDiscInfo; begin DLL:= SafeLoadLibrary(CDELib); GetVolumeInfo:= GetProcAddress(DLL, 'GetVolumeInfo'); Result:= GetVolumeInfo(WideChar(ADisc[1])); FreeLibrary(DLL); end; procedure CreateShortCut(ShortCutName, Parameters, FileName: String); var ShellObject: IUnknown; ShellLink: IShellLink; PersistFile: IPersistFile; FName: WideString; begin ShellObject:= CreateComObject(CLSID_ShellLink); ShellLink:= ShellObject as IShellLink; PersistFile:= ShellObject as IPersistFile; with ShellLink do begin SetArguments(PChar(Parameters)); SetPath(PChar(FileName)); SetWorkingDirectory(PChar(extractfilepath(FileName))); FName:= ShortCutName; PersistFile.Save(PWChar(FName), False); end; end; procedure UpdateLanguage; begin Application.Title:= GetLocalizedString(cdeg_app_title); with cde_Main do begin Caption:= Application.Title; NoDiscFound.Caption:= GetLocalizedString(cdeg_mainfrm_nodiscsfound); DiscM.Caption:= GetLocalizedString(cdeg_mainfrm_discsm); ActionsM.Caption:= GetLocalizedString(cdeg_mainfrm_actionsm); SettingsM.Caption:= GetLocalizedString(cdeg_mainfrm_settingsm); HelpM.Caption:= GetLocalizedString(cdeg_mainfrm_helpm); RefrashM.Caption:= GetLocalizedString(cdeg_mainfrm_refrashm); BrowseM.Caption:= GetLocalizedString(cdeg_mainfrm_browsem); CreateLinkM.Caption:= GetLocalizedString(cdeg_mainfrm_createlinkm); EjectM.Caption:= GetLocalizedString(cdeg_mainfrm_ejectm); ProgramWebM.Caption:= GetLocalizedString(cdeg_mainfrm_webpagem); AboutM.Caption:= GetLocalizedString(cdeg_mainfrm_aboutm); DCloseM.Caption:= GetLocalizedString(cdeg_mainfrm_dclosem); end; end; procedure CreateDriveRec (const ADiscIndex: Byte); var DiscFrame: Tcde_disc_frm; Tab: TTabSheet; MItem: TMenuItem; DI: TDiscInfo; VDrive: WideChar; begin VDrive:= cde_Main.DiscList[ADiscIndex][1]; DI:= GetDiscInfo(VDrive); Tab:= cde_Main.DiscPages.AddTabSheet; Tab.Caption:= FormatStrUDI(GetLocalizedString(cdeg_mainfrm_discmenuitem), DI); Tab.Tag:= ADiscIndex; Tab.ImageIndex:= 4; MItem:= TMenuItem.Create(cde_Main.MainMenu); MItem.Caption:= FormatStrUDI(GetLocalizedString(cdeg_mainfrm_discmenuitem), DI); MItem.Tag:= ADiscIndex; MItem.OnClick:= cde_Main.DiscsMenuClick; MItem.ImageIndex:= 4; cde_Main.MainMenu.Items.Items[0].Add(MItem); DiscFrame:= Tcde_disc_frm.Create(cde_Main); with DiscFrame do begin Parent:= Tab; Align:= alClient; Drive:= VDrive; Tag:= ADiscIndex; Name:= 'di' + IntToStr(ADiscIndex); CreateFrm; UpdateDriveInfo; end; end; function FormatStrUDI (const AStr: String; const ADiscInfo: TDiscInfo): String; begin Result:= FormatStr(AStr, [ '$letter$', '$volumename$', '$filesystrem$', '$serial$', '$discsize$', '$discsizebyte$', '$discfree$', '$discfreebyte$', '$discbusy$', '$discbusybyte$' ], [ ADiscInfo.diDrive, ADiscInfo.diVolumeName, ADiscInfo.diFileSystem, IntToStr(ADiscInfo.diSerial), CDEFileSize2Str(ADiscInfo.diDiscSize, False), CDEFileSize2Str(ADiscInfo.diDiscSize, True), CDEFileSize2Str(ADiscInfo.diDiscFree, False), CDEFileSize2Str(ADiscInfo.diDiscFree, True), CDEFileSize2Str(ADiscInfo.diDiscSize - ADiscInfo.diDiscFree, False), CDEFileSize2Str(ADiscInfo.diDiscSize - ADiscInfo.diDiscFree, True) ] ); end; procedure EjectDrive (const ADrive: WideChar); var DLL: TLibHandle; EjectCD: function (const ADisc: WideChar): Boolean; begin DLL:= SafeLoadLibrary(CDELib); EjectCD:= GetProcAddress(DLL, 'EjectCD'); EjectCD(ADrive); FreeLibrary(DLL); end; procedure CloseDrive (const ADrive: WideChar); var DLL: TLibHandle; CloseCD: function (const ADisc: WideChar): Boolean; begin DLL:= SafeLoadLibrary(CDELib); CloseCD:= GetProcAddress(DLL, 'CloseCD'); CloseCD(ADrive); FreeLibrary(DLL); end; function GetFrame: Tcde_disc_frm; var Indx: Byte; Frame: Tcde_disc_frm; begin if not cde_Main.DiscPages.Visible then Abort; Indx:= cde_Main.DiscPages.ActivePage.Tag; Frame:= (cde_Main.FindComponent('di' + IntToStr(Indx))) as Tcde_disc_frm; Result:= Frame; end; procedure ShowSettings (const APageIndx: Integer = 0); var SettingsFrm: Tcde_Settings; Node: TTreeNode; begin SettingsFrm:= Tcde_Settings.Create(cde_Main); with SettingsFrm do begin Node:= SettingsTree.Items.Item[APageIndx]; SettingsTree.Select([Node]); ShowModal; Free; end; end; function FormatAboutText (const AText: string): string; var LCLPlatformDisplayNames: array[TLCLPlatform] of string = ('gtk (deprecated)', 'gtk 2', 'gtk 3', 'win32/win64', 'wince', 'carbon', 'qt', 'fpGUI (alpha)', 'NoGUI', 'cocoa (alpha)', 'customdraw (alpha)'); BuildLCLWidgetType: TLCLPlatform = {$IFDEF MSWindows}{$DEFINE WidgetSetDefined} lpWin32; {$ENDIF} {$IFDEF darwin}{$DEFINE WidgetSetDefined} lpCarbon; {$ENDIF} {$IFNDEF WidgetSetDefined} lpGtk2; {$ENDIF} Bits: String; function GetDefaultTargetOS: string; begin {$IFDEF FPC} Result:=lowerCase({$I %FPCTARGETOS%}); {$ENDIF} end; function GetDefaultTargetCPU: string; begin {$IFDEF FPC} Result:=lowerCase({$I %FPCTARGETCPU%}); {$ENDIF} end; function GetCompiler: string; begin {$IFDEF FPC} Result:= 'Lazarus'; {$ELSE} Result:= 'Delphi'; {$ENDIF} end; function GetCompilerVersion: string; begin {$IFDEF FPC} {$IF declared(lcl_version)} Result:= lcl_version; {$ELSE} Result:= '0.0.0.0'; {$ENDIF} {$ELSE} Result:= FloatToStr(CompilerVersion); {$ENDIF} end; function GetDefaultLCLWidgetType: TLCLPlatform; begin {$IFDEF FPC} if (WidgetSet<>nil) and (WidgetSet.LCLPlatform<>lpNoGUI) then Result:= WidgetSet.LCLPlatform else Result:= BuildLCLWidgetType; {$ENDIF} end; begin case GetBuildPlatform of ospUnknown: Bits:= '?'; ospWin32: Bits:= 'x32'; ospWin64: Bits:= 'x64'; end; Result:= FormatStr( AText, ['$version$', '$copyrights$', '$YEARS$', '$compiler$', '$compversion$', '$compparams$', '$platform$'], [GetCDEVerStr('package'), 'Alexander Babaev', YearsDevelopment, GetCompiler, GetCompilerVersion, GetDefaultTargetCPU + '-' + GetDefaultTargetOS + '-' + LCLPlatformDisplayNames[GetDefaultLCLWidgetType], Bits] ); end; procedure ShowAboutInfo; var AboutFrm: Tcde_AboutFrm; begin AboutFrm:= Tcde_AboutFrm.Create(cde_Main); with AboutFrm do begin Caption:= GetLocalizedString(cdeg_about_caption); VersionLbl.Caption:= FormatAboutText(GetLocalizedString(cdeg_about_version)); PlatformLbl.Caption:= FormatAboutText(GetLocalizedString(cdeg_about_platform)); CopyrightsLbl.Caption:= FormatAboutText(GetLocalizedString(cdeg_about_copyrights)); UsedTechnologiesLbl.Caption:= FormatAboutText(GetLocalizedString(cdeg_about_3rdpartytechno)); BuildAtLbl.Caption:= FormatAboutText(GetLocalizedString(cdeg_about_compiler)); CloseButton.Caption:= FormatAboutText(GetLocalizedString(cdeg_about_close)); ShowModal; Free; end; end; function GetDiscState (const ADisc: String): TDiscState; var DLL: TLibHandle; GDS: function (const ADisc: WideChar): TDiscState; begin DLL:= SafeLoadLibrary(CDELib); GDS:= GetProcAddress(DLL, 'GetDiscState'); Result:= GDS(WideChar(ADisc[1])); FreeLibrary(DLL); end; function isDriveWatcherEnabled (const ADrive: WideChar): Boolean; var DrivesLst: TStringListUTF8; ConfigFile: String; i: Integer; begin Result:= False; ConfigFile:= GetCDEPath + 'configs\configs.json'; DrivesLst:= TStringListUTF8.Create; with DrivesLst do begin Delimiter:= ';'; Sorted:= True; DelimitedText:= JSReadString('/drivewatcher/driveslist', '', ConfigFile); end; case JSReadInteger('/drivewatcher/type', 1, ConfigFile) of 0: Result:= False; 1: Result:= True; 2: Result:= DrivesLst.Find(ADrive, i); 3: Result:= not (DrivesLst.Find(ADrive, i)); end; FreeAndNil(DrivesLst); end; end.