Initial
Исходный код версии 2.0
This commit is contained in:
		
							
								
								
									
										147
									
								
								sources/cdejecter_gui/data/__history/kernel.pas;40
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										147
									
								
								sources/cdejecter_gui/data/__history/kernel.pas;40
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,147 @@ | ||||
| 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; | ||||
| {stdcall} | ||||
| procedure UpdateDL (var DL: TStringListUTF8); STDCALL; | ||||
| function GetDiscInfo (const ADisc: String): TDiscInfo; STDCALL; | ||||
| procedure CreateShortCut(ShortCutName, Parameters, FileName: string); stdcall; | ||||
| function GetDesktopDir: string; stdcall; | ||||
| procedure UpdateLanguage; stdcall; | ||||
| function ShowMessageBox (const AText: string; const AMessageType: Longint; const AMessageBtns: Longint = 0): integer; stdcall; | ||||
| procedure CreateDriveRec (const ADiscIndex: Byte); STDCALL; | ||||
| function FormatStrUDI (const AStr: String; const ADiscInfo: TDiscInfo): String; STDCALL; | ||||
| procedure EjectDrive (const ADrive: WideChar); STDCALL; | ||||
| implementation | ||||
| uses cde_MainForm, cde_disc_frame; | ||||
| 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; | ||||
| function GetDesktopDir: string; | ||||
| //var reg: TRegistry; | ||||
| begin | ||||
| //Result:= ''; | ||||
| //reg:= TRegistry.Create(KEY_READ); | ||||
| //try | ||||
| // reg.RootKey:=HKEY_CURRENT_USER; | ||||
| // if reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', false) then | ||||
| //  Result:= IncludeTrailingBackslash(reg.ReadString('Desktop')); | ||||
| // reg.CloseKey; | ||||
| // finally | ||||
| // reg.Free; | ||||
| // 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; | ||||
| function ShowMessageBox (const AText: string; const AMessageType: Longint; const AMessageBtns: Longint = 0): integer; | ||||
| begin | ||||
| MessageBeep(AMessageType); | ||||
| Result:= Application.MessageBox(pchar(AText), pchar(Application.Title), AMessageType + AMessageBtns); | ||||
| 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; | ||||
| MItem:= TMenuItem.Create(cde_Main.MainMenu); | ||||
| MItem.Caption:= FormatStrUDI(GetLocalizedString(cdeg_mainfrm_discmenuitem), DI); | ||||
| MItem.Tag:= ADiscIndex; | ||||
| MItem.OnClick:= cde_Main.DiscsMenuClick; | ||||
| 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; | ||||
|  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; | ||||
| end. | ||||
		Reference in New Issue
	
	Block a user