Alexander c585c2f0cb Initial
Исходный код версии 2.0
2022-05-04 07:31:33 +03:00

203 lines
5.8 KiB
Plaintext

program cdejecter;
{$mode delphi}
{$codepage UTF8}
uses Interfaces, {$IFDEF UNIX}{$IFDEF UseCThreads}cthreads,{$ENDIF}{$ENDIF} Classes, SysUtils, CustApp, ANBFormatString,
dynlibs, LazUTF8Classes, cde_dir, cde_lang, cde_types, ParamsMngr, cde_kernel, LazUTF8;
type
{ TCDEjecter }
TCDEjecter = class(TCustomApplication)
protected
procedure DoRun; override;
public
constructor Create(TheOwner: TComponent); OVERRIDE;
destructor Destroy; OVERRIDE;
procedure WriteHelp; VIRTUAL;
procedure ListDiscs (const Extendend: Boolean);
function FormatDiscInfo (const AString: String; const AInfo: TDiscInfo): String;
procedure ShowDiscInfo (const ADisc: String);
procedure EjectDisc (const ADisc: String);
procedure BuildTitle;
end;
{ TCDEjecter }
procedure TCDEjecter.DoRun;
var isHandled: Boolean;
begin
BuildTitle;
isHandled:= False;
if HasParam('list') then
begin
isHandled:= True;
ListDiscs(False);
end;
if HasParam('listex') then
begin
isHandled:= True;
ListDiscs(True);
end;
if HasParam('info') then
begin
isHandled:= True;
ShowDiscInfo(GetParamValue('info'));
end;
if HasParam('eject') then
begin
isHandled:= True;
EjectDisc(GetParamValue('eject'));
end;
if not isHandled then
WriteHelp;
// stop program loop
Terminate;
end;
constructor TCDEjecter.Create(TheOwner: TComponent);
begin
inherited Create (TheOwner);
StopOnException:= True;
end;
destructor TCDEjecter.Destroy;
begin
inherited Destroy;
end;
procedure TCDEjecter.WriteHelp;
begin
writeln(FormatStr(GetLocalizedString(cde_messages_help), ['$newline$'], [#13#10]));
end;
procedure TCDEjecter.ListDiscs (const Extendend: Boolean);
var DLL: TLibHandle;
GetCDDiscs: function: PChar;
GetVolumeInfo: function (const ADisc: WideChar): TDiscInfo;
SL: TStringListUTF8;
Msg: String;
Indx: Integer;
DInfo: TDiscInfo;
begin
Msg:= '';
SL:= TStringListUTF8.Create;
DLL:= SafeLoadLibrary('cdejecter.dll');
GetCDDiscs:= GetProcAddress(DLL, 'GetCDDiscs');
GetVolumeInfo:= GetProcAddress(DLL, 'GetVolumeInfo');
SL.Delimiter:= ';';
SL.DelimitedText:= GetCDDiscs;
if SL.Count > 0 then
for Indx:= 0 to SL.Count - 1 do
begin
DInfo:= GetVolumeInfo(WideChar(SL[Indx][1]));
if not (Trim(Msg) = '') then
Msg:= Msg + #13#10;
Msg:= Msg + SL[Indx];
if Extendend then
if DInfo.diHasInfo then
Msg:= Msg + ' - ' + DInfo.diVolumeName
else
Msg:= Msg + ' - ' + GetLocalizedString(cde_messages_nodiscorempty);
end;
FreeLibrary(DLL);
SL.Free;
WriteLn(GetLocalizedString(cde_messages_discslist));
WriteLn(Msg);
end;
function TCDEjecter.FormatDiscInfo (const AString: String; const AInfo: TDiscInfo): String;
begin
Result:= FormatStr(AString,
['$newline$',
'$letter$',
'$volumename$',
'$filesystem$',
'$serial$'
],
[#13#10,
AInfo.diDrive,
AInfo.diVolumeName,
AInfo.diFileSystem,
IntToStr(AInfo.diSerial)
]);
end;
procedure TCDEjecter.ShowDiscInfo (const ADisc: String);
var DLL: TLibHandle;
GetVolumeInfo: function (const ADisc: WideChar): TDiscInfo;
Msg: String;
DInfo: TDiscInfo;
begin
DLL:= SafeLoadLibrary('cdejecter.dll');
GetVolumeInfo:= GetProcAddress(DLL, 'GetVolumeInfo');
DInfo:= GetVolumeInfo(WideChar(ADisc[1]));
FreeLibrary(DLL);
if DInfo.diHasInfo then
Msg:= FormatDiscInfo(GetLocalizedString(cde_messages_discdesc), DInfo)
else
Msg:= FormatDiscInfo(GetLocalizedString(cde_messages_discdesconerror), DInfo);
WriteLn(GetLocalizedString(cde_messages_discinfo));
WriteLn(Msg);
end;
procedure TCDEjecter.EjectDisc (const ADisc: String);
var DLL: TLibHandle;
EjectCD: function (const ADisc: WideChar): Boolean;
GetVolumeInfo: function (const ADisc: WideChar): TDiscInfo;
Msg: String;
DInfo: TDiscInfo;
begin
DLL:= SafeLoadLibrary('cdejecter.dll');
GetVolumeInfo:= GetProcAddress(DLL, 'GetVolumeInfo');
EjectCD:= GetProcAddress(DLL, 'EjectCD');
DInfo:= GetVolumeInfo(WideChar(ADisc[1]));
if EjectCD (WideChar(ADisc[1])) then
Msg:= FormatDiscInfo(GetLocalizedString(cde_messages_ejectsuccess), DInfo)
else
Msg:= FormatDiscInfo(GetLocalizedString(cde_messages_ejecterror), DInfo);
FreeLibrary(DLL);
if not HasParam('silent') then
begin
WriteLn(GetLocalizedString(cde_messages_ejecttitle));
WriteLn(Msg);
end;
end;
procedure TCDEjecter.BuildTitle;
procedure WriteWord (const AWord: String; const hMaxLength, AMaxLength: Byte; const ASymbol: Char);
var S1, S2: String;
Indx, hLen: Byte;
begin
hLen:= UTF8Length(AWord) div 2;
S1:= '';
for Indx:= 1 to (hMaxLength - hLen) - 1 do
S1:= S1 + ASymbol;
S1:= S1 + ' ';
S2:= ' ';
for Indx:= (UTF8Length(S1) + UTF8Length(AWord)) + 2 to AMaxLength do
S2:= S2 + ASymbol;
WriteLn(S1 + AWord + S2);
end;
var StrT, StrV, StrC, StrABL: String;
MaxLength, hMaxLength, Indx: Byte;
const ASymbol: Char = '#';
begin
StrT:= 'CD Ejecter';
StrV:= GetLocalizedString(cde_version) + ' ' + GetCDEVerStr('cde');
StrC:= FormatStr(GetLocalizedString(cde_copyrights), ['$DEVYEARS$'], ['2011 - 2017']);
MaxLength:= UTF8Length(StrT);
if UTF8Length(StrV) > MaxLength then
MaxLength:= UTF8Length(StrV);
if UTF8Length(StrC) > MaxLength then
MaxLength:= UTF8Length(StrC);
MaxLength:= MaxLength + 8;
hMaxLength:= MaxLength div 2;
WriteLn(IntToStr(MaxLength));
WriteLn(IntToStr(hMaxLength));
StrABL:= '';
for Indx:= 1 to MaxLength do
StrABL:= StrABL + ASymbol;
WriteLn(StrABL);
WriteWord(StrT, hMaxLength, MaxLength, ASymbol);
WriteWord(StrV, hMaxLength, MaxLength, ASymbol);
WriteWord(StrC, hMaxLength, MaxLength, ASymbol);
WriteLn(StrABL);
WriteLn('');
end;
var Application: TCDEjecter;
{$R *.res}
begin
Application:= TCDEjecter.Create(Nil);
Application.Title:= 'CD Ejecter';
Application.Run;
Application.Free;
end.