302 lines
9.7 KiB
Plaintext
302 lines
9.7 KiB
Plaintext
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;
|
|
{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;
|
|
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);
|
|
UserGuideM.Caption:= GetLocalizedString(cdeg_mainfrm_userguidem);
|
|
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;
|
|
begin
|
|
ConfigFile:= GetCDEPath + 'configs\configs.json';
|
|
DrivesLst:= TStringListUTF8.Create;
|
|
with DrivesLst do
|
|
begin
|
|
Delimiter:= ';';
|
|
Sorted:= True;
|
|
DelimitedText:= JSReadString('/drivewatcher/driveslist', '', ConfigFile);
|
|
end;
|
|
case JSReadInteger('/filter/type', 0, ConfigFile) of
|
|
0: ;
|
|
1: begin
|
|
SL.DelimitedText:= ;
|
|
SL.Sort;
|
|
Result:= not (SL.Find(ADisc, i));
|
|
end;
|
|
2: begin
|
|
SL.DelimitedText:= JSReadString('/filter/blacklist', '', ConfigFile);
|
|
SL.Sort;
|
|
Result:= SL.Find(ADisc, i);
|
|
end;
|
|
end;
|
|
FreeAndNil(DrivesLst);
|
|
end;
|
|
end.
|