241 lines
7.6 KiB
Plaintext
241 lines
7.6 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;
|
|
{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;
|
|
function GetFrame: Tcde_disc_frm; STDCALL;
|
|
procedure ShowSettings (const APageIndx: Integer = 0); STDCALL;
|
|
procedure ShowAboutInfo; 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);
|
|
//DriveListLbl.Caption:= GetLocalStrA(1);
|
|
//UpdateListBtn.Caption:= GetLocalStrA(2);
|
|
//EjectNowBtn.Caption:= GetLocalStrA(3);
|
|
//CreateLinkForEjectBtn.Caption:= GetLocalStrA(4);
|
|
//LNGFile:= GetCDEPath + 'language\' + GetLanguage + '.lng';
|
|
//LanguageNameLbl.Caption:= Format(GetLocalStrA(5), [INIReadString('lng_about', 'lng_name', 'default', LNGFile)]);
|
|
//LanguageTranslatorLbl.Caption:= Format(GetLocalStrA(6), [INIReadString('lng_about', 'lng_author', 'Alexander Babaev', LNGFile)]);
|
|
//LanguageVersionLbl.Caption:= Format(GetLocalStrA(7), [INIReadString('lng_about', 'lng_vers', '1.0', LNGFile)]);
|
|
//ChangeLanguageBtn.Caption:= '&' + GetLocalStrA(8);
|
|
//HomePageBtn.Caption:= GetLocalStrA(10);
|
|
//LanguageBox.Caption:= GetLocalStrA(23);
|
|
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);
|
|
UpdateDriveInfo;
|
|
end;
|
|
end;
|
|
function FormatStrUDI (const AStr: String; const ADiscInfo: TDiscInfo): String;
|
|
begin
|
|
Result:= FormatStr(AStr, [
|
|
'$letter$',
|
|
'$volumename$',
|
|
'$filesystrem$',
|
|
'$serial$'
|
|
],
|
|
[
|
|
ADiscInfo.diDrive,
|
|
ADiscInfo.diVolumeName,
|
|
ADiscInfo.diFileSystem,
|
|
IntToStr(ADiscInfo.diSerial)
|
|
]
|
|
);
|
|
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;
|
|
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;
|
|
end.
|