commit 39c0916f1c9e23b4c52f979c404fae85e1bd0052 Author: Dennis07 Date: Sun Aug 31 19:11:20 2014 +0200 Version 1.0 DEV 1.0 Signed-off-by: Dennis07 diff --git a/Example/TScriptManager/pExample.dpr b/Example/TScriptManager/pExample.dpr new file mode 100644 index 0000000..e16618b --- /dev/null +++ b/Example/TScriptManager/pExample.dpr @@ -0,0 +1,15 @@ +program pExample; + +uses + Vcl.Forms, + uMain in 'uMain.pas' {fmMain}; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.Title := 'Example'; + Application.CreateForm(TfmMain, fmMain); + Application.Run; +end. diff --git a/Example/TScriptManager/pExample.dproj b/Example/TScriptManager/pExample.dproj new file mode 100644 index 0000000..ec42e09 --- /dev/null +++ b/Example/TScriptManager/pExample.dproj @@ -0,0 +1,176 @@ + + + {2E891DD2-BDFD-4240-86C4-F159A689E482} + 15.3 + VCL + pExample.dpr + True + Debug + Win32 + 1 + Application + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + $(BDS)\bin\delphi_PROJECTICON.ico + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + true + 1033 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + frxDB19;FireDACASADriver;FireDACSqliteDriver;bindcompfmx;DBXSqliteDriver;AbbreviaVCL;vcldbx;FireDACPgDriver;FireDACODBCDriver;VampyreImagingPackage.D2009;fmx;rtl;dbrtl;DbxClientDriver;IndySystem;FireDACCommon;bindcomp;frx19;TeeDB;vclib;inetdbbde;DBXInterBaseDriver;GR32_DSGN_RSXE5;DataSnapCommon;MiscrosoftScriptControls;pkCindyDERDXE5;Tee;vclFireDAC;xmlrtl;svnui;ibxpress;DbxCommonDriver;SVATimer_DXE5;vclimg;IndyProtocols;dbxcds;DBXMySQLDriver;PieLib;FireDACCommonDriver;MetropolisUILiveTile;djsonrt;bindengine;vclactnband;vcldb;soaprtl;bindcompdbx;vcldsnap;bindcompvcl;pkCindyPackDXE5;TeeUI;FMXTee;vclie;pkCindyIEDXE5;vclshlctrls;fmxFireDAC;FireDACADSDriver;vcltouch;pkCindyDBCtrlsPackDXE5;pkCindyDBXDXE5;LINA_D_XE5;CustomIPTransport;SynEdit_RXE5;vclribbon;VclSmp;FireDAC;dsnap;IndyIPServer;Intraweb;fmxase;vcl;IndyCore;VCLRESTComponents;GR32_RSXE5;IndyIPCommon;CloudService;CodeSiteExpressPkg;dsnapcon;FireDACIBDriver;DCEF_XE5;inet;DebenuPDFLibraryLite;fmxobj;FmxTeeUI;FireDACMySQLDriver;vclx;inetdbxpress;webdsnap;svn;fmxdae;frxe19;RESTComponents;bdertl;FireDACMSAccDriver;adortl;dbexpress;IndyIPClient;$(DCC_UsePackage) + $(BDS)\bin\default_app.manifest + + + FireDACASADriver;FireDACSqliteDriver;bindcompfmx;DBXSqliteDriver;AbbreviaVCL;FireDACPgDriver;FireDACODBCDriver;fmx;rtl;dbrtl;DbxClientDriver;IndySystem;FireDACCommon;bindcomp;vclib;DBXInterBaseDriver;DataSnapCommon;vclFireDAC;xmlrtl;ibxpress;DbxCommonDriver;vclimg;IndyProtocols;dbxcds;DBXMySQLDriver;FireDACCommonDriver;MetropolisUILiveTile;bindengine;vclactnband;vcldb;soaprtl;bindcompdbx;vcldsnap;bindcompvcl;vclie;vclshlctrls;fmxFireDAC;FireDACADSDriver;vcltouch;LINA_D_XE5;CustomIPTransport;SynEdit_RXE5;vclribbon;VclSmp;FireDAC;dsnap;IndyIPServer;Intraweb;fmxase;vcl;IndyCore;VCLRESTComponents;IndyIPCommon;CloudService;dsnapcon;FireDACIBDriver;inet;fmxobj;FireDACMySQLDriver;vclx;inetdbxpress;webdsnap;fmxdae;RESTComponents;FireDACMSAccDriver;adortl;dbexpress;IndyIPClient;$(DCC_UsePackage) + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + 1033 + true + false + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + + MainSource + + +
fmMain
+ dfm + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + + + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1031 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + + + + + + + + + + + + + + + + + + + + + + + + pExample.dpr + + + Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver + Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server + + + + + True + False + + + 12 + + + + diff --git a/Example/TScriptManager/pExample.dproj.local b/Example/TScriptManager/pExample.dproj.local new file mode 100644 index 0000000..b3811b7 --- /dev/null +++ b/Example/TScriptManager/pExample.dproj.local @@ -0,0 +1,2 @@ + + diff --git a/Example/TScriptManager/pExample.exe b/Example/TScriptManager/pExample.exe new file mode 100644 index 0000000..b13dccf Binary files /dev/null and b/Example/TScriptManager/pExample.exe differ diff --git a/Example/TScriptManager/pExample.identcache b/Example/TScriptManager/pExample.identcache new file mode 100644 index 0000000..ace7a02 Binary files /dev/null and b/Example/TScriptManager/pExample.identcache differ diff --git a/Example/TScriptManager/pExample.res b/Example/TScriptManager/pExample.res new file mode 100644 index 0000000..d6cf632 Binary files /dev/null and b/Example/TScriptManager/pExample.res differ diff --git a/Example/TScriptManager/uMain.dfm b/Example/TScriptManager/uMain.dfm new file mode 100644 index 0000000..e74c03e --- /dev/null +++ b/Example/TScriptManager/uMain.dfm @@ -0,0 +1,199 @@ +object fmMain: TfmMain + Left = 0 + Top = 0 + Caption = 'LinaComponents "TScriptManager" Example' + ClientHeight = 369 + ClientWidth = 707 + Color = clBtnFace + Constraints.MinHeight = 360 + Constraints.MinWidth = 670 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Menu = MainMenu + OldCreateOrder = False + Position = poScreenCenter + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object SynEdit: TSynEdit + Left = 0 + Top = 0 + Width = 707 + Height = 304 + Align = alClient + ActiveLineColor = clInfoBk + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -13 + Font.Name = 'Courier New' + Font.Style = [] + PopupMenu = PopupMenu + TabOrder = 0 + Gutter.Font.Charset = DEFAULT_CHARSET + Gutter.Font.Color = clWindowText + Gutter.Font.Height = -11 + Gutter.Font.Name = 'Courier New' + Gutter.Font.Style = [] + Highlighter = SynPasSyn + Lines.Strings = ( + 'program Example;' + '' + 'var' + ' Frm: TForm;' + '' + 'begin' + ' //Show form' + ' Frm := TForm.Create(Application);' + ' Frm.Position := poScreenCenter;' + ' Frm.BorderStyle := bsDialog;' + ' Frm.Caption := '#39'Demo'#39';' + ' Frm.Show;' + 'end.') + WantTabs = True + FontSmoothing = fsmNone + end + object ListBox: TListBox + Left = 0 + Top = 304 + Width = 707 + Height = 65 + Align = alBottom + BevelKind = bkSoft + BevelWidth = 4 + ItemHeight = 13 + TabOrder = 1 + end + object MainMenu: TMainMenu + Left = 8 + Top = 8 + object miFile: TMenuItem + Caption = 'File' + object miFileOpen: TMenuItem + Caption = 'Open...' + ShortCut = 16463 + OnClick = miFileOpenClick + end + object miFileSave: TMenuItem + Caption = 'Save...' + ShortCut = 16467 + OnClick = miFileSaveClick + end + object miFileSep: TMenuItem + Caption = '-' + end + object miFileClose: TMenuItem + Caption = 'Close' + OnClick = miFileCloseClick + end + end + object miEdit: TMenuItem + Caption = 'Edit' + OnClick = miEditClick + object miEditUndo: TMenuItem + Caption = 'Undo' + ShortCut = 16474 + OnClick = miEditUndoClick + end + object miEditRedo: TMenuItem + Caption = 'Redo' + ShortCut = 16473 + OnClick = miEditRedoClick + end + object miEditSep: TMenuItem + Caption = '-' + end + object miEditSelectAll: TMenuItem + Caption = 'Select all' + OnClick = miEditSelectAllClick + end + end + object miRun: TMenuItem + Caption = 'Run' + object miRunCompileExecute: TMenuItem + Caption = 'Compile && execute' + ShortCut = 16466 + OnClick = miRunCompileExecuteClick + end + object miRunLibrary: TMenuItem + AutoCheck = True + Caption = 'Load libraries' + Checked = True + OnClick = miRunLibraryClick + end + end + object miInfo: TMenuItem + Caption = 'Info' + object miInfoAbout: TMenuItem + Caption = 'About...' + OnClick = miInfoAboutClick + end + end + end + object SynPasSyn: TSynPasSyn + Options.AutoDetectEnabled = False + Options.AutoDetectLineLimit = 0 + Options.Visible = False + AsmAttri.Foreground = clMaroon + CommentAttri.Foreground = clGreen + DirectiveAttri.Foreground = clPurple + KeyAttri.Foreground = clNavy + NumberAttri.Foreground = clTeal + FloatAttri.Foreground = clTeal + HexAttri.Foreground = clTeal + StringAttri.Foreground = clTeal + CharAttri.Foreground = clTeal + SymbolAttri.Foreground = clGray + Left = 40 + Top = 8 + end + object ScriptManager: TScriptManager + OnReturn = ScriptManagerReturn + ReturnMode = srAll + ReturnStyle = srName + VarSelf = Owner + Libraries = [slClasses, slControls, slStdCtrls, slForms, slDateUtils, slComObj, slDB, slCustom] + UsePreProcessor = True + Left = 40 + Top = 40 + end + object OpenTextFileDialog: TOpenTextFileDialog + Filter = 'Source Files (*.pas)|*.pas|Include Files (*.inc)|*.inc' + Left = 72 + Top = 8 + end + object SaveTextFileDialog: TSaveTextFileDialog + Filter = 'Source Files (*.pas)|*.pas|Include Files (*.inc)|*.inc' + Left = 72 + Top = 40 + end + object PopupMenu: TPopupMenu + Left = 8 + Top = 40 + object miPopupSelectAll: TMenuItem + Caption = 'Select all' + ShortCut = 16449 + OnClick = miPopupSelectAllClick + end + object miPopupSep: TMenuItem + Caption = '-' + end + object miPopupCopy: TMenuItem + Caption = 'Copy' + ShortCut = 16451 + OnClick = miPopupCopyClick + end + object miPopupCut: TMenuItem + Caption = 'Cut' + ShortCut = 16472 + OnClick = miPopupCutClick + end + object miPopupPaste: TMenuItem + Caption = 'Paste' + ShortCut = 16470 + OnClick = miPopupPasteClick + end + end +end diff --git a/Example/TScriptManager/uMain.pas b/Example/TScriptManager/uMain.pas new file mode 100644 index 0000000..e71affd --- /dev/null +++ b/Example/TScriptManager/uMain.pas @@ -0,0 +1,193 @@ +unit uMain; + +////////////////////////////////////// +/// Lina Script Manager Example /// +/// **************************** /// +/// (c) 2014 Dennis Göhlert a.o. /// +////////////////////////////////////// + +interface + +{ Dies ist ein Beispielprojekt, um den Umgang und die mögliche Verwendeng der + TScriptManager-Komponente von LinaComponents zu veranschaulichen. + Es benötigt die SynEdit-Komponenten, um kompiliert werden zu können. + Es darf als Grundlage für eingene Projekte ohne vorherige Einwilligung + verwendet werden, solange mindestens eine LinaComponents-Unit im Projekt + verarbeitet wird. + + WICHTIG: Im Gegensatz zur Entwicklung der LinaComponents selbst wurde bei + diesem Beispielprojekt keinerlei Rücksicht auf Abwärtskompatibilität + genommen. Dieses Beispielprogramm wurde in Embarcadero Delphi XE5 + erstellt, entwickelt und kompiliert und könnte bei älteren Delphi- + Versionen zu Kompilierungsfehlern führen. } + +uses + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, SynEdit, SynEditHighlighter, + SynHighlighterPas, Vcl.StdCtrls, uBase, uScriptMgr, Vcl.ExtDlgs; + +type + TfmMain = class(TForm) + MainMenu: TMainMenu; + miFile: TMenuItem; + miFileOpen: TMenuItem; + miFileSave: TMenuItem; + miFileSep: TMenuItem; + miFileClose: TMenuItem; + miRun: TMenuItem; + miInfo: TMenuItem; + miInfoAbout: TMenuItem; + SynEdit: TSynEdit; + SynPasSyn: TSynPasSyn; + ScriptManager: TScriptManager; + ListBox: TListBox; + miEdit: TMenuItem; + miEditUndo: TMenuItem; + miEditRedo: TMenuItem; + OpenTextFileDialog: TOpenTextFileDialog; + SaveTextFileDialog: TSaveTextFileDialog; + miRunCompileExecute: TMenuItem; + miEditSep: TMenuItem; + miEditSelectAll: TMenuItem; + miRunLibrary: TMenuItem; + PopupMenu: TPopupMenu; + miPopupSelectAll: TMenuItem; + miPopupCopy: TMenuItem; + miPopupPaste: TMenuItem; + miPopupCut: TMenuItem; + miPopupSep: TMenuItem; + procedure FormCreate(Sender: TObject); + procedure miInfoAboutClick(Sender: TObject); + procedure miFileCloseClick(Sender: TObject); + procedure miEditClick(Sender: TObject); + procedure miEditUndoClick(Sender: TObject); + procedure miEditRedoClick(Sender: TObject); + procedure miFileOpenClick(Sender: TObject); + procedure miFileSaveClick(Sender: TObject); + procedure miRunCompileExecuteClick(Sender: TObject); + procedure miEditSelectAllClick(Sender: TObject); + procedure miRunLibraryClick(Sender: TObject); + procedure miPopupSelectAllClick(Sender: TObject); + procedure miPopupCopyClick(Sender: TObject); + procedure miPopupCutClick(Sender: TObject); + procedure miPopupPasteClick(Sender: TObject); + procedure ScriptManagerReturn(Sender: TObject; const Msg: string); + private + { Private-Deklarationen } + public + { Public-Deklarationen } + end; + +var + fmMain: TfmMain; + +implementation + +{$R *.dfm} + +procedure TfmMain.FormCreate(Sender: TObject); +begin + ScriptManager.VarApplication := Application; + ScriptManager.ReturnTarget := ListBox.Items; +end; + +procedure TfmMain.miInfoAboutClick(Sender: TObject); +begin + ScriptManager.About.AboutDlg; +end; + +procedure TfmMain.miPopupCopyClick(Sender: TObject); +begin + SynEdit.CopyToClipboard; +end; + +procedure TfmMain.miPopupCutClick(Sender: TObject); +begin + SynEdit.CutToClipboard; +end; + +procedure TfmMain.miPopupPasteClick(Sender: TObject); +begin + SynEdit.PasteFromClipboard; +end; + +procedure TfmMain.miPopupSelectAllClick(Sender: TObject); +begin + miEditSelectAll.Click; +end; + +procedure TfmMain.miFileCloseClick(Sender: TObject); +begin + Close; +end; + +procedure TfmMain.miRunCompileExecuteClick(Sender: TObject); +begin + ListBox.Items.Clear; + ScriptManager.CodeAssign(SynEdit.Lines); + if miRunLibrary.Checked = False then + begin + ScriptManager.VarSelf := nil; + ScriptManager.VarApplication := nil; + end; + ScriptManager.CompileAndExecute; +end; + +procedure TfmMain.miEditClick(Sender: TObject); +begin + miEditUndo.Enabled := (SynEdit.UndoList.ItemCount > 0); + miEditRedo.Enabled := (SynEdit.RedoList.ItemCount > 0); +end; + +procedure TfmMain.miRunLibraryClick(Sender: TObject); +begin + if miRunLibrary.Checked = True then + begin + ScriptManager.Libraries := [slClasses,slControls,slStdCtrls,slForms,slDateUtils,slComObj,slDB,slCustom]; + end else + begin + ScriptManager.Libraries := []; + end; +end; + +procedure TfmMain.ScriptManagerReturn(Sender: TObject; const Msg: string); +begin + ListBox.TopIndex := ListBox.Items.Count - 1; +end; + +procedure TfmMain.miFileOpenClick(Sender: TObject); +begin + if OpenTextFileDialog.Execute then + begin + SynEdit.Lines.LoadFromFile(OpenTextFileDialog.FileName); + SynEdit.UndoList.Clear; + SynEdit.RedoList.Clear; + end; +end; + +procedure TfmMain.miEditRedoClick(Sender: TObject); +begin + SynEdit.Redo; +end; + +procedure TfmMain.miFileSaveClick(Sender: TObject); +begin + if SaveTextFileDialog.Execute then + begin + SynEdit.Lines.SaveToFile(SaveTextFileDialog.FileName); + SynEdit.UndoList.Clear; + SynEdit.RedoList.Clear; + end; +end; + +procedure TfmMain.miEditSelectAllClick(Sender: TObject); +begin + SynEdit.SelectAll; +end; + +procedure TfmMain.miEditUndoClick(Sender: TObject); +begin + SynEdit.Undo; +end; + +end. diff --git a/Example/TWinFile/pExample.dpr b/Example/TWinFile/pExample.dpr new file mode 100644 index 0000000..e16618b --- /dev/null +++ b/Example/TWinFile/pExample.dpr @@ -0,0 +1,15 @@ +program pExample; + +uses + Vcl.Forms, + uMain in 'uMain.pas' {fmMain}; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.Title := 'Example'; + Application.CreateForm(TfmMain, fmMain); + Application.Run; +end. diff --git a/Example/TWinFile/pExample.dproj b/Example/TWinFile/pExample.dproj new file mode 100644 index 0000000..28035e7 --- /dev/null +++ b/Example/TWinFile/pExample.dproj @@ -0,0 +1,176 @@ + + + {D28E4737-637C-4A11-9D4B-624FB1C78C89} + 15.3 + VCL + pExample.dpr + True + Debug + Win32 + 1 + Application + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + $(BDS)\bin\delphi_PROJECTICON.ico + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + + + $(BDS)\bin\default_app.manifest + 1033 + frxDB19;FireDACASADriver;FireDACSqliteDriver;bindcompfmx;DBXSqliteDriver;AbbreviaVCL;vcldbx;FireDACPgDriver;FireDACODBCDriver;VampyreImagingPackage.D2009;fmx;rtl;dbrtl;DbxClientDriver;IndySystem;FireDACCommon;bindcomp;frx19;TeeDB;vclib;inetdbbde;DBXInterBaseDriver;GR32_DSGN_RSXE5;DataSnapCommon;MiscrosoftScriptControls;pkCindyDERDXE5;Tee;vclFireDAC;xmlrtl;svnui;ibxpress;DbxCommonDriver;SVATimer_DXE5;vclimg;IndyProtocols;dbxcds;DBXMySQLDriver;PieLib;FireDACCommonDriver;MetropolisUILiveTile;djsonrt;bindengine;vclactnband;vcldb;soaprtl;bindcompdbx;vcldsnap;bindcompvcl;pkCindyPackDXE5;TeeUI;FMXTee;vclie;pkCindyIEDXE5;vclshlctrls;fmxFireDAC;FireDACADSDriver;vcltouch;pkCindyDBCtrlsPackDXE5;pkCindyDBXDXE5;LINA_D_XE5;CustomIPTransport;SynEdit_RXE5;vclribbon;VclSmp;FireDAC;dsnap;IndyIPServer;Intraweb;fmxase;vcl;IndyCore;VCLRESTComponents;GR32_RSXE5;IndyIPCommon;CloudService;CodeSiteExpressPkg;dsnapcon;FireDACIBDriver;DebenuPDFLibraryLite;inet;FmxTeeUI;fmxobj;DCEF_XE5;FireDACMySQLDriver;vclx;inetdbxpress;webdsnap;svn;fmxdae;frxe19;RESTComponents;bdertl;FireDACMSAccDriver;adortl;dbexpress;IndyIPClient;$(DCC_UsePackage) + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + true + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + + + FireDACASADriver;FireDACSqliteDriver;bindcompfmx;DBXSqliteDriver;AbbreviaVCL;FireDACPgDriver;FireDACODBCDriver;fmx;rtl;dbrtl;DbxClientDriver;IndySystem;FireDACCommon;bindcomp;vclib;DBXInterBaseDriver;DataSnapCommon;vclFireDAC;xmlrtl;ibxpress;DbxCommonDriver;vclimg;IndyProtocols;dbxcds;DBXMySQLDriver;FireDACCommonDriver;MetropolisUILiveTile;bindengine;vclactnband;vcldb;soaprtl;bindcompdbx;vcldsnap;bindcompvcl;vclie;vclshlctrls;fmxFireDAC;FireDACADSDriver;vcltouch;LINA_D_XE5;CustomIPTransport;SynEdit_RXE5;vclribbon;VclSmp;FireDAC;dsnap;IndyIPServer;Intraweb;fmxase;vcl;IndyCore;VCLRESTComponents;IndyIPCommon;CloudService;dsnapcon;FireDACIBDriver;inet;fmxobj;FireDACMySQLDriver;vclx;inetdbxpress;webdsnap;fmxdae;RESTComponents;FireDACMSAccDriver;adortl;dbexpress;IndyIPClient;$(DCC_UsePackage) + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + 1033 + true + false + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + + MainSource + + +
fmMain
+ dfm + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + + + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1031 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + + + + + + + + + + + + + + + + + + + + + + + + pExample.dpr + + + Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver + Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server + + + + + True + False + + + 12 + + + + diff --git a/Example/TWinFile/pExample.dproj.local b/Example/TWinFile/pExample.dproj.local new file mode 100644 index 0000000..925a567 --- /dev/null +++ b/Example/TWinFile/pExample.dproj.local @@ -0,0 +1,14 @@ + + + + 1899.12.30 00:00:00.000.957,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\Unit1.pas + 1899.12.30 00:00:00.000.333,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\Unit1.pas + 1899.12.30 00:00:00.000.028,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\Unit1.pas + 1899.12.30 00:00:00.000.554,C:\Users\Dennis G\Documents\RAD Studio\Projekte\Unit1.pas=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Example\TWinFile\uMain.pas + 1899.12.30 00:00:00.000.634,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\Unit1.pas + 1899.12.30 00:00:00.000.554,C:\Users\Dennis G\Documents\RAD Studio\Projekte\Unit1.dfm=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Example\TWinFile\uMain.dfm + 1899.12.30 00:00:00.000.484,C:\Users\Dennis G\Documents\RAD Studio\Projekte\Project1.dproj=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Example\TWinFile\pExample.dproj + 1899.12.30 00:00:00.000.824,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\Unit1.pas + 1899.12.30 00:00:00.000.832,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\Unit1.pas + + diff --git a/Example/TWinFile/pExample.exe b/Example/TWinFile/pExample.exe new file mode 100644 index 0000000..ca261a5 Binary files /dev/null and b/Example/TWinFile/pExample.exe differ diff --git a/Example/TWinFile/pExample.identcache b/Example/TWinFile/pExample.identcache new file mode 100644 index 0000000..28091a2 Binary files /dev/null and b/Example/TWinFile/pExample.identcache differ diff --git a/Example/TWinFile/pExample.res b/Example/TWinFile/pExample.res new file mode 100644 index 0000000..d6cf632 Binary files /dev/null and b/Example/TWinFile/pExample.res differ diff --git a/Example/TWinFile/uMain.dfm b/Example/TWinFile/uMain.dfm new file mode 100644 index 0000000..8b98067 --- /dev/null +++ b/Example/TWinFile/uMain.dfm @@ -0,0 +1,163 @@ +object fmMain: TfmMain + Left = 0 + Top = 0 + BorderIcons = [biSystemMenu, biMinimize] + BorderStyle = bsSingle + Caption = 'LinaComponents "TWinFile" Example' + ClientHeight = 257 + ClientWidth = 434 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + Position = poScreenCenter + PixelsPerInch = 96 + TextHeight = 13 + object laOtherFiles: TLabel + Left = 8 + Top = 144 + Width = 162 + Height = 13 + AutoSize = False + Caption = 'PAS && DPR files in this directory:' + end + object laOtherFolders: TLabel + Left = 176 + Top = 144 + Width = 162 + Height = 13 + AutoSize = False + Caption = 'Folders in this directory:' + end + object edPath: TEdit + Left = 8 + Top = 8 + Width = 249 + Height = 21 + TabOrder = 0 + OnChange = edPathChange + end + object miBrowse: TButton + Left = 263 + Top = 8 + Width = 75 + Height = 21 + Caption = 'Browse...' + TabOrder = 1 + OnClick = miBrowseClick + end + object lbOtherFiles: TListBox + Left = 8 + Top = 163 + Width = 162 + Height = 86 + ItemHeight = 13 + TabOrder = 2 + end + object gbProperties: TGroupBox + Left = 8 + Top = 35 + Width = 325 + Height = 94 + Caption = 'File properties' + TabOrder = 3 + object leFileName: TLabeledEdit + Left = 63 + Top = 24 + Width = 106 + Height = 21 + EditLabel.Width = 49 + EditLabel.Height = 13 + EditLabel.Caption = 'File name:' + LabelPosition = lpLeft + ReadOnly = True + TabOrder = 0 + end + object leFileExt: TLabeledEdit + Left = 268 + Top = 24 + Width = 45 + Height = 21 + EditLabel.Width = 70 + EditLabel.Height = 13 + EditLabel.Caption = 'File extension:' + LabelPosition = lpLeft + ReadOnly = True + TabOrder = 1 + end + object leFolderName: TLabeledEdit + Left = 63 + Top = 59 + Width = 106 + Height = 21 + EditLabel.Width = 51 + EditLabel.Height = 13 + EditLabel.Caption = 'File folder:' + LabelPosition = lpLeft + ReadOnly = True + TabOrder = 2 + end + end + object lbOtherFolders: TListBox + Left = 176 + Top = 163 + Width = 162 + Height = 86 + ItemHeight = 13 + TabOrder = 4 + end + object pnButtons: TPanel + Left = 345 + Top = 0 + Width = 89 + Height = 257 + Align = alRight + TabOrder = 5 + object laExecuteMode: TLabel + Left = 8 + Top = 144 + Width = 73 + Height = 13 + AutoSize = False + Caption = 'Mode:' + end + object btExecute: TButton + Left = 8 + Top = 224 + Width = 75 + Height = 25 + Caption = 'Execute' + TabOrder = 0 + OnClick = btExecuteClick + end + object cbExecuteSafe: TCheckBox + Left = 8 + Top = 201 + Width = 73 + Height = 17 + Caption = 'Safe exec.' + TabOrder = 1 + end + object coExecuteMode: TComboBox + Left = 8 + Top = 163 + Width = 73 + Height = 21 + Style = csDropDownList + ItemIndex = 0 + TabOrder = 2 + Text = 'Open' + Items.Strings = ( + 'Open' + 'Edit') + end + end + object OpenDialog: TOpenDialog + Title = 'Select a file anywhere on your system' + Left = 400 + Top = 8 + end +end diff --git a/Example/TWinFile/uMain.pas b/Example/TWinFile/uMain.pas new file mode 100644 index 0000000..9bacf81 --- /dev/null +++ b/Example/TWinFile/uMain.pas @@ -0,0 +1,116 @@ +unit uMain; + +////////////////////////////////////// +/// Lina File Tools Example /// +/// **************************** /// +/// (c) 2014 Dennis Göhlert a.o. /// +////////////////////////////////////// + +interface + +{ Dies ist ein Beispielprojekt, um den Umgang und die mögliche Verwendeng der + TWinFile-Klasse und einiger uFileTools-Methoden von LinaComponents zu + veranschaulichen. + Es darf als Grundlage für eingene Projekte ohne vorherige Einwilligung + verwendet werden, solange mindestens eine LinaComponents-Unit im Projekt + verarbeitet wird. + + WICHTIG: Im Gegensatz zur Entwicklung der LinaComponents selbst wurde bei + diesem Beispielprojekt keinerlei Rücksicht auf Abwärtskompatibilität + genommen. Dieses Beispielprogramm wurde in Embarcadero Delphi XE5 + erstellt, entwickelt und kompiliert und könnte bei älteren Delphi- + Versionen zu Kompilierungsfehlern führen. } + +uses + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, uFileTools, Vcl.StdCtrls, Vcl.ExtCtrls; + +type + TfmMain = class(TForm) + edPath: TEdit; + miBrowse: TButton; + lbOtherFiles: TListBox; + gbProperties: TGroupBox; + leFileName: TLabeledEdit; + leFileExt: TLabeledEdit; + leFolderName: TLabeledEdit; + laOtherFiles: TLabel; + lbOtherFolders: TListBox; + laOtherFolders: TLabel; + pnButtons: TPanel; + btExecute: TButton; + cbExecuteSafe: TCheckBox; + OpenDialog: TOpenDialog; + coExecuteMode: TComboBox; + laExecuteMode: TLabel; + procedure edPathChange(Sender: TObject); + procedure miBrowseClick(Sender: TObject); + procedure btExecuteClick(Sender: TObject); + private + { Private-Deklarationen } + public + { Public-Deklarationen } + end; + +var + fmMain: TfmMain; + +implementation + +{$R *.dfm} + +procedure TfmMain.btExecuteClick(Sender: TObject); +var + CurrentFile: TWinFile; +begin + if FileExists(edPath.Text) then + begin + CurrentFile := TWinFile.Create(edPath.Text); + try + case coExecuteMode.ItemIndex of + 0: CurrentFile.ExecuteMode := feOpen; + 1: CurrentFile.ExecuteMode := feEdit; + end; + if cbExecuteSafe.Checked = True then + begin + CurrentFile.SafeExecute; + end else + begin + CurrentFile.Execute; + end; + finally + CurrentFile.Free; + end; + end; +end; + +procedure TfmMain.edPathChange(Sender: TObject); +var + CurrentFile: TWinFile; +begin + if FileExists(edPath.Text) then + begin + CurrentFile := TWinFile.Create(edPath.Text); + try + leFileName.Text := CurrentFile.GetFileName(False); + leFileExt.Text := CurrentFile.GetExtension(False); + leFolderName.Text := CurrentFile.GetFolderName; + lbOtherFolders.Items.Clear; + ListFolders(CurrentFile.GetPath,lbOtherFolders.Items); + lbOtherFiles.Items.Clear; + ListFiles(CurrentFile.GetPath,lbOtherFiles.Items,['*.pas','*.dpr'],[fnExtension]); + finally + CurrentFile.Free; + end; + end; +end; + +procedure TfmMain.miBrowseClick(Sender: TObject); +begin + if OpenDialog.Execute then + begin + edPath.Text := OpenDialog.FileName; + end; +end; + +end. diff --git a/Information/Changelog.txt b/Information/Changelog.txt new file mode 100644 index 0000000..0a87fb7 --- /dev/null +++ b/Information/Changelog.txt @@ -0,0 +1,2 @@ +== Version 1.0 ==================================================== +(initial release version) \ No newline at end of file diff --git a/Information/Credits.txt b/Information/Credits.txt new file mode 100644 index 0000000..dd3494d --- /dev/null +++ b/Information/Credits.txt @@ -0,0 +1,4 @@ +The official version of "Lina Components" with all its belongings, +elements and features is maintained by Dennis Göhlert. +Special thanks go to Sebastian Jänicke for his great help finding +solutions for countless problems. \ No newline at end of file diff --git a/Information/License.txt b/Information/License.txt new file mode 100644 index 0000000..bd095d0 --- /dev/null +++ b/Information/License.txt @@ -0,0 +1,13 @@ +"Lina Components" is free open-source software and may be used for +both personal, public purposes. It can be used non-commercially for +commercial purposes without additional limitations of usability. + +It is available under "Mozilla Public License v2.0". +A copy of the current version can be found in "MPL20.txt" file. +You can optain the current version online from www.mozilla.org. + +For a list of all authors who contributed to this project see: +"Credits.txt" file. + +INFO: Even if the code contains copyright marks or references, + they are overwritten by this document! \ No newline at end of file diff --git a/Information/Manual.txt b/Information/Manual.txt new file mode 100644 index 0000000..4bc4556 --- /dev/null +++ b/Information/Manual.txt @@ -0,0 +1,30 @@ +== Requirements =================================================== +For the compatibility version, you need to have one of these Delphi +versions installed: + +- Delphi 7 +- Delphi 2005 +- Delphi 2006 * +- Delphi 2007 +- Delphi 2009 +- Delphi 2010 +- Delphi XE +- Delphi XE2 +- Delphi XE3 +- Delphi XE4 +- Delphi XE5 +- Delphi XE6 + +*) The code will run under Turbo-Delphi 2006, but the components + won't be available in the components palett of the personal + version. + +== Installation =================================================== +1. Add the "{...}\Source" and the "{...}\Source\Compiled" Folders + to your application's library path +2. Open the corresponding packe for your Delphi version located in + {...}\Package\{DELPHI_...}\{LINA_D_...}.dpk +3. Right-click on the package and compile it +4. Right-click on the package and build it +5. Right-click on the package and install it +6. Close the package \ No newline at end of file diff --git a/Information/Resource/MPL20.txt b/Information/Resource/MPL20.txt new file mode 100644 index 0000000..f4bbcd2 --- /dev/null +++ b/Information/Resource/MPL20.txt @@ -0,0 +1,373 @@ +Mozilla Public License Version 2.0 +================================== + +1. Definitions +-------------- + +1.1. "Contributor" + means each individual or legal entity that creates, contributes to + the creation of, or owns Covered Software. + +1.2. "Contributor Version" + means the combination of the Contributions of others (if any) used + by a Contributor and that particular Contributor's Contribution. + +1.3. "Contribution" + means Covered Software of a particular Contributor. + +1.4. "Covered Software" + means Source Code Form to which the initial Contributor has attached + the notice in Exhibit A, the Executable Form of such Source Code + Form, and Modifications of such Source Code Form, in each case + including portions thereof. + +1.5. "Incompatible With Secondary Licenses" + means + + (a) that the initial Contributor has attached the notice described + in Exhibit B to the Covered Software; or + + (b) that the Covered Software was made available under the terms of + version 1.1 or earlier of the License, but not also under the + terms of a Secondary License. + +1.6. "Executable Form" + means any form of the work other than Source Code Form. + +1.7. "Larger Work" + means a work that combines Covered Software with other material, in + a separate file or files, that is not Covered Software. + +1.8. "License" + means this document. + +1.9. "Licensable" + means having the right to grant, to the maximum extent possible, + whether at the time of the initial grant or subsequently, any and + all of the rights conveyed by this License. + +1.10. "Modifications" + means any of the following: + + (a) any file in Source Code Form that results from an addition to, + deletion from, or modification of the contents of Covered + Software; or + + (b) any new file in Source Code Form that contains any Covered + Software. + +1.11. "Patent Claims" of a Contributor + means any patent claim(s), including without limitation, method, + process, and apparatus claims, in any patent Licensable by such + Contributor that would be infringed, but for the grant of the + License, by the making, using, selling, offering for sale, having + made, import, or transfer of either its Contributions or its + Contributor Version. + +1.12. "Secondary License" + means either the GNU General Public License, Version 2.0, the GNU + Lesser General Public License, Version 2.1, the GNU Affero General + Public License, Version 3.0, or any later versions of those + licenses. + +1.13. "Source Code Form" + means the form of the work preferred for making modifications. + +1.14. "You" (or "Your") + means an individual or a legal entity exercising rights under this + License. For legal entities, "You" includes any entity that + controls, is controlled by, or is under common control with You. For + purposes of this definition, "control" means (a) the power, direct + or indirect, to cause the direction or management of such entity, + whether by contract or otherwise, or (b) ownership of more than + fifty percent (50%) of the outstanding shares or beneficial + ownership of such entity. + +2. License Grants and Conditions +-------------------------------- + +2.1. Grants + +Each Contributor hereby grants You a world-wide, royalty-free, +non-exclusive license: + +(a) under intellectual property rights (other than patent or trademark) + Licensable by such Contributor to use, reproduce, make available, + modify, display, perform, distribute, and otherwise exploit its + Contributions, either on an unmodified basis, with Modifications, or + as part of a Larger Work; and + +(b) under Patent Claims of such Contributor to make, use, sell, offer + for sale, have made, import, and otherwise transfer either its + Contributions or its Contributor Version. + +2.2. Effective Date + +The licenses granted in Section 2.1 with respect to any Contribution +become effective for each Contribution on the date the Contributor first +distributes such Contribution. + +2.3. Limitations on Grant Scope + +The licenses granted in this Section 2 are the only rights granted under +this License. No additional rights or licenses will be implied from the +distribution or licensing of Covered Software under this License. +Notwithstanding Section 2.1(b) above, no patent license is granted by a +Contributor: + +(a) for any code that a Contributor has removed from Covered Software; + or + +(b) for infringements caused by: (i) Your and any other third party's + modifications of Covered Software, or (ii) the combination of its + Contributions with other software (except as part of its Contributor + Version); or + +(c) under Patent Claims infringed by Covered Software in the absence of + its Contributions. + +This License does not grant any rights in the trademarks, service marks, +or logos of any Contributor (except as may be necessary to comply with +the notice requirements in Section 3.4). + +2.4. Subsequent Licenses + +No Contributor makes additional grants as a result of Your choice to +distribute the Covered Software under a subsequent version of this +License (see Section 10.2) or under the terms of a Secondary License (if +permitted under the terms of Section 3.3). + +2.5. Representation + +Each Contributor represents that the Contributor believes its +Contributions are its original creation(s) or it has sufficient rights +to grant the rights to its Contributions conveyed by this License. + +2.6. Fair Use + +This License is not intended to limit any rights You have under +applicable copyright doctrines of fair use, fair dealing, or other +equivalents. + +2.7. Conditions + +Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted +in Section 2.1. + +3. Responsibilities +------------------- + +3.1. Distribution of Source Form + +All distribution of Covered Software in Source Code Form, including any +Modifications that You create or to which You contribute, must be under +the terms of this License. You must inform recipients that the Source +Code Form of the Covered Software is governed by the terms of this +License, and how they can obtain a copy of this License. You may not +attempt to alter or restrict the recipients' rights in the Source Code +Form. + +3.2. Distribution of Executable Form + +If You distribute Covered Software in Executable Form then: + +(a) such Covered Software must also be made available in Source Code + Form, as described in Section 3.1, and You must inform recipients of + the Executable Form how they can obtain a copy of such Source Code + Form by reasonable means in a timely manner, at a charge no more + than the cost of distribution to the recipient; and + +(b) You may distribute such Executable Form under the terms of this + License, or sublicense it under different terms, provided that the + license for the Executable Form does not attempt to limit or alter + the recipients' rights in the Source Code Form under this License. + +3.3. Distribution of a Larger Work + +You may create and distribute a Larger Work under terms of Your choice, +provided that You also comply with the requirements of this License for +the Covered Software. If the Larger Work is a combination of Covered +Software with a work governed by one or more Secondary Licenses, and the +Covered Software is not Incompatible With Secondary Licenses, this +License permits You to additionally distribute such Covered Software +under the terms of such Secondary License(s), so that the recipient of +the Larger Work may, at their option, further distribute the Covered +Software under the terms of either this License or such Secondary +License(s). + +3.4. Notices + +You may not remove or alter the substance of any license notices +(including copyright notices, patent notices, disclaimers of warranty, +or limitations of liability) contained within the Source Code Form of +the Covered Software, except that You may alter any license notices to +the extent required to remedy known factual inaccuracies. + +3.5. Application of Additional Terms + +You may choose to offer, and to charge a fee for, warranty, support, +indemnity or liability obligations to one or more recipients of Covered +Software. However, You may do so only on Your own behalf, and not on +behalf of any Contributor. You must make it absolutely clear that any +such warranty, support, indemnity, or liability obligation is offered by +You alone, and You hereby agree to indemnify every Contributor for any +liability incurred by such Contributor as a result of warranty, support, +indemnity or liability terms You offer. You may include additional +disclaimers of warranty and limitations of liability specific to any +jurisdiction. + +4. Inability to Comply Due to Statute or Regulation +--------------------------------------------------- + +If it is impossible for You to comply with any of the terms of this +License with respect to some or all of the Covered Software due to +statute, judicial order, or regulation then You must: (a) comply with +the terms of this License to the maximum extent possible; and (b) +describe the limitations and the code they affect. Such description must +be placed in a text file included with all distributions of the Covered +Software under this License. Except to the extent prohibited by statute +or regulation, such description must be sufficiently detailed for a +recipient of ordinary skill to be able to understand it. + +5. Termination +-------------- + +5.1. The rights granted under this License will terminate automatically +if You fail to comply with any of its terms. However, if You become +compliant, then the rights granted under this License from a particular +Contributor are reinstated (a) provisionally, unless and until such +Contributor explicitly and finally terminates Your grants, and (b) on an +ongoing basis, if such Contributor fails to notify You of the +non-compliance by some reasonable means prior to 60 days after You have +come back into compliance. Moreover, Your grants from a particular +Contributor are reinstated on an ongoing basis if such Contributor +notifies You of the non-compliance by some reasonable means, this is the +first time You have received notice of non-compliance with this License +from such Contributor, and You become compliant prior to 30 days after +Your receipt of the notice. + +5.2. If You initiate litigation against any entity by asserting a patent +infringement claim (excluding declaratory judgment actions, +counter-claims, and cross-claims) alleging that a Contributor Version +directly or indirectly infringes any patent, then the rights granted to +You by any and all Contributors for the Covered Software under Section +2.1 of this License shall terminate. + +5.3. In the event of termination under Sections 5.1 or 5.2 above, all +end user license agreements (excluding distributors and resellers) which +have been validly granted by You or Your distributors under this License +prior to termination shall survive termination. + +************************************************************************ +* * +* 6. Disclaimer of Warranty * +* ------------------------- * +* * +* Covered Software is provided under this License on an "as is" * +* basis, without warranty of any kind, either expressed, implied, or * +* statutory, including, without limitation, warranties that the * +* Covered Software is free of defects, merchantable, fit for a * +* particular purpose or non-infringing. The entire risk as to the * +* quality and performance of the Covered Software is with You. * +* Should any Covered Software prove defective in any respect, You * +* (not any Contributor) assume the cost of any necessary servicing, * +* repair, or correction. This disclaimer of warranty constitutes an * +* essential part of this License. No use of any Covered Software is * +* authorized under this License except under this disclaimer. * +* * +************************************************************************ + +************************************************************************ +* * +* 7. Limitation of Liability * +* -------------------------- * +* * +* Under no circumstances and under no legal theory, whether tort * +* (including negligence), contract, or otherwise, shall any * +* Contributor, or anyone who distributes Covered Software as * +* permitted above, be liable to You for any direct, indirect, * +* special, incidental, or consequential damages of any character * +* including, without limitation, damages for lost profits, loss of * +* goodwill, work stoppage, computer failure or malfunction, or any * +* and all other commercial damages or losses, even if such party * +* shall have been informed of the possibility of such damages. This * +* limitation of liability shall not apply to liability for death or * +* personal injury resulting from such party's negligence to the * +* extent applicable law prohibits such limitation. Some * +* jurisdictions do not allow the exclusion or limitation of * +* incidental or consequential damages, so this exclusion and * +* limitation may not apply to You. * +* * +************************************************************************ + +8. Litigation +------------- + +Any litigation relating to this License may be brought only in the +courts of a jurisdiction where the defendant maintains its principal +place of business and such litigation shall be governed by laws of that +jurisdiction, without reference to its conflict-of-law provisions. +Nothing in this Section shall prevent a party's ability to bring +cross-claims or counter-claims. + +9. Miscellaneous +---------------- + +This License represents the complete agreement concerning the subject +matter hereof. If any provision of this License is held to be +unenforceable, such provision shall be reformed only to the extent +necessary to make it enforceable. Any law or regulation which provides +that the language of a contract shall be construed against the drafter +shall not be used to construe this License against a Contributor. + +10. Versions of the License +--------------------------- + +10.1. New Versions + +Mozilla Foundation is the license steward. Except as provided in Section +10.3, no one other than the license steward has the right to modify or +publish new versions of this License. Each version will be given a +distinguishing version number. + +10.2. Effect of New Versions + +You may distribute the Covered Software under the terms of the version +of the License under which You originally received the Covered Software, +or under the terms of any subsequent version published by the license +steward. + +10.3. Modified Versions + +If you create software not governed by this License, and you want to +create a new license for such software, you may create and use a +modified version of this License if you rename the license and remove +any references to the name of the license steward (except to note that +such modified license differs from this License). + +10.4. Distributing Source Code Form that is Incompatible With Secondary +Licenses + +If You choose to distribute Source Code Form that is Incompatible With +Secondary Licenses under the terms of this version of the License, the +notice described in Exhibit B of this License must be attached. + +Exhibit A - Source Code Form License Notice +------------------------------------------- + + This Source Code Form is subject to the terms of the Mozilla Public + License, v. 2.0. If a copy of the MPL was not distributed with this + file, You can obtain one at http://mozilla.org/MPL/2.0/. + +If it is not possible or desirable to put the notice in a particular +file, then You may include the notice in a location (such as a LICENSE +file in a relevant directory) where a recipient would be likely to look +for such a notice. + +You may add additional accurate notices of copyright ownership. + +Exhibit B - "Incompatible With Secondary Licenses" Notice +--------------------------------------------------------- + + This Source Code Form is "Incompatible With Secondary Licenses", as + defined by the Mozilla Public License, v. 2.0. \ No newline at end of file diff --git a/Package/Delphi_XE5/LINA_D_XE5.dpk b/Package/Delphi_XE5/LINA_D_XE5.dpk new file mode 100644 index 0000000..cd39b2b --- /dev/null +++ b/Package/Delphi_XE5/LINA_D_XE5.dpk @@ -0,0 +1,54 @@ +package LINA_D_XE5; + +{$R *.res} +{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION OFF} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES ON} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DEFINE DEBUG} +{$ENDIF IMPLICITBUILDING} +{$DESCRIPTION 'Lina Components'} +{$IMPLICITBUILD ON} + +{$R '..\..\Resource\Compiled\uBattery.dcr'} +{$R '..\..\Resource\Compiled\uFrmCtrls.dcr'} +{$R '..\..\Resource\Compiled\uLocalMgr.dcr'} +{$R '..\..\Resource\Compiled\uScriptMgr.dcr'} +{$R '..\..\Resource\Compiled\uVirtObj.dcr'} + +requires + rtl, + vcl, + dbrtl, + PascalScript_Core_D19; + +contains + uBase in '..\..\Source\uBase.pas', + uBattery in '..\..\Source\uBattery.pas', + uCrypt in '..\..\Source\uCrypt.pas', + uFileTools in '..\..\Source\uFileTools.pas', + uFrmCtrls in '..\..\Source\uFrmCtrls.pas', + uLocalMgr in '..\..\Source\uLocalMgr.pas', + uScriptMgr in '..\..\Source\uScriptMgr.pas', + uSysTools in '..\..\Source\uSysTools.pas', + uVirtObj in '..\..\Source\uVirtObj.pas'; + +end. diff --git a/Package/Delphi_XE5/LINA_D_XE5.dproj b/Package/Delphi_XE5/LINA_D_XE5.dproj new file mode 100644 index 0000000..0dcd52b --- /dev/null +++ b/Package/Delphi_XE5/LINA_D_XE5.dproj @@ -0,0 +1,207 @@ + + + {605C75AC-974B-44E9-997A-211A42CE323E} + LINA_D_XE5.dpk + 15.3 + VCL + True + Debug + Win32 + 3 + Package + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + All + true + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + true + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + + + rtl;dbrtl;$(DCC_UsePackage) + + + rtl;vcl;dbrtl;$(DCC_UsePackage) + true + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + 1033 + + + rtl;vcl;dbrtl;$(DCC_UsePackage) + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + 1033 + true + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + ..\..\Source\Compiled\ + CompanyName=Dennis Göhlert a.o.;FileDescription=Lina Components;FileVersion=1.0.0.0;InternalName=;LegalCopyright=2014;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + 1033 + true + Lina Components + false + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + + MainSource + + + + + + + + + + + + + + + + + + + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + Package + + + + True + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1031 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + + + + + + + + + + + + + + + + + + + + + + + + LINA_D_XE5.dpk + + + Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver + Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server + + + + + False + True + True + + + 12 + + + + diff --git a/Package/Delphi_XE5/LINA_D_XE5.dproj.local b/Package/Delphi_XE5/LINA_D_XE5.dproj.local new file mode 100644 index 0000000..0994c4c --- /dev/null +++ b/Package/Delphi_XE5/LINA_D_XE5.dproj.local @@ -0,0 +1,55 @@ + + + + 1899.12.30 00:00:00.000.525,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uCrypt.pas + 1899.12.30 00:00:00.000.584,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uVirtObj.pas + 1899.12.30 00:00:00.000.555,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uBase.pas + 1899.12.30 00:00:00.000.518,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uBattery.pas + 1899.12.30 00:00:00.000.648,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uScriptMgr.pas + 1899.12.30 00:00:00.000.196,=rtl.dcp + 1899.12.30 00:00:00.000.686,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\uSysTools.pas + 1899.12.30 00:00:00.000.621,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uLinaTest.pas + 1899.12.30 00:00:00.000.577,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uBattery.pas + 1899.12.30 00:00:00.000.633,C:\Users\Dennis\Documents\RAD Studio\Projekte\Package1.dproj=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\LINA_D_XE5.dproj + 1899.12.30 00:00:00.000.318,=vcl.dcp + 1899.12.30 00:00:00.000.556,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uLocalMgr.pas + 1899.12.30 00:00:00.000.414,C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uLinaTest.pas= + 1899.12.30 00:00:00.000.535,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uFileTools.pas + 1899.12.30 00:00:00.000.566,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uScriptMgr.pas + 1899.12.30 00:00:00.000.592,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uFileTools.pas + 1899.12.30 00:00:00.000.799,=PascalScript_Core_D19.dcp + 1899.12.30 00:00:00.000.857,=PascalScript_Core_D19.dcp + 1899.12.30 00:00:00.000.546,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uFrmCtrls.pas + 1899.12.30 00:00:00.000.325,=dbrtl.dcp + 1899.12.30 00:00:00.000.633,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uLocalMgr.pas + 1899.12.30 00:00:00.000.576,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uSysTools.pas + 1899.12.30 00:00:00.000.672,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\uFrmCtrls.pas + 1899.12.30 00:00:00.000.809,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Resource\Lina.rc + 1899.12.30 00:00:00.000.681,C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Resource\Lina.rc= + 1899.12.30 00:00:00.000.508,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uBase.pas + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Package/Delphi_XE5/LINA_D_XE5.identcache b/Package/Delphi_XE5/LINA_D_XE5.identcache new file mode 100644 index 0000000..d9889b0 Binary files /dev/null and b/Package/Delphi_XE5/LINA_D_XE5.identcache differ diff --git a/Package/Delphi_XE5/LINA_D_XE5.res b/Package/Delphi_XE5/LINA_D_XE5.res new file mode 100644 index 0000000..8a27321 Binary files /dev/null and b/Package/Delphi_XE5/LINA_D_XE5.res differ diff --git a/Resource/Bitmap/Large/TBattery.bmp b/Resource/Bitmap/Large/TBattery.bmp new file mode 100644 index 0000000..ab7e0e9 Binary files /dev/null and b/Resource/Bitmap/Large/TBattery.bmp differ diff --git a/Resource/Bitmap/Large/TLocalizationManager.bmp b/Resource/Bitmap/Large/TLocalizationManager.bmp new file mode 100644 index 0000000..899a94a Binary files /dev/null and b/Resource/Bitmap/Large/TLocalizationManager.bmp differ diff --git a/Resource/Bitmap/Large/TScriptManager.bmp b/Resource/Bitmap/Large/TScriptManager.bmp new file mode 100644 index 0000000..cf79db7 Binary files /dev/null and b/Resource/Bitmap/Large/TScriptManager.bmp differ diff --git a/Resource/Bitmap/Large/TSplashScreen.bmp b/Resource/Bitmap/Large/TSplashScreen.bmp new file mode 100644 index 0000000..2b73833 Binary files /dev/null and b/Resource/Bitmap/Large/TSplashScreen.bmp differ diff --git a/Resource/Bitmap/Large/TVirtualProgram.bmp b/Resource/Bitmap/Large/TVirtualProgram.bmp new file mode 100644 index 0000000..e1c365e Binary files /dev/null and b/Resource/Bitmap/Large/TVirtualProgram.bmp differ diff --git a/Resource/Bitmap/Large/Thumbs.db b/Resource/Bitmap/Large/Thumbs.db new file mode 100644 index 0000000..920bc2a Binary files /dev/null and b/Resource/Bitmap/Large/Thumbs.db differ diff --git a/Resource/Bitmap/Small/TBattery.bmp b/Resource/Bitmap/Small/TBattery.bmp new file mode 100644 index 0000000..d1fa8c7 Binary files /dev/null and b/Resource/Bitmap/Small/TBattery.bmp differ diff --git a/Resource/Bitmap/Small/TLocalizationManager.bmp b/Resource/Bitmap/Small/TLocalizationManager.bmp new file mode 100644 index 0000000..df993c0 Binary files /dev/null and b/Resource/Bitmap/Small/TLocalizationManager.bmp differ diff --git a/Resource/Bitmap/Small/TScriptManager.bmp b/Resource/Bitmap/Small/TScriptManager.bmp new file mode 100644 index 0000000..5d508a0 Binary files /dev/null and b/Resource/Bitmap/Small/TScriptManager.bmp differ diff --git a/Resource/Bitmap/Small/TSplashScreen.bmp b/Resource/Bitmap/Small/TSplashScreen.bmp new file mode 100644 index 0000000..3461797 Binary files /dev/null and b/Resource/Bitmap/Small/TSplashScreen.bmp differ diff --git a/Resource/Bitmap/Small/TVirtualProgram.bmp b/Resource/Bitmap/Small/TVirtualProgram.bmp new file mode 100644 index 0000000..1ab0957 Binary files /dev/null and b/Resource/Bitmap/Small/TVirtualProgram.bmp differ diff --git a/Resource/Bitmap/Small/Thumbs.db b/Resource/Bitmap/Small/Thumbs.db new file mode 100644 index 0000000..1c3ecbb Binary files /dev/null and b/Resource/Bitmap/Small/Thumbs.db differ diff --git a/Resource/Bitmap/Thumbs.db b/Resource/Bitmap/Thumbs.db new file mode 100644 index 0000000..93e202f Binary files /dev/null and b/Resource/Bitmap/Thumbs.db differ diff --git a/Resource/Compiled/uBattery.dcr b/Resource/Compiled/uBattery.dcr new file mode 100644 index 0000000..42ff05c Binary files /dev/null and b/Resource/Compiled/uBattery.dcr differ diff --git a/Resource/Compiled/uFrmCtrls.dcr b/Resource/Compiled/uFrmCtrls.dcr new file mode 100644 index 0000000..24beb66 Binary files /dev/null and b/Resource/Compiled/uFrmCtrls.dcr differ diff --git a/Resource/Compiled/uLocalMgr.dcr b/Resource/Compiled/uLocalMgr.dcr new file mode 100644 index 0000000..1436db1 Binary files /dev/null and b/Resource/Compiled/uLocalMgr.dcr differ diff --git a/Resource/Compiled/uScriptMgr.dcr b/Resource/Compiled/uScriptMgr.dcr new file mode 100644 index 0000000..7997cc1 Binary files /dev/null and b/Resource/Compiled/uScriptMgr.dcr differ diff --git a/Resource/Compiled/uVirtObj.dcr b/Resource/Compiled/uVirtObj.dcr new file mode 100644 index 0000000..bf99241 Binary files /dev/null and b/Resource/Compiled/uVirtObj.dcr differ diff --git a/Resource/LINA.rc b/Resource/LINA.rc new file mode 100644 index 0000000..5fa5fcc --- /dev/null +++ b/Resource/LINA.rc @@ -0,0 +1,15 @@ +//TBATTERY BITMAP "TBattery.bmp" +TBATTERY16 BITMAP "Bitmap\Small\TBattery.bmp" +TBATTERY32 BITMAP "Bitmap\Large\TBattery.bmp" +//TLOCALIZATIONMANAGER BITMAP "TLocalizationManager.bmp" +TLOCALIZATIONMANAGER16 BITMAP "Bitmap\Small\TLocalizationManager.bmp" +TLOCALIZATIONMANAGER32 BITMAP "Bitmap\Large\TLocalizationManager.bmp" +//TSCRIPTMANAGER BITMAP "TScriptManager.bmp" +TSCRIPTMANAGER16 BITMAP "Bitmap\Small\TScriptManager.bmp" +TSCRIPTMANAGER32 BITMAP "Bitmap\Large\TScriptManager.bmp" +//TSPLASHSCREEN BITMAP "TSplashScreen.bmp" +TSPLASHSCREEN16 BITMAP "Bitmap\Small\TSplashScreen.bmp" +TSPLASHSCREEN32 BITMAP "Bitmap\Large\TSplashScreen.bmp" +//TVIRTUALPROGRAM BITMAP "TVirtualProgram.bmp" +TVIRTUALPROGRAM16 BITMAP "Bitmap\Small\TVirtualProgram.bmp" +TVIRTUALPROGRAM32 BITMAP "Bitmap\Large\TVirtualProgram.bmp" diff --git a/Source/Compiled/uBase.dcu b/Source/Compiled/uBase.dcu new file mode 100644 index 0000000..a8cc7a5 Binary files /dev/null and b/Source/Compiled/uBase.dcu differ diff --git a/Source/Compiled/uBattery.dcu b/Source/Compiled/uBattery.dcu new file mode 100644 index 0000000..137c068 Binary files /dev/null and b/Source/Compiled/uBattery.dcu differ diff --git a/Source/Compiled/uCrypt.dcu b/Source/Compiled/uCrypt.dcu new file mode 100644 index 0000000..2e366a4 Binary files /dev/null and b/Source/Compiled/uCrypt.dcu differ diff --git a/Source/Compiled/uFileTools.dcu b/Source/Compiled/uFileTools.dcu new file mode 100644 index 0000000..9cc2d03 Binary files /dev/null and b/Source/Compiled/uFileTools.dcu differ diff --git a/Source/Compiled/uFrmCtrls.dcu b/Source/Compiled/uFrmCtrls.dcu new file mode 100644 index 0000000..8e5756a Binary files /dev/null and b/Source/Compiled/uFrmCtrls.dcu differ diff --git a/Source/Compiled/uLocalMgr.dcu b/Source/Compiled/uLocalMgr.dcu new file mode 100644 index 0000000..a81a493 Binary files /dev/null and b/Source/Compiled/uLocalMgr.dcu differ diff --git a/Source/Compiled/uScriptMgr.dcu b/Source/Compiled/uScriptMgr.dcu new file mode 100644 index 0000000..35fa421 Binary files /dev/null and b/Source/Compiled/uScriptMgr.dcu differ diff --git a/Source/Compiled/uSysTools.dcu b/Source/Compiled/uSysTools.dcu new file mode 100644 index 0000000..6d58574 Binary files /dev/null and b/Source/Compiled/uSysTools.dcu differ diff --git a/Source/Compiled/uVirtObj.dcu b/Source/Compiled/uVirtObj.dcu new file mode 100644 index 0000000..aad8e1c Binary files /dev/null and b/Source/Compiled/uVirtObj.dcu differ diff --git a/Source/uBase.pas b/Source/uBase.pas new file mode 100644 index 0000000..c2c4356 --- /dev/null +++ b/Source/uBase.pas @@ -0,0 +1,98 @@ +unit uBase; + +////////////////////////////////////// +/// Lina Base Unit /// +/// **************************** /// +/// (c) 2014 Dennis Göhlert a.o. /// +////////////////////////////////////// + + {$IF CompilerVersion < 18.0} + { Unter früheren Delphi-Versionen als 2007 gab es (offiziell) noch keine + Unterstützung für Windows-Vista-spezifische funktionen wie die TaskDialog- + Komponente oder einige Funktionen. + Damit dies nicht zu Problemen führt, geht der Compiler darauf mithilfe + dieser Direktive ein. } + {$DEFINE NO_VISTA} + {$ENDIF} + {$IF CompilerVersion < 20.0} + { Unter früheren Delphi-Versionen als 2009 war die Nutzung generischer + Datentypen (Generics) nicht möglich. Da es ohne diese nahezu unmöglich + scheint, typisierte Objekte, wie zum Beispiel typisierte TObjectList's + zu deklarieren, fallen diese Deklarationen unter früheren Delphi-Versionen + weg. Dies kann eventuell zu kompatibilitätsproblemen zwischen + unterschiedlichen Nutzern dieser Komponenten führen, lässt sich aber nicht + vermeiden. } + {$DEFINE NO_GENERIC} + {$ENDIF} + +interface + + { Dies ist die Basis-Unit für die Lina-Komponenten bzw. Methoden und Klassen } + +uses + { Standard-Units } + SysUtils, Dialogs; + +type + TComponentAbout = class + private + { Private-Deklarationen } + FComponent: ShortString; + FVersion: Single; + FAuthor: ShortString; + FCopyright: ShortString; + FHomepage: ShortString; + protected + { Protected-Deklarationen } + published + property Component: ShortString read FComponent; + property Version: Single read FVersion; + property Copyright: ShortString read FCopyright; + property Author: ShortString read FAuthor; + property Homepage: ShortString read FHomepage; + public + { Public-Deklarationen } + constructor Create(Comp: ShortString = ''; Ver: Single = 1.0; + Copy: ShortString = ''; Auth: ShortString = ''; Home: ShortString = ''); + { Über-Dialog } + procedure AboutDlg; + end; + +const + ComponentsPage = 'Lina'; + About_Title = 'About...'; + +implementation + +constructor TComponentAbout.Create(Comp: ShortString = ''; Ver: Single = 1.0; + Copy: ShortString = ''; Auth: ShortString = ''; Home: ShortString = ''); +begin + FComponent := Comp; + FVersion := Ver; + FCopyright := Copy; + FAuthor := Auth; + FHomepage := Homepage; +end; + +procedure TComponentAbout.AboutDlg; +begin + {$IFDEF NO_VISTA} + { MessageDlg, falls der Compiler KEINE Vista-Dialoge unterstützt } + MessageDlg( + {$ELSE} + { TaskMessageDlg, falls der Compiler Vista-Dialoge unterstützt } + TaskMessageDlg( + {$ENDIF} + About_Title, + { ---------------------------------- } + Component + ' v' + + FloatToStr(Version) + #10#13 + + Copyright + ' ' + Author + #10#13 + + Homepage, + { ---------------------------------- } + mtInformation, + { ---------------------------------- } + [mbClose],0) +end; + +end. diff --git a/Source/uBattery.pas b/Source/uBattery.pas new file mode 100644 index 0000000..269c975 --- /dev/null +++ b/Source/uBattery.pas @@ -0,0 +1,157 @@ +unit uBattery; + +////////////////////////////////////// +/// Lina Battery Unit /// +/// **************************** /// +/// (c) 2014 Dennis Göhlert a.o. /// +////////////////////////////////////// + +interface + +uses + { Standard-Units } + SysUtils, Classes, Windows, + { Andere Package-Units } + uBase; + +type + { Hilfsklassen } + TBatteryFlag = (bfHealthy,bfLow,bfCritical,bfCharge,bfHealthyAccu,bfNone,bfUnknown); + TBatteryStatus = (bsInternal,bsExternal); + +type + TBattery = class(TComponent) + private + { Private-Deklarationen } + function BatteryFlag(Flag: Integer): TBatteryFlag; + function SecToTime(Sec: Integer): TDateTime; + protected + { Protected-Deklarationen } + public + { Public-Deklarationen } + function GetPowerStatus: TBatteryStatus; + function GetBatteryTime: TDateTime; + function GetBatteryFullTime: TDateTime; + function GetBatteryFlag: TBatteryFlag; + function GetBatteryFlagReport: String; + function GetBatteryPercent: Byte; + published + { Published-Deklarationen } + end; + + procedure Register; + +const + { Meta-Daten } + BatteryComponent_Name = 'Battery'; + BatteryComponent_Version = 1.0; + BatteryComponent_Copyright = 'Copyright © 2014'; + BatteryComponent_Author = 'Dennis Göhlert a.o.'; + { PowerStatus-Meldungen } + PS_HEALTHY = 'Healthy'; + PS_LOW = 'Low'; + PS_CRITICAL = 'Critical'; + PS_CHARGE = 'Charge'; + PS_HEALTHYACCU = 'Healthy (Akku)'; + PS_NONE = 'None'; + PS_UNKNOWN = 'Unknown'; + +implementation + +procedure Register; +begin + RegisterComponents(ComponentsPage,[TBattery]); +end; + +function TBattery.BatteryFlag(Flag: Integer): TBatteryFlag; +begin + case Flag of + 1: Result := bfHealthy; + 2: Result := bfLow; + 4: Result := bfCritical; + 8: Result := bfCharge; + 9: Result := bfHealthyAccu; + 128: Result := bfNone; + 255: Result := bfUnknown; + end; +end; + +function TBattery.SecToTime(Sec: Integer): TDateTime; +var + H, M, S: String; + ZH, ZM, ZS: Integer; +begin + if Sec < 0 then + begin + Result := StrToTime('00:00:00'); + Exit; + end; + ZH := Sec div 3600; + ZM := Sec div 60 - ZH * 60; + ZS := Sec - (ZH * 3600 + ZM * 60) ; + H := IntToStr(ZH) ; + M := IntToStr(ZM) ; + S := IntToStr(ZS) ; + Result := StrToTime(H + ':' + M + ':' + S); +end; + +function TBattery.GetPowerStatus: TBatteryStatus; +var + SysPowerStatus: TSystemPowerStatus; +begin + GetSystemPowerStatus(SysPowerStatus); + if Boolean(SysPowerStatus.ACLineStatus) then + begin + Result := bsExternal; + end else + begin + Result := bsInternal; + end; +end; + +function TBattery.GetBatteryTime: TDateTime; +var + SysPowerStatus: TSystemPowerStatus; +begin + GetSystemPowerStatus(SysPowerStatus); + Result := SecToTime(SysPowerStatus.BatteryLifeTime); +end; + +function TBattery.GetBatteryFlag: TBatteryFlag; +var + SysPowerStatus: TSystemPowerStatus; +begin + GetSystemPowerStatus(SysPowerStatus); + Result := BatteryFlag(SysPowerStatus.BatteryFlag); +end; + +function TBattery.GetBatteryFlagReport: String; +begin + case GetBatteryFlag of + bfHealthy: Result := PS_HEALTHY; + bfLow: Result := PS_LOW; + bfCritical: Result := PS_CRITICAL; + bfCharge: Result := PS_CHARGE; + bfHealthyAccu: Result := PS_HEALTHYACCU; + bfNone: Result := PS_NONE; + bfUnknown: Result := PS_UNKNOWN; + end; +end; + +function TBattery.GetBatteryPercent: Byte; +var + SysPowerStatus: TSystemPowerStatus; +begin + GetSystemPowerStatus(SysPowerStatus); + Result := SysPowerStatus.BatteryLifePercent; +end; + +function TBattery.GetBatteryFullTime: TDateTime; +var + SysPowerStatus: TSystemPowerStatus; +begin + GetSystemPowerStatus(SysPowerStatus); + Result := SecToTime(SysPowerStatus.BatteryFullLifeTime); +end; + +end. diff --git a/Source/uCrypt.pas b/Source/uCrypt.pas new file mode 100644 index 0000000..927c40a --- /dev/null +++ b/Source/uCrypt.pas @@ -0,0 +1,69 @@ +unit uCrypt; + +////////////////////////////////////// +/// Lina Cryption Unit /// +/// **************************** /// +/// (c) 2014 Dennis Göhlert a.o. /// +////////////////////////////////////// + +interface + +uses + { Standard-Units } + Classes; + +type + TCrypt = class + private + { Private-Deklarationen } + FLines: TStrings; + public + { Public-Deklarationen } + constructor Create; + destructor Destroy; + property Lines: TStrings read FLines write FLines; + procedure Decrypt; + procedure Encrypt; + end; + + { Spezifische Kryptologie-Verfahren } + + TXorCrypt = class(TCrypt) + + end; + + TVigenereCrypt = class(TCrypt) + + end; + + TCaesarCrypt = class(TCrypt) + + end; + + TDynaCrypt = class(TCrypt) + + end; + +implementation + +constructor TCrypt.Create; +begin + //... +end; + +destructor TCrypt.Destroy; +begin + //... +end; + +procedure TCrypt.Decrypt; +begin + //... +end; + +procedure TCrypt.Encrypt; +begin + //... +end; + +end. diff --git a/Source/uFileTools.pas b/Source/uFileTools.pas new file mode 100644 index 0000000..78610d9 --- /dev/null +++ b/Source/uFileTools.pas @@ -0,0 +1,277 @@ +unit uFileTools; + +////////////////////////////////////// +/// Lina File Tools Unit /// +/// **************************** /// +/// (c) 2014 Dennis Göhlert a.o. /// +////////////////////////////////////// + +interface + +{ Da Delphi vor Version 2009 noch keine Generics kannte, musste die TWinFiles- + Deklaration auf Compiler-Versionen 20.0 oder höher beschränkt werden. + Meines Wissens nach gibt es keine einfache Möglichkeit, Typisierte Listen + auch in ältere Versionen zu integrieren. } + +uses + { Standard-Units } + Classes, SysUtils, ShellAPI, Forms, Winapi.Windows, Dialogs, + {$IFNDEF NOGENERIC} + Generics.Collections, + {$ENDIF} + { Andere Package-Units } + uBase; + +type + { Fehlermeldungen } + EFileNoExist = class(Exception); + EMissingTypeDesc = class(Exception); + EMissingExts = class(Exception); + EInvalidStyle = class(Exception); + +type + { Hilfsklassen } + TFileExecuteMode = (feOpen,feEdit,feExplore,feFind,fePrint); + TFileNameStyles = set of (fnDirectory,fnExtension); + +type + { Hauptklassen } + TWinFile = class + private + { Private-Deklarationen } + FFileName: String; + FExecuteMode: TFileExecuteMode; + public + { Public-Deklarationen } + constructor Create(AFileName: String); + destructor Destroy; + property FileName: String read FFileName; + property ExecuteMode: TFileExecuteMode read FExecuteMode write FExecuteMode; + function GetExtension(WithDot: Boolean = True): String; //ExtractFileExt() + function GetPath: String; //ExtractFilePath() + function GetDir: String; //ExtractFileDir() + function GetFileName(WithExt: Boolean = True): String; //ExtractFileName() + function GetFolderName: String; //ExtractFileFolder() + // GetSize: Int64 + // GetVersion: Extended + // GetAttribute: ... + // GetOwner: String + // GetCreated: TDateTime + // GetModified: TDateTime + function Execute: Boolean; //ExecuteFile() + function SafeExecute: Boolean; //............. + end; + + TWinFiles = array of TWinFile; + + {$IFNDEF NOGENERIC} + TWinFileList = TList; + {$ENDIF} + + function FEModeToPChar(FEMode: TFileExecuteMode): PChar; + procedure EnsureDirDelimeter(var Dir: String); + function ExecuteFile(FileName: String; ExecMode: TFileExecuteMode = feOpen; + InDir: Boolean = False): Boolean; + function ExtractFileFolder(FileName: String): String; + procedure ListFiles(Dir: String; OutList: TStrings; FileExts: array of String; + NameStyles: TFileNameStyles = []); overload; + procedure ListFolders(Dir: String; OutList: TStrings; + NameStyles: TFileNameStyles = []); overload; + +//const + { Dateierweiterungen für ListFiles() } + {FXT_ANY = '*.*' + FXT_EXE = ('*.exe'); + FXT_TXT = ('*.txt';'*.rtf'); + FXT_IMG = ('*.jpg','*.jpeg','*.png','*.tif','*.tiff','*.bmp','*.gif'); + FXT_PAS = ('*.pas','*.dpr','*.dpk','*.dfm'); + FXT_MSO = ('*.doc','*.xls','*.ppt'); + FXT_MSI = ('*.msi'); + FXT_IMG = ('*.img','*.iso'); } + +implementation + +{ TWinFile } + +function FEModeToPChar(FEMode: TFileExecuteMode): PChar; +begin + case FEMode of + feOpen: Result := 'open'; + feEdit: Result := 'edit'; + feExplore: Result := 'explore'; + feFind: Result := 'find'; + fePrint: Result := 'print'; + else Result := nil; + end; +end; + +procedure EnsureDirDelimeter(var Dir: String); +begin + if (Dir[Length(Dir)] <> '\') and (Dir[Length(Dir)] <> '/') then + begin + Dir := Dir + '\'; + end else + begin + while Length(Dir) >= 1 do + begin + if (Dir[Length(Dir) - 1] = '\') or (Dir[Length(Dir) - 1] = '/') then + begin + Delete(Dir,Length(Dir) - 1,1); + end else + begin + Break; + end; + end; + end; +end; + +procedure ListFiles(Dir: String; OutList: TStrings; FileExts: array of String; + NameStyles: TFileNameStyles = []); +var + SRec: TSearchRec; + ExtIndex: Integer; +begin + EnsureDirDelimeter(Dir); + if Length(FileExts) < 1 then + begin + raise EMissingExts.Create('Missing file extensions'); + end; + for ExtIndex := Low(FileExts) to High(FileExts) do + begin + if FindFirst(Dir + FileExts[ExtIndex],faAnyFile,SRec) = 0 then + begin + repeat + if ((SRec.Attr and faDirectory) <> faDirectory) and + (SRec.Name <> '.') and (SRec.Name <> '..') and + (ChangeFileExt(SRec.Name,ExtractFileExt(FileExts[ExtIndex])) = SRec.Name) then + begin + OutList.Add(SRec.Name); + if fnDirectory in NameStyles then + begin + OutList.Strings[OutList.Count - 1] := Dir + OutList.Strings[OutList.Count - 1]; + end; + if not (fnExtension in NameStyles) then + begin + OutList.Strings[OutList.Count - 1] := ChangeFileExt(OutList.Strings[OutList.Count - 1],''); + end; + end; + until FindNext(SRec) <> 0; + SysUtils.FindClose(SRec); + end; + end; +end; + +procedure ListFolders(Dir: String; OutList: TStrings; + NameStyles: TFileNameStyles = []); +var + SRec: TSearchRec; +begin + EnsureDirDelimeter(Dir); + if FindFirst(Dir + '*.*',faAnyFile,SRec) = 0 then + begin + repeat + if ((SRec.Attr and faDirectory) = faDirectory) and + (SRec.Name <> '.') and (SRec.Name <> '..') then + begin + if fnDirectory in NameStyles then + begin + OutList.Add(Dir + SRec.Name); + end else + begin + OutList.Add(SRec.Name); + end; + end; + until FindNext(SRec) <> 0; + SysUtils.FindClose(SRec); + end; + if fnExtension in NameStyles then + begin + raise EInvalidStyle.Create('The extension file name style is invalid for directory names and has been ignored'); + end; +end; + +function ExecuteFile(FileName: String; ExecMode: TFileExecuteMode = feOpen; + InDir: Boolean = False): Boolean; +begin + Result := True; + try + if InDir = True then + begin + ShellExecute(Application.Handle,FEModeToPChar(ExecMode),PChar(FileName),nil,PChar(ExtractFileDir(FileName)),SW_NORMAL); + end else + begin + ShellExecute(Application.Handle,FEModeToPChar(ExecMode),PChar(FileName),nil,nil,SW_NORMAL); + end; + except + Result := False; + end; +end; + +function ExtractFileFolder(FileName: String): String; +begin + Result := ExtractFileName(ExtractFileDir(FileName)); //Name d. übergeord. Ordners +end; + +constructor TWinFile.Create(AFileName: String); +begin + ExecuteMode := feOpen; + FFileName := AFileName; + if FileExists(AFileName) = False then + begin + raise EFileNoExist.Create('File not found: "' + AFileName + '"'); + end; +end; + +destructor TWinFile.Destroy; +begin + ExecuteMode := feOpen; +end; + +function TWinFile.GetExtension(WithDot: Boolean = True): String; +begin + if WithDot = True then + begin + Result := ExtractFileExt(FFileName); + end else + begin + Result := Copy(ExtractFileExt(FFileName),2,Length(ExtractFileExt(FFileName)) - 1); + end; +end; + +function TWinFile.GetFileName(WithExt: Boolean = True): String; +begin + if WithExt = True then + begin + Result := ExtractFileName(FFileName); //Name + Erweiterung + end else + begin + Result := ExtractFileName(ChangeFileExt(FFileName,'')); //Nur Dateiname + end; +end; + +function TWinFile.GetFolderName: String; +begin + Result := ExtractFileFolder(FFileName); +end; + +function TWinFile.GetPath: String; +begin + Result := ExtractFilePath(FFileName); //Gesamter Ordnerpfad (ohne Dateiname) +end; + +function TWinFile.GetDir: String; +begin + Result := ExtractFileDir(FFileName); +end; + +function TWinFile.Execute: Boolean; +begin + Result := ExecuteFile(FileName,ExecuteMode); +end; + +function TWinFile.SafeExecute: Boolean; +begin + Result := ExecuteFile(FileName,ExecuteMode,True); +end; + +end. diff --git a/Source/uFrmCtrls.pas b/Source/uFrmCtrls.pas new file mode 100644 index 0000000..1486f33 --- /dev/null +++ b/Source/uFrmCtrls.pas @@ -0,0 +1,576 @@ +unit uFrmCtrls; + +////////////////////////////////////// +/// Lina Form Controls Unit /// +/// **************************** /// +/// (c) 2014 Dennis Göhlert a.o. /// +////////////////////////////////////// + +interface + +uses + { Standard-Units } + SysUtils, Classes, Controls, Forms, ComCtrls, ExtCtrls, Graphics, + { Andere Package-Units } + uBase; + +type + { Hilfsklassen } + TSplashScreenMode = (ssmDefault,ssmModal); + TSplashScreenAnimation = (ssaNone,ssaShallow); + +type + { Ereignisse } + TSplashCreateEvent = procedure(Sender: TObject) of object; + TSplashDestroyEvent = procedure(Sender: TObject) of object; + TSplashShowEvent = procedure(Sender: TObject) of object; + TSplashHideEvent = procedure(Sender: TObject) of object; + TSplashChangeEvent = procedure(Sender: TObject) of object; + TSplashTimerEvent = procedure(Sender: TObject) of object; + +type + { Hauptklassen } + TSplashForm = class + private + { Private-Deklarationen } + FBorderStyle: TFormBorderStyle; + FBorderIcons: TBorderIcons; + FLeft: Integer; + FTop: Integer; + FWidth: Integer; + FHeight: Integer; + FVisible: Boolean; + FAlign: TAlign; + FAlphaBlend: Boolean; + FAlphaBlendValue: Byte; + FCaption: TCaption; + FColor: TColor; + FEnabled: Boolean; + FWindowState: TWindowState; + FPosition: TPosition; + FCursor: TCursor; + public + { Public-Deklarationen } + constructor Create; + destructor Destroy; override; + published + { Published-Deklarationen } + property BorderStyle: TFormBorderStyle read FBorderStyle write FBorderStyle default bsNone; + property BorderIcons: TBorderIcons read FBorderIcons write FBorderIcons default []; + property Left: Integer read FLeft write FLeft default 0; + property Top: Integer read FTop write FTop default 0; + property Width: Integer read FWidth write FWidth default 600; + property Height: Integer read FHeight write FHeight default 400; + property Visible: Boolean read FVisible write FVisible default True; + property Align: TAlign read FAlign write FAlign default alNone; + property AlphaBlend: Boolean read FAlphaBlend write FAlphaBlend default False; + property AlphaBlendValue: Byte read FAlphaBlendValue write FAlphaBlendValue default 255; + property Caption: TCaption read FCaption write FCaption; + property Color: TColor read FColor write FColor default clBtnFace; + property Enabled: Boolean read FEnabled write FEnabled default False; + property WindowState: TWindowState read FWindowState write FWindowState default wsNormal; + property Position: TPosition read FPosition write FPosition default poScreenCenter; + property Cursor: TCursor read FCursor write FCursor default crHourGlass; + end; + + TSplashProgressBar = class + private + { Private-Deklarationen } + FLeft: Integer; + FTop: Integer; + FWidth: Integer; + FHeight: Integer; + FVisible: Boolean; + FPosition: Integer; + FMin: Integer; + FMax: Integer; + FAlign: TAlign; + FBackgroundColor: TColor; + FBarColor: TColor; + FState: TProgressBarState; + FStyle: TProgressBarStyle; + FSmooth: Boolean; + FSmoothReverse: Boolean; + FMarqueeInterval: Integer; + FStep: Integer; + public + { Public-Deklarationen } + constructor Create; + destructor Destroy; override; + published + { Published-Deklarationen } + property Left: Integer read FLeft write FLeft default 250; + property Top: Integer read FTop write FTop default 250; + property Width: Integer read FWidth write FWidth default 100; + property Height: Integer read FHeight write FHeight default 50; + property Visible: Boolean read FVisible write FVisible default True; + property Position: Integer read FPosition write FPosition default 0; + property Max: Integer read FMax write FMax default 100; + property Min: Integer read FMin write FMin default 0; + property Align: TAlign read FAlign write FAlign default alNone; + property BackgroundColor: TColor read FBackgroundColor write FBackgroundColor default clDefault; + property BarColor: TColor read FBarColor write FBarColor default clDefault; + property State: TProgressBarState read FState write FState default pbsNormal; + property Style: TProgressBarStyle read FStyle write FStyle default pbstNormal; + property Smooth: Boolean read FSmooth write FSmooth default False; + property SmoothReverse: Boolean read FSmoothReverse write FSmoothReverse default False; + property MarqueeInterval: Integer read FMarqueeInterval write FMarqueeInterval default 10; + property Step: Integer read FStep write FStep default 10; + end; + + TSplashImage = class + private + { Private-Deklarationen } + FVisible: Boolean; + FTransparent: Boolean; + FPicture: TPicture; + public + { Public-Deklarationen } + constructor Create; + destructor Destroy; override; + published + { Published-Deklarationen } + property Visible: Boolean read FVisible write FVisible default True; + property Transparent: Boolean read FTransparent write FTransparent default False; + property Picture: TPicture read FPicture write FPicture; + end; + + TSplashTimer = class + private + { Private-Deklarationen } + FEnabled: Boolean; + FInterval: Cardinal; + public + { Public-Deklarationen } + constructor Create; + destructor Destroy; + published + { Published-Deklarationen } + property Enabled: Boolean read FEnabled write FEnabled default False; + property Interval: Cardinal read FInterval write FInterval default 1000; + end; + + TSplashScreen = class(TComponent) + private + { Private-Deklarationen } + FormObject: TForm; + ProgressBarObject: TProgressBar; + ImageObject: TImage; + TimerObject: TTimer; + AnimationTimerShow: TTimer; + AnimationTimerHide: TTimer; + FAbout: TComponentAbout; + FSplashForm: TSplashForm; + FSplashProgressBar: TSplashProgressBar; + FSplashImage: TSplashImage; + FSplashTimer: TSplashTimer; + FDisplayTime: Cardinal; + FAutoShow: Boolean; + FMode: TSplashScreenMode; + FAnimation: TSplashScreenAnimation; + FVisible: Boolean; + { Ereignisse } + FCreateEvent: TSplashCreateEvent; + FDestroyEvent: TSplashDestroyEvent; + FShowEvent: TSplashShowEvent; + FHideEvent: TSplashHideEvent; + FChangeEvent: TSplashChangeEvent; + FTimerEvent: TSplashTimerEvent; + { Methoden } + procedure SetVisible(Value: Boolean); + procedure FormObjectShow(Sender: TObject); + procedure FormObjectHide(Sender: TObject); + procedure TimerObjectTimer(Sender: TObject); + procedure AnimationTimerShowTimer(Sender: TObject); + procedure AnimationTimerHideTimer(Sender: TObject); + protected + { Protected-Deklarationen } + procedure Refresh; //Vorberaitung (benutzerdefinierte Werte) + procedure Reset; //Vorbereitung (standardmäßige Werte) + public + { Public-Deklarationen } + property Visible: Boolean read FVisible write SetVisible; + constructor Create(AOwnder: TComponent); override; + destructor Destroy; override; + procedure ApplyChanges; //Änderungen übernehmen + procedure Show; //Anzeigen + procedure Hide; //Verstecken (schließen) + published + { Published-Deklarationen } + { Ereignisse } + property OnCreate: TSplashCreateEvent read FCreateEvent write FCreateEvent; + property OnDestroy: TSplashDestroyEvent read FDestroyEvent write FDestroyEvent; + property OnShow: TSplashShowEvent read FShowEvent write FShowEvent; + property OnHide: TSplashHideEvent read FHideEvent write FHideEvent; + property OnChange: TSplashChangeEvent read FChangeEvent write FChangeEvent; + property OnTimer: TSplashTimerEvent read FTimerEvent write FTimerEvent; + { Eigenschaften } + property About: TComponentAbout read FAbout write FAbout; + property SplashForm: TSplashForm read FSplashForm write FSplashForm; + property SplashProgressBar: TSplashProgressBar read FSplashProgressBar write FSplashProgressBar; + property SplashImage: TSplashImage read FSplashImage write FSplashImage; + property SplashTimer: TSplashTimer read FSplashTimer write FSplashTimer; + property DisplayTime: Cardinal read FDisplayTime write FDisplayTime default 2000; + property AutoShow: Boolean read FAutoShow write FAutoShow default True; + property Mode: TSplashScreenMode read FMode write FMode default ssmDefault; + property Animation: TSplashScreenAnimation read FAnimation write FAnimation; + end; + + procedure Register; + +const + { Meta-Daten } + SplashComponent_Name = 'SplashScreen'; + SplashComponent_Version = 1.0; + SplashComponent_Copyright = 'Copyright © 2014'; + SplashComponent_Author = 'Dennis Göhlert a.o.'; + +implementation + +procedure Register; +begin + RegisterComponents(ComponentsPage,[TSplashScreen]); +end; + +{ ---------------------------------------------------------------------------- + TSplashForm + ---------------------------------------------------------------------------- } + +constructor TSplashForm.Create; +begin + Visible := False; +end; + +destructor TSplashForm.Destroy; +begin + //... + inherited; +end; + +{ ---------------------------------------------------------------------------- + TSplashProgressBar + ---------------------------------------------------------------------------- } + +constructor TSplashProgressBar.Create; +begin + //... +end; + +destructor TSplashProgressBar.Destroy; +begin + //... + inherited; +end; + +{ ---------------------------------------------------------------------------- + TSplashImage + ---------------------------------------------------------------------------- } + +constructor TSplashImage.Create; +begin + FPicture := TPicture.Create; +end; + +destructor TSplashImage.Destroy; +begin + FPicture.Free; + inherited; +end; + +{ ---------------------------------------------------------------------------- + TSplashTimer + ---------------------------------------------------------------------------- } + +constructor TSplashTimer.Create; +begin + //... +end; + +destructor TSplashTimer.Destroy; +begin + //... + inherited; +end; + +{ ---------------------------------------------------------------------------- + TSplashScreen + ---------------------------------------------------------------------------- } + +constructor TSplashScreen.Create(AOwnder: TComponent); +begin + inherited; + FAbout := TComponentAbout.Create(SplashComponent_Name,SplashComponent_Version,SplashComponent_Copyright,SplashComponent_Author); + FSplashForm := TSplashForm.Create; + FSplashProgressBar := TSplashProgressBar.Create; + FSplashImage := TSplashImage.Create; + FSplashTimer := TSplashTimer.Create; + FormObject := TForm.Create(Self); + FormObject.OnShow := FormObjectShow; + FormObject.OnHide := FormObjectHide; + ProgressBarObject := TProgressBar.Create(Self); + ProgressBarObject.Parent := FormObject; + ImageObject := TImage.Create(Self); + ImageObject.Parent := FormObject; + TimerObject := TTimer.Create(Self); + TimerObject.OnTimer := TimerObjectTimer; + + AnimationTimerShow := TTimer.Create(Self); + AnimationTimerShow.OnTimer := AnimationTimerShowTimer; + AnimationTimerShow.Enabled := False; + AnimationTimerShow.Interval := 50; + AnimationTimerHide := TTimer.Create(Self); + AnimationTimerHide.OnTimer := AnimationTimerHideTimer; + AnimationTimerHide.Enabled := False; + AnimationTimerHide.Interval := 50; + + Reset; + + if Assigned(OnCreate) then + begin + OnCreate(Self); + end; +end; + +destructor TSplashScreen.Destroy; +begin + if Assigned(OnDestroy) then + begin + OnDestroy(Self); + end; + FAbout.Free; + FSplashForm.Free; + FSplashProgressBar.Free; + FSplashImage.Free; + FSplashTimer.Free; + FormObject.Close; + FormObject.Free; + //ProgressBarObject.Free; _ + //ImageObject.Free; | + //TimerObject.Free; |____\ Automatisch + //AnimationTimerShow.Free; | / freigegeben + //AnimationTimerHide.Free; _| + inherited; +end; + +procedure TSplashScreen.Show; +begin + ApplyChanges; + if Mode = ssmModal then + begin + FormObject.ShowModal; + end else + begin + FormObject.Show; + end; + if Assigned(OnShow) then + begin + OnShow(Self); + end; + if Animation = ssaShallow then + begin + FormObject.AlphaBlend := True; + FormObject.AlphaBlendValue := 0; + AnimationTimerShow.Enabled := True; + end; + FVisible := True; + FormObject.BringToFront; +end; + +procedure TSplashScreen.Hide; +begin + if Animation = ssaNone then + begin + FormObject.Hide; + end else + begin + if Animation = ssaShallow then + begin + FormObject.AlphaBlend := True; + AnimationTimerHide.Enabled := True; + end; + end; + FVisible := False; + if Assigned(OnHide) then + begin + OnHide(Self); + end; +end; + +procedure TSplashScreen.ApplyChanges; +begin + { "Refresh;" ist nicht public, deswegen hier eine Referenz. + Falls beim übernehmen der Änderungen noch sonstige Dinge getan werden + müssen, können diese hier definiert werden. } + Refresh; +end; + +procedure TSplashScreen.Refresh; +begin + { TSplashForm -> TForm } + FormObject.BorderStyle := SplashForm.BorderStyle; + FormObject.BorderIcons := SplashForm.BorderIcons; + FormObject.Left := SplashForm.Left; + FormObject.Top := SplashForm.Top; + FormObject.Width := SplashForm.Width; + FormObject.Height := SplashForm.Height; + FormObject.Visible := SplashForm.Visible; + FormObject.Align := SplashForm.Align; + FormObject.AlphaBlend := SplashForm.AlphaBlend; + FormObject.AlphaBlendValue := SplashForm.AlphaBlendValue; + FormObject.Caption := SplashForm.Caption; + FormObject.Color := SplashForm.Color; + FormObject.Enabled := SplashForm.Enabled; + FormObject.WindowState := SplashForm.WindowState; + FormObject.Position := SplashForm.Position; + FormObject.Cursor := SplashForm.Cursor; + { TSplashProgressBar -> TProgressBar } + ProgressBarObject.Left := SplashProgressBar.Left; + ProgressBarObject.Top := SplashProgressBar.Top; + ProgressBarObject.Width := SplashProgressBar.Width; + ProgressBarObject.Height := SplashProgressBar.Height; + ProgressBarObject.Visible := SplashProgressBar.Visible; + ProgressBarObject.Position := SplashProgressBar.Position; + ProgressBarObject.Max := SplashProgressBar.Max; + ProgressBarObject.Min := SplashProgressBar.Min; + ProgressBarObject.Align := SplashProgressBar.Align; + ProgressBarObject.BackgroundColor := SplashProgressBar.BackgroundColor; + ProgressBarObject.BarColor := SplashProgressBar.BarColor; + ProgressBarObject.State := SplashProgressBar.State; + ProgressBarObject.Style := SplashProgressBar.Style; + ProgressBarObject.Smooth := SplashProgressBar.Smooth; + ProgressBarObject.SmoothReverse := SplashProgressBar.SmoothReverse; + ProgressBarObject.MarqueeInterval := SplashProgressBar.MarqueeInterval; + ProgressBarObject.Step := SplashProgressBar.Step; + { TSplashImage -> TImage } + ImageObject.Visible := SplashImage.Visible; + ImageObject.Transparent := SplashImage.Transparent; + ImageObject.Picture := SplashImage.Picture; + { TSplashTimer -> TTimer } + TimerObject.Enabled := SplashTimer.Enabled; + TimerObject.Interval := SplashTimer.Interval; + if Assigned(OnChange) then + begin + OnChange(Self); + end; +end; + +procedure TSplashScreen.Reset; +begin + { TSplashForm } + SplashForm.BorderStyle := bsNone; + SplashForm.BorderIcons := []; + SplashForm.Left := 0; + SplashForm.Top := 0; + SplashForm.Width := 600; + SplashForm.Height := 400; + SplashForm.Visible := True; + SplashForm.Align := alNone; + SplashForm.AlphaBlend := False; + SplashForm.AlphaBlendValue := 255; + SplashForm.Color := clBtnFace; + SplashForm.Enabled := False; + SplashForm.WindowState := wsNormal; + SplashForm.Position := poScreenCenter; + SplashForm.Cursor := crHourGlass; + { TSplashProgressBar } + SplashProgressBar.Left := 250; + SplashProgressBar.Top := 250; + SplashProgressBar.Width := 100; + SplashProgressBar.Height := 50; + SplashProgressBar.Visible := True; + SplashProgressBar.Position := 0; + SplashProgressBar.Max := 100; + SplashProgressBar.Min := 0; + SplashProgressBar.Align := alNone; + SplashProgressBar.BackgroundColor := clDefault; + SplashProgressBar.BarColor := clDefault; + SplashProgressBar.State := pbsNormal; + SplashProgressBar.Style := pbstNormal; + SplashProgressBar.Smooth := False; + SplashProgressBar.SmoothReverse := False; + SplashProgressBar.MarqueeInterval := 10; + SplashProgressBar.Step := 10; + { TSplashImage } + SplashImage.Visible := True; + SplashImage.Transparent := False; + { TSplashTimer } + SplashTimer.Enabled := False; + SplashTimer.Interval := 1000; + if Assigned(OnChange) then + begin + OnChange(Self); + end; +end; + +procedure TSplashScreen.SetVisible(Value: Boolean); +begin + if Value = True then + begin + Show; + end else + begin + Hide; + end; +end; + +procedure TSplashScreen.FormObjectShow(Sender: TObject); +begin + //... +end; + +procedure TSplashScreen.FormObjectHide(Sender: TObject); +begin + //... +end; + +procedure TSplashScreen.TimerObjectTimer(Sender: TObject); +begin + if Assigned(OnTimer) then + begin + OnTimer(Self); + end; +end; + +procedure TSplashScreen.AnimationTimerShowTimer(Sender: TObject); +begin + if Animation = ssaShallow then + begin + if FormObject.AlphaBlendValue <> SplashForm.AlphaBlendValue then + begin + if SplashForm.AlphaBlendValue - FormObject.AlphaBlendValue < 10 then + begin + FormObject.AlphaBlendValue := FormObject.AlphaBlendValue + (SplashForm.AlphaBlendValue - FormObject.AlphaBlendValue); + end else + begin + FormObject.AlphaBlendValue := FormObject.AlphaBlendValue + 10; + end; + end else + begin + AnimationTimerShow.Enabled := False; + FormObject.AlphaBlend := SplashForm.AlphaBlend; + end; + end; +end; + +procedure TSplashScreen.AnimationTimerHideTimer(Sender: TObject); +begin + if Animation = ssaShallow then + begin + if FormObject.AlphaBlendValue <> 0 then + begin + if FormObject.AlphaBlendValue < 10 then + begin + FormObject.AlphaBlendValue := FormObject.AlphaBlendValue - FormObject.AlphaBlendValue; + end else + begin + FormObject.AlphaBlendValue := FormObject.AlphaBlendValue - 10; + end; + end; + end else + begin + AnimationTimerHide.Enabled := False; + FormObject.AlphaBlend := SplashForm.AlphaBlend; + end; +end; + +end. diff --git a/Source/uLocalMgr.pas b/Source/uLocalMgr.pas new file mode 100644 index 0000000..17587bc --- /dev/null +++ b/Source/uLocalMgr.pas @@ -0,0 +1,134 @@ +unit uLocalMgr; + +////////////////////////////////////// +/// Lina Localize Manager Unit /// +/// **************************** /// +/// (c) 2014 Dennis Göhlert a.o. /// +////////////////////////////////////// + +interface + +uses + { Standard-Units } + SysUtils, Classes, IniFiles, + { Andere Package-Units } + uBase; + +type + { Hilfsklassen } + TComponentDetectMode = (cdTag,cdName); + TIdentifyStructure = (isSimple,isSection); + +type + { Hauptklassen } + TLocalization = class + private + { Private-Deklarationen } + FFileName: TFileName; + FLanguageName: ShortString; + FLines: TStrings; + protected + { Protected-Deklarationen } + public + { Public-Deklarationen } + constructor Create; overload; + constructor Create(AFileName: TFileName); overload; + destructor Destroy; + function Check: Boolean; + published + { Published-Deklarationen } + property FileName: TFileName read FFileName write FFileName; + property LanguageName: ShortString read FLanguageName write FLanguageName; + property Lines: TStrings read FLines; + end; + + TLocalizations = array of TLocalization; + + TLocalizationManager = class(TComponent) + private + { Private-Deklarationen } + FAbout: TComponentAbout; + FLanguages: TLocalizations; + FCurrent: TLocalization; + FDefault: TLocalization; + FDetect: TComponentDetectMode; + FStructure: TIdentifyStructure; + protected + { Protected-Deklarationen } + public + { Public-Deklarationen } + constructor Create(AOwnder: TComponent); override; + destructor Destroy; override; + published + { Published-Deklarationen } + property About: TComponentAbout read FAbout write FAbout; + property Languages: TLocalizations read FLanguages write FLanguages; + property Current: TLocalization read FCurrent write FCurrent; + property Default: TLocalization read FDefault write FDefault; + property Detect: TComponentDetectMode read FDetect write FDetect default cdName; + property Structure: TIdentifyStructure read FStructure write FStructure default isSection; + end; + + procedure Register; + +const + { Meta-Daten } + LocalComponent_Name = 'LocalizationManager'; + LocalComponent_Version = 1.0; + LocalComponent_Copyright = 'Copyright © 2014'; + LocalComponent_Author = 'Dennis Göhlert a.o.'; + +implementation + +procedure Register; +begin + RegisterComponents(ComponentsPage,[TLocalizationManager]); +end; + +{ ---------------------------------------------------------------------------- + TLocalization + ---------------------------------------------------------------------------- } + +constructor TLocalization.Create; +begin + //... +end; + +constructor TLocalization.Create(AFileName: TFileName); +begin + //... +end; + +destructor TLocalization.Destroy; +begin + //... +end; + +function TLocalization.Check: Boolean; +var + Index: Integer; +begin + + for Index := 0 to Lines.Count do + begin + + end; +end; + +{ ---------------------------------------------------------------------------- + TLocalizationManager + ---------------------------------------------------------------------------- } + +constructor TLocalizationManager.Create(AOwnder: TComponent); +begin + inherited; + FAbout := TComponentAbout.Create(LocalComponent_Name,LocalComponent_Version,LocalComponent_Copyright,LocalComponent_Author); +end; + +destructor TLocalizationManager.Destroy; +begin + //... + inherited; +end; + +end. diff --git a/Source/uScriptMgr.pas b/Source/uScriptMgr.pas new file mode 100644 index 0000000..56220b5 --- /dev/null +++ b/Source/uScriptMgr.pas @@ -0,0 +1,740 @@ +unit uScriptMgr; + +////////////////////////////////////// +/// Lina Script Manager Unit /// +/// **************************** /// +/// (c) 2014 Dennis Göhlert a.o. /// +////////////////////////////////////// + +interface + + { Wegen Kompatibilitätsgründen mussten einige AnsiString-Werte eingebaut + werden, da die PascalScript-Engine von RemObjects noch für ältere Versionen + von Delphi ausgelegt war. Damit TScriptManager auch unter neueren Delphi- + Versionen kompiliert werden kann, müssen die AnsiString-Werte so belassen + werden, da es sonst zu Fehlern kommt. } + +uses + { Standard-Units } + Classes, SysUtils, Dialogs, Forms, + { PS Komponenten-Units } + uPSCompiler, uPSRuntime, uPSComponent, + { PS Syntax-Libraries } + uPSComponent_Default, uPSComponent_COM, uPSComponent_Controls, + uPSComponent_Forms, uPSComponent_StdCtrls, uPSComponent_DB, + { Andere Package-Units } + uBase, uFileTools; + +type + { Fehlermeldungen } + EMissingReturnTarget = class(Exception); + EMissingComponentName = class(Exception); + EInvalidCodeLine = class(Exception); + +type + { Hilfsklassen } + TScriptReturnMode = (srNone,srAll,srErrors); + TScriptReturnStyle = (srSimple,srTime,srDateTime,srName); + TScriptLibraries = set of (slClasses,slControls,slStdCtrls,slForms,slDateUtils,slComObj,slDB,slCustom); + +type + { Ereignisse } + TScriptCreateEvent = procedure(Sender: TObject) of object; + TScriptDestroyEvent = procedure(Sender: TObject) of object; + TScriptReturnEvent = procedure(Sender: TObject; const Msg: String) of object; + TScriptNeedFileEvent = function(Sender:TObject; const OriginFileName: AnsiString; var FileName, Output: AnsiString): Boolean of object; + TScriptCompileEvent = procedure(Sender: TObject) of object; + TScriptExecuteEvent = procedure(Sender: TObject) of object; + TScriptAfterExecuteEvent = procedure(Sender: TObject) of object; + TScriptLineEvent = procedure(Sender: TObject) of object; + TScriptCodeAssignEvent = procedure(Sender: TObject) of object; + TScriptCodeLoadEvent = procedure(Sender: TObject) of object; + +type + { Hauptklassen } + TScriptManager = class(TComponent) + private + { Private-Deklarationen } + ScriptEngine: TPSScript; + Log: TStrings; + Code: TStrings; + CustomPlugins: TPSPlugIns; + FAbout: TComponentAbout; + FReturnMode: TScriptReturnMode; + FReturnStyle: TScriptReturnStyle; + FReturnTarget: TStrings; + FSecureMode: Boolean; + FVarApplication: TApplication; + FVarSelf: TForm; + FLibraries: TScriptLibraries; + { Ereignisse } + FCreateEvent: TScriptCreateEvent; + FDestroyEvent: TScriptDestroyEvent; + FReturnEvent: TScriptReturnEvent; + FNeedFileEvent: TScriptNeedFileEvent; + FCompileEvent: TScriptCompileEvent; + FExecuteEvent: TScriptExecuteEvent; + FAfterExecuteEvent: TScriptAfterExecuteEvent; + FLineEvent: TScriptLineEvent; + FCodeAssignEvent: TScriptCodeAssignEvent; + FCodeLoadEvent: TScriptCodeLoadEvent; + { Methoden } + function GetCompilerOptions: TPSCompOptions; + procedure SetCompilerOptions(const Value: TPSCompOptions); + function GetCodeLines(Index: Integer): String; //Int. Dekl. für: CodeLines[Index] + procedure SetCodeLines(Index: Integer; const Value: String); //Int. Dekl. für: CodeLines[Index] + function GetCodeCount: Integer; + function GetRunning: Boolean; + function GetPluginItems(Index: Integer): TPSPlugin; + procedure SetPluginItems(Index: Integer; const Value: TPSPlugin); + procedure SetLibraries(const Value: TScriptLibraries); + function GetUsePreProcessor: Boolean; + procedure SetUsePreProcessor(const Value: Boolean); + function GetMainFileName: AnsiString; + procedure SetMainFileName(const Value: AnsiString); + function GetDefines: TStrings; + procedure SetDefines(const Value: TStrings); + function GetPluginCount: Integer; + published + { Published-Deklarationen } + { Ereignisse} + property OnCreate: TScriptCreateEvent read FCreateEvent write FCreateEvent; + property OnDestroy: TScriptDestroyEvent read FDestroyEvent write FDestroyEvent; + property OnReturn: TScriptReturnEvent read FReturnEvent write FReturnEvent; + property OnNeedFile: TScriptNeedFileEvent read FNeedFileEvent write FNeedFileEvent; + property OnCompile: TScriptCompileEvent read FCompileEvent write FCompileEvent; + property OnExecute: TScriptExecuteEvent read FExecuteEvent write FExecuteEvent; + property OnAfterExecute: TScriptAfterExecuteEvent read FAfterExecuteEvent write FAfterExecuteEvent; + property OnLine: TScriptLineEvent read FLineEvent write FLineEvent; + property OnCodeAssign: TScriptCodeAssignEvent read FCodeAssignEvent write FCodeAssignEvent; + property OnCodeLoad: TScriptCodeLoadEvent read FCodeLoadEvent write FCodeLoadEvent; + { Eigenschaften } + property CompilerOptions: TPSCompOptions read GetCompilerOptions write SetCompilerOptions default []; + property ReturnMode: TScriptReturnMode read FReturnMode write FReturnMode default srNone; //Wann soll eine Rückmeldung erfolgen? + property ReturnStyle: TScriptReturnStyle read FReturnStyle write FReturnStyle default srSimple; //Wie soll diese Rückmeldung aussehen? + property ReturnTarget: TStrings read FReturnTarget write FReturnTarget; //Wohin soll die Rückmeldung geschrieben werden? + property SecureMode: Boolean read FSecureMode write FSecureMode default True; //Darf der Script auf den ScriptMgr zugreifen? + property VarApplication: TApplication read FVarApplication write FVarApplication; //Variable "Application" + property VarSelf: TForm read FVarSelf write FVarSelf; //Variable "Self" + property Libraries: TScriptLibraries read FLibraries write SetLibraries default [slClasses,slControls,slStdCtrls,slForms,slDateUtils,slCustom]; + property UsePreProcessor: Boolean read GetUsePreProcessor write SetUsePreProcessor; //Sind "Include"-Anweisungen erlaubt? + property MainFileName: AnsiString read GetMainFileName write SetMainFileName; //Dateiname für "Include"-Anweisungen + property Defines: TStrings read GetDefines write SetDefines; //Standardwerte für "Include"-Anweisung + { Meta-Daten } + property About: TComponentAbout read FAbout; + protected + { Protected-Deklarationen } + procedure AddLog(Entry: String); + procedure AddCustomPlugins; + function ScriptEngineNeedFile(Sender:TObject; const OriginFileName: AnsiString; var FileName, Output: AnsiString): Boolean; //TPSScript.OnNeedFile-Ereignis + procedure ScriptEngineCompile(Sender: TPSScript); //TPSScript.OnCompile-Ereignis + procedure ScriptEngineExecute(Sender: TPSScript); //TPSScript.OnExecute-Ereignis + procedure ScriptEngineAfterExecute(Sender: TPSScript); //TPSScript.OnAfterExecute-Ereignis + procedure ScriptEngineLine(Sender: TObject); //TPSScript.OnLine-Ereignis + { Skript-Funktionen } + function PS_Random(LimitPlusOne : Integer): Integer; + function PS_ExecuteFile(FileName: String; ExecMode: TFileExecuteMode): Boolean; + function PS_InputBox(const ACaption, APrompt, ADefault: String): String; + function PS_InputQuery(const ACaption, APrompt: String; var Value: String): Boolean; + procedure PS_ShowMessage(const Msg: String); + procedure PS_Randomize; + procedure PS_Sleep(Milliseconds: Cardinal); + procedure PS_About; + public + { Public-Deklarationen } + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + property Running: Boolean read GetRunning; + procedure Stop; virtual; + property CodeLines[Index: Integer]: String read GetCodeLines write SetCodeLines; + property CodeCount: Integer read GetCodeCount; + function CodeAddLine(const S: String): Integer; + procedure CodeAddLines(Strings: TStrings); + procedure CodeDeleteLine(Index: Integer); + procedure CodeLoadFromFile(FileName: String); + procedure CodeLoadFromStream(Stream: TStream); + procedure CodeAssign(Source: TPersistent); + procedure CodeClear; + function CompileAndExecute: Boolean; + property PluginItems[Index: Integer]: TPSPlugin read GetPluginItems write SetPluginItems; + property PluginCount: Integer read GetPluginCount; + procedure PluginAdd(Plugin: TPSPlugin); + procedure PluginDelete(Plugin: TPSPlugin); + end; + + procedure AddPlugin(PluginList: TPSPlugins; Plugin: TPSPlugin); + procedure DeletePlugin(PluginList: TPSPlugins; Plugin: TPSPlugin); + + procedure Register; + +const + { Meta-Daten } + ScriptComponent_Name = 'ScriptManager'; + ScriptComponent_Version = 1.0; + ScriptComponent_Copyright = 'Copyright © 2014'; + ScriptComponent_Author = 'Dennis Göhlert a.o.'; + { Fehlermeldungen } + Error_InvalidCodeLine = 'Invalid cole-line number'; + Error_MissingReturnTarget = 'Missing log-return target'; + Error_MissingComponentName = 'Missing component name'; + +var + { PS Import-Units } + PS_Import_Classes: TPSImport_Classes; + PS_Import_Controls: TPSImport_Controls; + PS_Import_StdCtrls: TPSImport_StdCtrls; + PS_Import_Forms: TPSImport_Forms; + PS_Import_DateUtils: TPSImport_DateUtils; + PS_Import_ComObj: TPSImport_ComObj; + PS_Import_DB: TPSImport_DB; + +implementation + +procedure Register; +begin + RegisterComponents(ComponentsPage,[TScriptManager]); +end; + +procedure AddPlugin(PluginList: TPSPlugins; Plugin: TPSPlugin); +begin + TPSPluginItem(PluginList.Add).Plugin := Plugin; +end; + +procedure DeletePlugin(PluginList: TPSPlugins; Plugin: TPSPlugin); +var + Index: Integer; + PluginFound: Boolean; +begin + PluginFound := False; + Index := 0; + if PluginList.Count > Index then + begin + repeat + if TPSPluginItem(PluginList.Items[Index]).Plugin = Plugin then + begin + PluginList.Delete(Index); + PluginFound := True; + end else + begin + Index := Index + 1; + end; + until (PluginFound = True); + end; +end; + +constructor TScriptManager.Create(AOwner: TComponent); +begin + inherited; + FAbout := TComponentAbout.Create(ScriptComponent_Name,ScriptComponent_Version,ScriptComponent_Copyright,ScriptComponent_Author); + //ReturnMode := srNone; Durch DEFAULT festgelegt! + //ReturnStyle := srSimple; Durch DEFAULT festgelegt! + SecureMode := True; + //ReturnSL := TStringList.Create; Nicht erstellen, Property ist nur ein Pointer auf ext. TStrings + FLibraries := [slClasses,slControls,slStdCtrls,slForms,slDateUtils,slCustom]; + if (Self.Owner is TForm) or (Owner.ClassParent = TForm) then + begin + VarSelf := (Self.Owner as TForm); + end; + Log := TStringList.Create; + Code := TStringList.Create; + CustomPlugins := TPSPlugins.Create(ScriptEngine); + ScriptEngine := TPSScript.Create(nil); + ScriptEngine.OnNeedFile := ScriptEngineNeedFile; + ScriptEngine.OnCompile := ScriptEngineCompile; + ScriptEngine.OnExecute := ScriptEngineExecute; + ScriptEngine.OnAfterExecute := ScriptEngineAfterExecute; + ScriptEngine.OnLine := ScriptEngineLine; + + { Import-Unit-Komponenten erstellen } + PS_Import_Classes := TPSImport_Classes.Create(Self); + PS_Import_Controls := TPSImport_Controls.Create(Self); + PS_Import_StdCtrls := TPSImport_StdCtrls.Create(Self); + PS_Import_Forms := TPSImport_Forms.Create(Self); + PS_Import_DateUtils := TPSImport_DateUtils.Create(Self); + PS_Import_ComObj := TPSImport_ComObj.Create(Self); + PS_Import_DB := TPSImport_DB.Create(Self); + //Libraries := [slClasses,slControls,slStdCtrls,slForms,slDateUtils,slCustom]; Durch DEFAULT festgelegt! + if Assigned(OnCreate) then + begin + OnCreate(Self); + end; +end; + +destructor TScriptManager.Destroy; +begin + if Assigned(OnDestroy) then + begin + OnDestroy(Self); + end; + VarSelf := nil; + VarApplication := nil; + ReturnMode := srNone; + ReturnStyle := srSimple; + //ReturnSL.Free; Pointer auf ext. Komponente, nicht freigeben + Log.Free; + Code.Free; + //ScriptEngine.Free; Wird automatisch mit dem Owner vom TScriptManager freigegeben + About.Free; + {PS_Import_DB.Free; + PS_Import_ComObj.Free; + PS_Import_DateUtils.Free; + PS_Import_Forms.Free; + PS_Import_StdCtrls.Free; + PS_Import_Controls.Free; + PS_Import_Classes.Free; } + CustomPlugins.Free; + ScriptEngine.Free; + inherited; +end; + +function TScriptManager.GetCompilerOptions: TPSCompOptions; +begin + Result := ScriptEngine.CompilerOptions; +end; + +procedure TScriptManager.SetCompilerOptions(const Value: TPSCompOptions); +begin + ScriptEngine.CompilerOptions := Value; + ScriptEngine.Stop +end; + +function TScriptManager.GetCodeLines(Index: Integer): String; +begin + if (Index >= 0) and (Index <= Code.Count - 1) then + begin + Result := Code.Strings[Index]; + end else + begin + raise EInvalidCodeLine.Create(Error_InvalidCodeLine); + end; +end; + +procedure TScriptManager.SetCodeLines(Index: Integer; const Value: String); +begin + if (Index >= 0) and (Index <= Code.Count - 1) then + begin + Code.Strings[Index] := Value; + if ReturnMode = srAll then + begin + AddLog('Code line ' + IntToStr(Index + 1) + ' modified'); + end; + end else + begin + raise EInvalidCodeLine.Create(Error_InvalidCodeLine); + end; +end; + +function TScriptManager.GetCodeCount; +begin + Result := Code.Count; +end; + +function TScriptManager.GetRunning: Boolean; +begin + Result := ScriptEngine.Running; +end; + +procedure TScriptManager.Stop; +begin + ScriptEngine.Stop; +end; + +function TScriptManager.GetPluginItems(Index: Integer): TPSPlugin; +begin + Result := TPSPluginItem(CustomPlugins.Items[Index]).Plugin; +end; + +procedure TScriptManager.SetPluginItems(Index: Integer; const Value: TPSPlugin); +begin + TPSPluginItem(CustomPlugins.Items[Index]).Plugin := Value; +end; + +function TScriptManager.GetPluginCount: Integer; +begin + Result := ScriptEngine.Plugins.Count; +end; + +procedure TScriptManager.SetLibraries(const Value: TScriptLibraries); +begin + ScriptEngine.Plugins.Clear; + FLibraries := Value; + { Import-Unit-Komponenten integrieren } + if slClasses in FLibraries then + begin + AddPlugin(ScriptEngine.Plugins,PS_Import_Classes); + end else + begin + FLibraries := FLibraries - [slControls,slStdCtrls,slForms,slDateUtils,slComObj,slDB]; + end; + if slControls in FLibraries then + begin + AddPlugin(ScriptEngine.Plugins,PS_Import_Controls); + end else + begin + FLibraries := FLibraries - [slStdCtrls,slForms]; + end; + if slStdCtrls in Libraries then + begin + AddPlugin(ScriptEngine.Plugins,PS_Import_StdCtrls); + end else + begin + FLibraries := FLibraries - [slForms]; + end; + if slForms in FLibraries then + begin + AddPlugin(ScriptEngine.Plugins,PS_Import_Forms); + end; + if slDateUtils in FLibraries then + begin + AddPlugin(ScriptEngine.Plugins,PS_Import_DateUtils); + end; + if slComObj in FLibraries then + begin + AddPlugin(ScriptEngine.Plugins,PS_Import_ComObj); + end; + if slDB in FLibraries then + begin + AddPlugin(ScriptEngine.Plugins,PS_Import_DB); + end; + if slCustom in FLibraries then + begin + AddCustomPlugins; + end; +end; + +function TScriptManager.GetUsePreProcessor: Boolean; +begin + Result := ScriptEngine.UsePreProcessor; +end; + +procedure TScriptManager.SetUsePreProcessor(const Value: Boolean); +begin + ScriptEngine.UsePreProcessor := Value; +end; + +function TScriptManager.GetMainFileName: AnsiString; +begin + Result := ScriptEngine.MainFileName; +end; + +procedure TScriptManager.SetMainFileName(const Value: AnsiString); +begin + ScriptEngine.MainFileName := Value; +end; + +function TScriptManager.GetDefines: TStrings; +begin + Result := ScriptEngine.Defines; +end; + +procedure TScriptManager.SetDefines(const Value: TStrings); +begin + ScriptEngine.Defines := Value; +end; + +procedure TScriptManager.AddLog(Entry: string); +const + PrefixBegin = '['; + PrefixEnd = ']'; +begin + Log.Add(Entry); + if ReturnTarget = nil then + begin + raise EMissingReturnTarget.Create(Error_MissingReturnTarget); + end; + if ReturnStyle = srTime then + begin + Entry := PrefixBegin + TimeToStr(Time) + PrefixEnd + ' ' + Entry; + end; + if ReturnStyle = srDateTime then + begin + Entry := PrefixBegin + DateToStr(Date) + ' ' + TimeToStr(Time) + PrefixEnd + ' ' + Entry; + end; + if ReturnStyle = srName then + begin + if Length(Name) > 0 then + begin + Entry := PrefixBegin + Name + PrefixEnd + ' ' + Entry; + end else + begin + raise EMissingComponentName.Create(Error_MissingComponentName); + end; + end; + ReturnTarget.Add(Entry); + if Assigned(OnReturn) then + begin + OnReturn(Self,Entry); + end; +end; + +procedure TScriptManager.AddCustomPlugins; +var + Index: Integer; +begin + for Index := 0 to CustomPlugins.Count - 1 do + begin + AddPlugin(ScriptEngine.Plugins,TPSPluginItem(CustomPlugins.Items[Index]).Plugin); + end; +end; + +function TScriptManager.CompileAndExecute: Boolean; +begin + Result := False; + ScriptEngine.Script.Assign(Code); + if ReturnMode = srAll then + begin + AddLog('Compiling script...'); + end; + if ScriptEngine.Compile = True then + begin + if ReturnMode = srAll then + begin + AddLog('Script succesfully compiled'); + end; + if ReturnMode = srAll then + begin + AddLog('Executing script...'); + end; + if ScriptEngine.Execute = False then + begin + if (ReturnMode = srAll) or (ReturnMode = srErrors) then + begin + AddLog(ScriptEngine.ExecErrorToString + ' at ' + Inttostr(ScriptEngine.ExecErrorProcNo) + '.'+Inttostr(ScriptEngine.ExecErrorByteCodePosition)); + end; + end else + begin + if ReturnMode = srAll then + begin + AddLog('Script succesfully executed'); + end; + Result := True; + end; + end else + begin + if ReturnMode = srAll then + begin + AddLog('Script compilation failed'); + end; + end; +end; + +function TScriptManager.CodeAddLine(const S: String): Integer; +begin + Result := Code.Add(S); +end; + +procedure TScriptManager.CodeAddLines(Strings: TStrings); +begin + Code.AddStrings(Strings); +end; + +procedure TScriptManager.CodeDeleteLine(Index: Integer); +begin + Code.Delete(Index); +end; + +procedure TScriptManager.CodeLoadFromFile(FileName: String); +begin + Code.LoadFromFile(FileName); + if ReturnMode = srAll then + begin + AddLog('Script code loaded successfully'); + end; + if Assigned(OnCodeLoad) then + begin + OnCodeLoad(Self); + end; +end; + +procedure TScriptManager.CodeLoadFromStream(Stream: TStream); +begin + Code.LoadFromStream(Stream); + if ReturnMode = srAll then + begin + AddLog('Script code loaded successfully'); + end; + if Assigned(OnCodeLoad) then + begin + OnCodeLoad(Self); + end; +end; + +procedure TScriptManager.CodeAssign(Source: TPersistent); +begin + Code.Assign(Source); + if ReturnMode = srAll then + begin + AddLog('Script code assigned successfully'); + end; + if Assigned(OnCodeAssign) then + begin + OnCodeAssign(Self); + end; +end; + +procedure TScriptManager.CodeClear; +begin + Code.Clear; + if ReturnMode = srAll then + begin + AddLog('Script code cleared successfully'); + end; +end; + +procedure TScriptManager.PluginAdd(Plugin: TPSPlugin); +begin + AddPlugin(CustomPlugins,Plugin); + SetLibraries(Libraries); +end; + +procedure TScriptManager.PluginDelete(Plugin: TPSPlugin); +begin + DeletePlugin(CustomPlugins,Plugin); + SetLibraries(Libraries); +end; + +function TScriptManager.ScriptEngineNeedFile(Sender:TObject; const OriginFileName: AnsiString; var FileName, Output: AnsiString): Boolean; +begin + Result := ScriptEngine.OnNeedFile(Sender,OriginFileName,FileName,Output); + if Assigned(OnNeedFile) then + begin + OnNeedFile(Self,OriginFileName,FileName,OutPut); + end; +end; + +procedure TScriptManager.ScriptEngineCompile(Sender: TPSScript); +begin + with (Sender as TPSScript) do + begin + { VARIABLEN } + if slForms in Libraries then + begin + if Assigned(VarSelf) = True then + begin + AddRegisteredVariable('Self','TForm'); + end; + if Assigned(VarApplication) = True then + begin + AddRegisteredVariable('Application','TApplication'); + end; + end; + { TYPEN } + //Comp.AddTypeS('TFileExecuteMode','(feOpen,feEdit)'); + { FUNKTIONEN } + AddMethod(Self,@TScriptManager.PS_Random,'function Random(LimitPlusOne: Integer): Integer'); + //AddMethod(Self,@TScriptManager.PS_ExecuteFile,'function ExecuteFile(FileName: String; ExecMode: TFileExecuteMode): Boolean'); + AddMethod(Self,@TScriptManager.PS_InputBox,'function InputBox(const ACaption, APrompt, ADefault: String): String'); + AddMethod(Self,@TScriptManager.PS_InputQuery,'function InputQuery(const ACaption, APrompt: String; var Value: String): Boolean'); + { PROZEDUREN } + AddMethod(Self,@TScriptManager.PS_ShowMessage,'procedure ShowMessage (const Msg: String)'); + AddMethod(Self,@TScriptManager.PS_Randomize,'procedure Randomize'); + AddMethod(Self,@TScriptManager.PS_Sleep,'procedure Sleep(Milliseconds: Cardinal)'); + AddMethod(Self,@TScriptManager.PS_About,'procedure About'); + if SecureMode = False then + begin + AddMethod(Self,@TScriptManager.CodeAddLine,'function CodeAddLine(const S: String): Integer)'); + AddMethod(Self,@TScriptManager.CodeAddLines,'procedure CodeAddLines(Strings: TStrings)'); + AddMethod(Self,@TScriptManager.CodeDeleteLine,'procedure CodeDeleteLine(Index: Integer)'); + AddMethod(Self,@TScriptManager.CodeLoadFromFile,'procedure CodeLoadFromFile(FileName: String)'); + AddMethod(Self,@TScriptManager.CodeLoadFromStream,'procedure CodeLoadFromStream(Stream: TStream)'); + AddMethod(Self,@TScriptManager.CodeAssign,'procedure CodeAssign(Source: TPersistent)'); + AddMethod(Self,@TScriptManager.CodeClear,'procedure CodeClear'); + AddMethod(Self,@TScriptManager.CompileAndExecute,'function CompileAndExecute: Boolean'); + end; + end; + if Assigned(OnCompile) then + begin + OnCompile(Self); + end; +end; + +procedure TScriptManager.ScriptEngineExecute(Sender: TPSScript); +begin + with (Sender as TPSScript) do + begin + if Assigned(VarSelf) = True then + begin + SetVarToInstance('Self',VarSelf); + end; + if Assigned(VarApplication) = True then + begin + SetVarToInstance('Application',VarApplication); + end; + end; + if Assigned(OnExecute) then + begin + OnExecute(Self); + end; +end; + +procedure TScriptManager.ScriptEngineAfterExecute(Sender: TPSScript); +begin + with (Sender as TPSScript) do + begin + // ScriptEngine.Plugins.Clear; NICHT BENUTZEN! + end; + if Assigned(OnAfterExecute) then + begin + OnAfterExecute(Self); + end; +end; + +procedure TScriptManager.ScriptEngineLine(Sender: TObject); +begin + with (Sender as TPSScript) do + begin + //... Nur definieren falls verwendet/benötigt! + end; + if Assigned(OnLine) then + begin + OnLine(Self); + end; +end; + +function TScriptManager.PS_Random(LimitPlusOne: Integer): Integer; +begin + Result := Random(LimitPlusOne); +end; + +function TScriptManager.PS_ExecuteFile(FileName: String; ExecMode: TFileExecuteMode): Boolean; +begin + Result := ExecuteFile(FileName,feOpen); +end; + +function TScriptManager.PS_InputBox(const ACaption, APrompt, ADefault: String): String; +begin + Result := InputBox(ACaption,APrompt,ADefault); +end; + +function TScriptManager.PS_InputQuery(const ACaption, APrompt: String; var Value: String): Boolean; +begin + Result := InputQuery(ACaption,APrompt,Value); +end; + +procedure TScriptManager.PS_ShowMessage(const Msg: string); +begin + ShowMessage(Msg); +end; + +procedure TScriptManager.PS_Randomize; +begin + Randomize; +end; + +procedure TScriptManager.PS_Sleep(Milliseconds: Cardinal); +begin + Sleep(Milliseconds); +end; + +procedure TScriptManager.PS_About; +begin + MessageDlg(ScriptComponent_Name + ' Component v' + + FloatToStr(ScriptComponent_Version) + #10 + + 'For: Borland Delphi' + #10 + + ScriptComponent_Copyright + ' by ' + + ScriptComponent_Author + #10 + + 'Requires and uses: RemObjects PascalScript component library', + mtInformation,[mbOK],0); +end; + +end. diff --git a/Source/uSysTools.pas b/Source/uSysTools.pas new file mode 100644 index 0000000..84ec9fd --- /dev/null +++ b/Source/uSysTools.pas @@ -0,0 +1,186 @@ +unit uSysTools; + +////////////////////////////////////// +/// Lina System Tools Unit /// +/// **************************** /// +/// (c) 2014 Dennis Göhlert a.o. /// +////////////////////////////////////// + +interface + + { Da Delphi vor Version 2009 noch keine Generics kannte, musste die + TIntegerList-,TBooleanList-,TFloatList- und TPointList-Deklaration auf + Compiler-Versionen 20.0 oder höher beschränkt werden. + Meines Wissens nach gibt es keine einfache Möglichkeit, Typisierte Listen + auch in ältere Versionen zu integrieren. } + +uses + { Standard-Units } + Classes, SysUtils, Math, Windows, + {$IFNDEF NOGENERIC} + Types, Generics.Collections, + {$ENDIF} + { Andere Package-Units } + uFileTools, uBase; + +type + { Fehlermeldungen } + EWinUserInformation = class(Exception); + +type + {$IFNDEF NOGENERIC} + TIntegerList = TList; + TBooleanList = TList; + TFloatList = TList; + TPointList = TList; + {$ENDIF} + + function BoolToInt(B: Boolean): Integer; + function IntToBool(Value: Integer): Boolean; + + function StrIsInt(const S: String): Boolean; + function StrIsFloat(const S: String): Boolean; + function StrIsBool(const S: String): Boolean; + function FloatIsInt(Value: Extended): Boolean; + + function SystemLanguage: String; + + function WinUserName: String; + function WinUserDirectory: String; + function WinUserAdmin: Boolean; + function WinUserExists(UsrNme: String): Boolean; + +implementation + +function BoolToInt(B: Boolean): Integer; +begin + if B then + begin + Result := not 0; + end else + begin + Result := 0; + end; +end; + +function IntToBool(Value: Integer): Boolean; +begin + Result := (Value <> 0); +end; + +function StrIsInt(const S: String): Boolean; +var + TryMethodBuffer: Integer; +begin + Result := TryStrToInt(S,TryMethodBuffer); +end; + +function StrIsFloat(const S: String): Boolean; +var + TryMethodBuffer: Extended; +begin + Result := TryStrToFloat(S,TryMethodBuffer); +end; + +function StrIsBool(const S: String): Boolean; +var + TryMethodBuffer: Boolean; +begin + Result := TryStrToBool(S,TryMethodBuffer); +end; + +function FloatIsInt(Value: Extended): Boolean; +begin + Result := (Ceil(Value) = Floor(Value)); +end; + +function SystemLanguage: String; +begin + Result := Languages.NameFromLocaleID[Languages.UserDefaultLocale]; +end; + +function WinUserName: String; +var + Buffer: array [0..255] of Char; + Size: DWord; +begin + Size := SizeOf(Buffer); + if not GetUserName(Buffer, Size) then + begin + raise EWinUserInformation.Create('Could not collect information on user name'); + end; + SetString(Result,Buffer,Size - 1); +end; + +function WinUserDirectory: String; +begin + Result := GetEnvironmentVariable('USERPROFILE'); +end; + +function WinUserAdmin: Boolean; +const + SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority = (Value: (0,0,0,0,0,5)); + SECURITY_BUILTIN_DOMAIN_RID = $00000020; + DOMAIN_ALIAS_RID_ADMINS = $00000220; +var + hAccessToken: THandle; + ptgGroups: PTokenGroups; + dwInfoBufferSize: DWORD; + psidAdministrators: PSID; + X: Integer; + bSuccess: BOOL; +begin + Result := False; + bSuccess := False; + ptgGroups := nil; + psidAdministrators := nil; + try + bSuccess := OpenThreadToken(GetCurrentThread,TOKEN_QUERY,True,hAccessToken); + if not bSuccess then + begin + if GetLastError = ERROR_NO_TOKEN then + begin + bSuccess := OpenProcessToken(GetCurrentProcess,TOKEN_QUERY,hAccessToken); + end; + end; + if bSuccess then + begin + GetMem(ptgGroups,1024); + bSuccess := GetTokenInformation(hAccessToken,TokenGroups,ptgGroups,1024,dwInfoBufferSize); + if bSuccess then + begin + AllocateAndInitializeSid(SECURITY_NT_AUTHORITY,2,SECURITY_BUILTIN_DOMAIN_RID,DOMAIN_ALIAS_RID_ADMINS,0,0,0,0,0,0,psidAdministrators); + {$R-} + for X := 0 to ptgGroups.GroupCount - 1 do + begin + if EqualSid(psidAdministrators,ptgGroups.Groups[X].Sid) then + begin + Result := True; + Break; + end; + end; + {$R+} + end; + end; + finally + if bSuccess then + begin + CloseHandle(hAccessToken); + end; + if Assigned(ptgGroups) then + begin + FreeMem(ptgGroups); + end; + if Assigned(psidAdministrators) then + begin + FreeSid(psidAdministrators); + end; + end; +end; + +function WinUserExists(UsrNme: String): Boolean; +begin + //... +end; + +end. diff --git a/Source/uVirtObj.pas b/Source/uVirtObj.pas new file mode 100644 index 0000000..7d6c1e8 --- /dev/null +++ b/Source/uVirtObj.pas @@ -0,0 +1,93 @@ +unit uVirtObj; + +////////////////////////////////////// +/// Lina Virtual Object Unit /// +/// **************************** /// +/// (c) 2014 Dennis Göhlert a.o. /// +////////////////////////////////////// + +interface + +uses + { Standard-Units } + SysUtils, Classes, + { Andere Package-Units } + uBase; + +type + { Hauptklassen } + + { VirtualObject } + TVirtualObject = class + + end; + + TVirtualObjects = array of TVirtualObject; + + { VirtualMethod } + TVirtualMethod = class + + end; + + TVirtualMethods = array of TVirtualMethod; + + { VirtualLirary } + TVirtualLibray = class + + end; + + TVirtualLibraries = array of TVirtualLibray; + + { VirtualClass } + TVirtualClass = class + + end; + + TVirtualClasses = array of TVirtualClass; + + { VirtualProgram } + TVirtualProgram = class(TComponent) + private + { Private-Deklarationen } + FObjects: TVirtualObjects; + FAbout: TComponentAbout; + public + { Public-Deklarationen } + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + { Published-Deklarationen } + // property Objects [Index: Integer]: TVirtualObject read FObjects write FObjects; + { Meta-Daten } + property About: TComponentAbout read FAbout; + end; + + procedure Register; + +const + { Meta-Daten } + VirtualComponent_Name = 'ScriptManager'; + VirtualComponent_Version = 1.0; + VirtualComponent_Copyright = 'Copyright © 2014'; + VirtualComponent_Author = 'Dennis Göhlert a.o.'; + +implementation + +procedure Register; +begin + RegisterComponents(ComponentsPage,[TVirtualProgram]); +end; + +constructor TVirtualProgram.Create(AOwner: TComponent); +begin + inherited; + //... +end; + +destructor TVirtualProgram.Destroy; +begin + //... + inherited; +end; + +end.