|
- unit uutlConsoleHelper;
-
- { Package: Utils
- Prefix: utl - UTiLs
- Beschreibung: diese Unit implementiert Helper Klassen für Consolen Ein- und Ausgaben,
- sowie Menüführung und Autovervollständigung }
-
- {$mode objfpc}{$H+}
-
- interface
-
- uses
- Classes, SysUtils, fgl, uutlMCF, uutlCommon, uutlGenerics, syncobjs;
-
- type
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlParameterStringFlag = (psfBrackets);
- TutlParameterStringFlags = set of TutlParameterStringFlag;
- TutlMenuItem = class;
- TutlMenuParameter = class
- private
- fParent: TutlMenuItem;
- fOptional: Boolean;
- fName, fDescription, fValue: String;
- public
- property Parent: TutlMenuItem read fParent;
- property Optional: Boolean read fOptional;
- property Value: String read fValue;
- property Name: String read fName;
- property Description: String read fDescription;
-
- procedure WriteConfig(const aMCF: TutlMCFSection); virtual;
- procedure ReadConfig(const aMCF: TutlMCFSection); virtual;
-
- procedure GetAutoCompleteStrings(const aStrings: TStrings); virtual; abstract;
- function SetValue(const aValue: String): Boolean; virtual;
- function GetString(const aOptions: TutlParameterStringFlags = [psfBrackets]): String; virtual;
-
- constructor Create(const aOptional: Boolean; const aName, aDescription: String);
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlMenuParameterListBase = specialize TFPGObjectList<TutlMenuParameter>;
- TutlMenuParameterList = class(TutlMenuParameterListBase)
- public
- function HasParameter(const aName: String): Boolean;
- function FindParameter(const aName: String): TutlMenuParameter;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlMenuParameterStack = class(TutlMenuParameterList)
- public
- procedure Push(const aValue: TutlMenuParameter);
- function Seek: TutlMenuParameter;
- function Pop: TutlMenuParameter;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlParameterType = (ptString = 0, ptInteger, ptBoolean, ptHex, ptPreset);
- TutlParameterTypeH = specialize TutlEnumHelper<TutlParameterType>;
- TutlMenuParameterSingle = class(TutlMenuParameter)
- private
- fType: TutlParameterType;
- public
- property ParamType: TutlParameterType read fType;
-
- procedure WriteConfig(const aMCF: TutlMCFSection); override;
- procedure ReadConfig(const aMCF: TutlMCFSection); override;
-
- procedure GetAutoCompleteStrings(const aStrings: TStrings); override;
- function SetValue(const aValue: String): Boolean; override;
- function GetString(const aOptions: TutlParameterStringFlags = [psfBrackets]): String; override;
-
- constructor Create(const aOptional: Boolean; const aName, aDescription: String; const aType: TutlParameterType);
- destructor Destroy; override;
- end;
- TutlMenuParameterSingleList = specialize TFPGObjectList<TutlMenuParameterSingle>;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlMenuParameterGroup = class(TutlMenuParameter)
- private
- fParameters: TutlMenuParameterSingleList;
- function GetCount: Integer;
- function GetParameter(const aIndex: Integer): TutlMenuParameterSingle;
- public
- property Count: Integer read GetCount;
- property Parameter[const aIndex: Integer]: TutlMenuParameterSingle read GetParameter; default;
-
- procedure WriteConfig(const aMCF: TutlMCFSection); override;
- procedure ReadConfig(const aMCF: TutlMCFSection); override;
-
- procedure GetAutoCompleteStrings(const aStrings: TStrings); override;
- function SetValue(const aValue: String): Boolean; override;
- function GetString(const aOptions: TutlParameterStringFlags = [psfBrackets]): String; override;
-
- function AddParameter(const aName, aDescription: String;
- const aType: TutlParameterType): TutlMenuParameterSingle; overload;
- function AddParameter(const aParameter: TutlMenuParameterSingle): TutlMenuParameterSingle; overload;
- procedure DelParameter(const aIndex: Integer);
-
- constructor Create(const aOptional: Boolean; const aName, aDescription: String);
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlCallback = procedure(aSender: TObject) of object;
- TutlMenuItemList = specialize TFPGObjectList<TutlMenuItem>;
- TutlMenuItem = class(TObject)
- private
- fCommand: String;
- fDescription: String;
- fCallback: TutlCallback;
- fExecutable: Boolean;
- fParent: TutlMenuItem;
- fHelpItem: TutlMenuItem;
-
- function GetCount: Integer;
- function GetItems(const aIndex: Integer): TutlMenuItem;
- function GetMenuPath: String;
- function GetParamCount: Integer;
- function GetParameters(const aIndex: Integer): TutlMenuParameter;
- function GetParameterString: String;
- procedure SetCallback(aValue: TutlCallback);
- protected
- fItems: TutlMenuItemList;
- fParameters: TutlMenuParameterList;
-
- procedure WriteConfig(const aMCF: TutlMCFSection); virtual;
- procedure ReadConfig(const aMCF: TutlMCFSection); virtual;
- public
- property Command: String read fCommand write fCommand;
- property Description: String read fDescription write fDescription;
- property Callback: TutlCallback read fCallback write SetCallback;
- property Executable: Boolean read fExecutable;
- property MenuPath: String read GetMenuPath;
- property ParameterString: String read GetParameterString;
- property ParamCount: Integer read GetParamCount;
- property Count: Integer read GetCount;
- property Parent: TutlMenuItem read fParent;
- property Items[const aIndex: Integer]: TutlMenuItem read GetItems; default;
- property Parameters[const aIndex: Integer]: TutlMenuParameter read GetParameters;
-
- procedure GetAutoCompleteStrings(const aList: TStrings; const aParameter: TutlMenuParameterList); virtual;
- function GetString: String;
- function AddItem(const aCmd, aDesc: String; const aCallback: TutlCallback): TutlMenuItem; overload;
- function AddItem(const aItem: TutlMenuItem): TutlMenuItem; overload;
- procedure DelItem(const aIndex: Integer);
- function AddParameter(const aParameter: TutlMenuParameter): TutlMenuParameter;
- procedure DelParameter(const aIndex: Integer);
-
- procedure LoadFromStream(const aStream: TStream);
- procedure SaveToStream(const aStream: TStream);
-
- constructor Create(const aParent: TutlMenuItem; const aCmd, aDesc: String; const aCallback: TutlCallback);
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlParseResult = (prUnknownCommand, prInvalidParam, prInvalidParamCount, prSuccess, prIncompleteCmd);
- TutlHelpOption = (hoNone, hoAll, hoDetail);
- TutlCommandMenu = class(TutlMenuItem)
- private
- fInvalidParam: String;
- fUnknownCmd: String;
- fLastCmd: String;
- fCurrentParamCount: Integer;
- function GetCmdParameter: TutlMenuParameterList;
- protected
- fCmdParameter: TutlMenuParameterStack;
- fCmdStack: TutlStringStack;
- fCurrentMenu: TutlMenuItem;
- procedure SplitCmdString(const aText: String; const aChar: Char);
- function ParseCommand: TutlParseResult;
- public
- property CmdParameter: TutlMenuParameterList read GetCmdParameter;
- property LastCmd: String read fLastCmd;
-
- procedure ExecuteCommand(const aCmd: String); virtual;
-
- procedure DisplayHelp(const aRefMenu: TutlMenuItem = nil; const aOption: TutlHelpOption = hoNone);
- procedure DisplayIncompleteCommand;
- procedure DisplayUnknownCommand(const aCmd: String = '');
- procedure DisplayInvalidParamCount(const aParamCount: Integer = -1);
- procedure DisplayInvalidParam(const aParam: String = '');
-
- constructor Create(const aHelp: String);
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlInputEvent = procedure(aSender: TObject; const aInput: String) of Object;
- TutlAutoCompleteEvent = function(aSender: TObject; const aInput: String; const aDisplayPossibilities: Boolean): String of Object;
- TutlCommandPrompt = class(TObject)
- private
- fCurrent: String;
- fInput: String;
- fPrefix: String;
- fHistoryBackup: String;
- fCurID: Integer;
- fStartIndex: Integer;
- fHistoryID: Integer;
- fHistoryEnabled: Boolean;
- fRunning: Boolean;
- fHiddenChar: Char;
- fConsoleCS: TCriticalSection;
- fHistory: TStringList;
-
- fOnInput: TutlInputEvent;
- fOnAutoComplete: TutlAutoCompleteEvent;
-
- function GetCurrent: String;
- procedure SetCurrent(aValue: String);
- procedure SetHiddenChar(aValue: Char);
- procedure SetPrefix(aValue: String);
-
- procedure CursorToStart;
- procedure CursorToEnd;
- procedure DelInput(const aAll: Boolean = false);
- procedure RestoreInput;
- procedure CursorRight;
- procedure CursorLeft;
- procedure DelChar(const aBeforeCursor: Boolean = false);
- procedure WriteChar(const c: Char);
-
- function ReadLnEx: String;
- function AutoComplete(const aInput: String; const aDisplayPossibilities: Boolean): String;
- procedure AddHistory(const aInput: String);
-
- procedure DoInput;
- public
- property Prefix: String read fPrefix write SetPrefix;
- property Current: String read GetCurrent write SetCurrent;
- property HistoryEnabled: Boolean read fHistoryEnabled write fHistoryEnabled;
- property HiddenChar: Char read fHiddenChar write SetHiddenChar;
- property OnInput: TutlInputEvent read fOnInput write fOnInput;
- property OnAutoComplete: TutlAutoCompleteEvent read fOnAutoComplete write fOnAutoComplete;
-
- procedure Start;
- procedure Stop;
- procedure Reset;
- procedure Clear; //löscht nur die Ausgabe und hält die Eingabe intern
- procedure Restore; //stellt die Ausgabe wieder her
-
- constructor Create(const aConsoleCS: TCriticalSection);
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlConsoleMenu = class(TutlCommandMenu)
- private
- fExitMenu: TutlMenuItem;
- fCommandPrompt: TutlCommandPrompt;
- fIsAsking: Boolean;
- fInputBackup: String;
-
- fOnAnswer: TutlInputEvent;
-
- procedure CommandInput(aSender: TObject; const aCmd: String);
- function AutoComplete(aSender: TObject; const aCmd: String;
- const aDisplayPossibilities: Boolean): String;
-
- procedure DoAnswer(const aInput: String);
- public
- property CommandPrompt: TutlCommandPrompt read fCommandPrompt;
- property OnAnswer: TutlInputEvent read fOnAnswer;
-
- procedure ExecuteCommand(const aCmd: String); override;
- procedure StartMenu;
- procedure ExitMenu;
- procedure Ask(const aQuestion: String; const aHidden: Boolean = false; const aOnAnswer: TutlInputEvent = nil);
-
- constructor Create(const aHelp: String; const aConsoleCS: TCriticalSection);
- destructor Destroy; override;
- end;
-
- implementation
-
- uses
- strutils,
- uutlLogger,
- uutlKeyCodes,
- {$IFDEF WINDOWS}
- windows
- {$ELSE}
- crt
- {$ENDIF};
-
- const
- COMMAND_PROMPT_PREFIX = '> ';
-
- {$IFDEF WINDOWS}
- var
- ScanCode : char;
- SpecialKey : boolean;
- DoingNumChars: Boolean;
- DoingNumCode: Byte;
-
- Function RemapScanCode (ScanCode: byte; CtrlKeyState: byte; keycode:longint): byte;
- { Several remappings of scancodes are necessary to comply with what
- we get with MSDOS. Special Windows keys, as Alt-Tab, Ctrl-Esc etc.
- are excluded }
- var
- AltKey, CtrlKey, ShiftKey: boolean;
- const
- {
- Keypad key scancodes:
-
- Ctrl Norm
-
- $77 $47 - Home
- $8D $48 - Up arrow
- $84 $49 - PgUp
- $8E $4A - -
- $73 $4B - Left Arrow
- $8F $4C - 5
- $74 $4D - Right arrow
- $4E $4E - +
- $75 $4F - End
- $91 $50 - Down arrow
- $76 $51 - PgDn
- $92 $52 - Ins
- $93 $53 - Del
- }
- CtrlKeypadKeys: array[$47..$53] of byte =
- ($77, $8D, $84, $8E, $73, $8F, $74, $4E, $75, $91, $76, $92, $93);
-
- begin
- AltKey := ((CtrlKeyState AND
- (RIGHT_ALT_PRESSED OR LEFT_ALT_PRESSED)) > 0);
- CtrlKey := ((CtrlKeyState AND
- (RIGHT_CTRL_PRESSED OR LEFT_CTRL_PRESSED)) > 0);
- ShiftKey := ((CtrlKeyState AND SHIFT_PRESSED) > 0);
-
- if AltKey then
- begin
- case ScanCode of
- // Digits, -, =
- $02..$0D: inc(ScanCode, $76);
- // Function keys
- $3B..$44: inc(Scancode, $2D);
- $57..$58: inc(Scancode, $34);
- // Extended cursor block keys
- $47..$49, $4B, $4D, $4F..$53:
- inc(Scancode, $50);
- // Other keys
- $1C: Scancode := $A6; // Enter
- $35: Scancode := $A4; // / (keypad and normal!)
- end
- end
- else if CtrlKey then
- case Scancode of
- // Tab key
- $0F: Scancode := $94;
- // Function keys
- $3B..$44: inc(Scancode, $23);
- $57..$58: inc(Scancode, $32);
- // Keypad keys
- $35: Scancode := $95; // \
- $37: Scancode := $96; // *
- $47..$53: Scancode := CtrlKeypadKeys[Scancode];
- //Enter on Numpad
- $1C:
- begin
- Scancode := $0A;
- SpecialKey := False;
- end;
- end
- else if ShiftKey then
- case Scancode of
- // Function keys
- $3B..$44: inc(Scancode, $19);
- $57..$58: inc(Scancode, $30);
- //Enter on Numpad
- $1C:
- begin
- Scancode := $0D;
- SpecialKey := False;
- end;
- end
- else
- case Scancode of
- // Function keys
- $57..$58: inc(Scancode, $2E); // F11 and F12
- //Enter on NumPad
- $1C:
- begin
- Scancode := $0D;
- SpecialKey := False;
- end;
- end;
- RemapScanCode := ScanCode;
- end;
-
-
- function KeyPressed : boolean;
- var
- nevents,nread : dword;
- buf : TINPUTRECORD;
- AltKey: Boolean;
- c : longint;
- begin
- KeyPressed := FALSE;
- if ScanCode <> #0 then
- KeyPressed := TRUE
- else
- begin
- GetNumberOfConsoleInputEvents(TextRec(input).Handle,nevents{%H-});
- while nevents>0 do
- begin
- ReadConsoleInputA(TextRec(input).Handle,buf{%H-},1,nread{%H-});
- if buf.EventType = KEY_EVENT then
- if buf.Event.KeyEvent.bKeyDown then
- begin
- { Alt key is VK_MENU }
- { Capslock key is VK_CAPITAL }
-
- AltKey := ((Buf.Event.KeyEvent.dwControlKeyState AND
- (RIGHT_ALT_PRESSED OR LEFT_ALT_PRESSED)) > 0);
- if not(Buf.Event.KeyEvent.wVirtualKeyCode in [VK_SHIFT, VK_MENU, VK_CONTROL,
- VK_CAPITAL, VK_NUMLOCK,
- VK_SCROLL]) then
- begin
- keypressed:=true;
-
- if (ord(buf.Event.KeyEvent.AsciiChar) = 0) or
- (buf.Event.KeyEvent.dwControlKeyState and (LEFT_ALT_PRESSED or ENHANCED_KEY) > 0) then
- begin
- SpecialKey := TRUE;
- ScanCode := Chr(RemapScanCode(Buf.Event.KeyEvent.wVirtualScanCode, Buf.Event.KeyEvent.dwControlKeyState,
- Buf.Event.KeyEvent.wVirtualKeyCode));
- end
- else
- begin
- { Map shift-tab }
- if (buf.Event.KeyEvent.AsciiChar=#9) and
- (buf.Event.KeyEvent.dwControlKeyState and SHIFT_PRESSED > 0) then
- begin
- SpecialKey := TRUE;
- ScanCode := #15;
- end
- else
- begin
- SpecialKey := FALSE;
- ScanCode := Chr(Ord(buf.Event.KeyEvent.AsciiChar));
- end;
- end;
-
- if AltKey then
- begin
- case Buf.Event.KeyEvent.wVirtualScanCode of
- 71 : c:=7;
- 72 : c:=8;
- 73 : c:=9;
- 75 : c:=4;
- 76 : c:=5;
- 77 : c:=6;
- 79 : c:=1;
- 80 : c:=2;
- 81 : c:=3;
- 82 : c:=0;
- else
- break;
- end;
- DoingNumChars := true;
- DoingNumCode := Byte((DoingNumCode * 10) + c);
- Keypressed := false;
- Specialkey := false;
- ScanCode := #0;
- end
- else
- break;
- end;
- end
- else
- begin
- if (Buf.Event.KeyEvent.wVirtualKeyCode in [VK_MENU]) then
- if DoingNumChars then
- if DoingNumCode > 0 then
- begin
- ScanCode := Chr(DoingNumCode);
- Keypressed := true;
-
- DoingNumChars := false;
- DoingNumCode := 0;
- break
- end; { if }
- end;
- { if we got a key then we can exit }
- if keypressed then
- exit;
- GetNumberOfConsoleInputEvents(TextRec(input).Handle,nevents);
- end;
- end;
- end;
-
- function ReadKey: char;
- begin
- while (not KeyPressed) do
- Sleep(1);
- if SpecialKey then begin
- ReadKey := #0;
- SpecialKey := FALSE;
- end else begin
- ReadKey := ScanCode;
- ScanCode := #0;
- end;
- end;
- {$ENDIF}
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlMenuParameter////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlMenuParameter.WriteConfig(const aMCF: TutlMCFSection);
- begin
- with aMCF do begin
- SetString('classname', self.ClassName);
- SetBool ('optional', fOptional);
- SetString('name', fName);
- SetString('description', fDescription);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlMenuParameter.ReadConfig(const aMCF: TutlMCFSection);
- begin
- with aMCF do begin
- fOptional := GetBool ('optional', true);
- fName := GetString('name', fName);
- fDescription := GetString('description', fDescription);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuParameter.SetValue(const aValue: String): Boolean;
- begin
- fValue := aValue;
- result := true;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlMenuParameter////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuParameter.GetString(const aOptions: TutlParameterStringFlags
- ): String;
- begin
- if fOptional then
- result := '(' + fName + ')'
- else
- result := '[' + fName + ']'
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlMenuParameter.Create(const aOptional: Boolean; const aName, aDescription: String);
- begin
- inherited Create;
- fOptional := aOptional;
- fName := aName;
- fDescription := aDescription;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TutlMenuParameter.Destroy;
- begin
- inherited Destroy;
- end;
-
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlMenuParameterList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuParameterList.HasParameter(const aName: String): Boolean;
- begin
- result := Assigned(FindParameter(aName));
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuParameterList.FindParameter(const aName: String): TutlMenuParameter;
- var
- i: Integer;
- begin
- for i := 0 to Count-1 do begin
- result := Items[i];
- if (result.Name = aName) then
- exit;
- end;
- result := nil
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlMenuParameterStack///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlMenuParameterStack.Push(const aValue: TutlMenuParameter);
- begin
- Add(aValue);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuParameterStack.Seek: TutlMenuParameter;
- begin
- if (Count > 0) then
- result := Items[Count-1]
- else
- result := nil;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuParameterStack.Pop: TutlMenuParameter;
- begin
- if (Count > 0) then begin
- result := Items[Count-1];
- Delete(Count-1);
- end else
- result := nil;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlMenuParameterSingle.WriteConfig(const aMCF: TutlMCFSection);
- begin
- inherited WriteConfig(aMCF);
- aMCF.SetString('type', TutlParameterTypeH.ToString(fType));
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlMenuParameterSingle.ReadConfig(const aMCF: TutlMCFSection);
- begin
- inherited ReadConfig(aMCF);
- fType := TutlParameterTypeH.ToEnum(aMCF.GetString('type', TutlParameterTypeH.ToString(ptPreset)));
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlMenuParameterSingle//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlMenuParameterSingle.GetAutoCompleteStrings(const aStrings: TStrings);
- begin
- case fType of
- ptBoolean: begin
- aStrings.Add('true');
- aStrings.Add('false');
- end;
- ptInteger: begin
- aStrings.Add('[integer]');
- end;
- ptHex: begin
- aStrings.Add('[hex]');
- end;
- ptString: begin
- aStrings.Add('[string]');
- end;
- ptPreset: begin
- aStrings.Add(fName);
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuParameterSingle.SetValue(const aValue: String): Boolean;
- const
- BOOL_ARR: array[0..7] of String = ('y', 'n', 't', 'f', 'yes', 'no', 'true', 'false');
-
- function IsInArr: Boolean;
- var
- i: Integer;
- s: String;
- begin
- s := LowerCase(aValue);
- result := true;
- for i := 0 to high(BOOL_ARR) do
- if (BOOL_ARR[i] = s) then
- exit;
- result := false;
- end;
-
- var
- i: Integer;
- c: QWord;
- begin
- result := false;
- case fType of
- ptBoolean:
- if IsInArr then
- result := true;
- ptInteger:
- result := TryStrToInt(aValue, i);
- ptHex:
- result := AnsiStartsStr('0x', aValue) and TryStrToQWord('$' + AnsiRightStr(aValue, Length(aValue)-2), c);
- ptPreset:
- result := (aValue = fName);
- ptString:
- result := true;
- end;
- if result then
- result := inherited SetValue(aValue);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlMenuParameterSingle//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuParameterSingle.GetString(const aOptions: TutlParameterStringFlags): String;
- begin
- result := fName;
- case fType of
- ptBoolean:
- result := result+':b';
- ptHex:
- result := result+':h';
- ptInteger:
- result := result+':i';
- ptString:
- result := result+':s';
- ptPreset:
- result := '''' + result + '''';
- end;
- if (psfBrackets in aOptions) then begin
- if fOptional then
- result := '(' + result + ')'
- else
- result := '[' + result + ']';
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlMenuParameterSingle.Create(const aOptional: Boolean;
- const aName, aDescription: String; const aType: TutlParameterType);
- begin
- inherited Create(aOptional, aName, aDescription);
- fType := aType;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TutlMenuParameterSingle.Destroy;
- begin
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlMenuParameterGroup///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuParameterGroup.GetCount: Integer;
- begin
- result := fParameters.Count;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuParameterGroup.GetParameter(const aIndex: Integer): TutlMenuParameterSingle;
- begin
- if (aIndex >= 0) and (aIndex < fParameters.Count) then
- result := fParameters[aIndex]
- else
- raise Exception.Create(format('TMenuParameterGroup.GetParameter - index out of bounds (%d)', [aIndex]));
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlMenuParameterGroup.WriteConfig(const aMCF: TutlMCFSection);
- var
- i: Integer;
- begin
- inherited WriteConfig(aMCF);
- with aMCF.Sections['parameters'] do begin
- SetInt('count', fParameters.Count);
- for i := 0 to fParameters.Count-1 do
- fParameters[i].WriteConfig(Sections[IntToStr(i)]);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlMenuParameterGroup.ReadConfig(const aMCF: TutlMCFSection);
- var
- c, i: Integer;
- begin
- inherited ReadConfig(aMCF);
- with aMCF.Sections['parameters'] do begin
- c := GetInt('count', 0);
- for i := 0 to c-1 do
- AddParameter('', '', ptPreset).ReadConfig(Sections[IntToStr(i)]);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlMenuParameterGroup.GetAutoCompleteStrings(const aStrings: TStrings);
- var
- i: Integer;
- begin
- for i := 0 to fParameters.Count-1 do
- fParameters[i].GetAutoCompleteStrings(aStrings);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuParameterGroup.SetValue(const aValue: String): Boolean;
- var
- i: Integer;
- begin
- for i := 0 to fParameters.Count-1 do
- if fParameters[i].SetValue(aValue) then begin
- result := inherited SetValue(aValue);
- break;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuParameterGroup.GetString(const aOptions: TutlParameterStringFlags): String;
- var
- i: Integer;
- s: String;
- begin
- result := '';
- for i := 0 to fParameters.Count-1 do begin
- if result <> '' then
- result := result + '|';
- s := fParameters[i].GetString;
- s := copy(s, 2, Length(s)-2);
- result := result + s;
- end;
- result := fName + ':' + result;
- if (psfBrackets in aOptions) then begin
- if (fOptional) then
- result := '(' + result + ')'
- else
- result := '[' + result + ']';
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuParameterGroup.AddParameter(const aName, aDescription: String; const aType: TutlParameterType): TutlMenuParameterSingle;
- begin
- result := TutlMenuParameterSingle.Create(false, aName, aDescription, aType);
- fParameters.Add(result);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuParameterGroup.AddParameter(const aParameter: TutlMenuParameterSingle): TutlMenuParameterSingle;
- begin
- result := aParameter;
- fParameters.Add(result);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlMenuParameterGroup.DelParameter(const aIndex: Integer);
- begin
- if (aIndex >= 0) and (aIndex < fParameters.Count) then
- fParameters.Delete(aIndex)
- else
- raise Exception.Create(format('TMenuParameterGroup.DelParameter - index out of bounds (%d)', [aIndex]));
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlMenuParameterGroup.Create(const aOptional: Boolean; const aName, aDescription: String);
- begin
- inherited Create(aOptional, aName, aDescription);
- fParameters := TutlMenuParameterSingleList.Create(true);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TutlMenuParameterGroup.Destroy;
- begin
- FreeAndNil(fParameters);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlMenuItem/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuItem.GetCount: Integer;
- begin
- result := fItems.Count;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuItem.GetItems(const aIndex: Integer): TutlMenuItem;
- begin
- if (aIndex >= 0) and (aIndex < fItems.Count) then
- result := fItems[aIndex]
- else
- raise Exception.Create(format('TMenuItem.GetItems - index out of bounds (%d)', [aIndex]));
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuItem.GetMenuPath: String;
- var
- m: TutlMenuItem;
- begin
- result := '';
- m := self;
- while Assigned(m) do begin
- if Length(result) > 0 then
- result := ' ' + result;
- result := m.GetString + result; //m.Command + result;
- if (m <> m.Parent) then
- m := m.Parent
- else
- m := nil;
- end;
- result := Trim(result);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuItem.GetParamCount: Integer;
- begin
- result := fParameters.Count;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuItem.GetParameters(const aIndex: Integer): TutlMenuParameter;
- begin
- if (aIndex >= 0) and (aIndex < fParameters.Count) then
- result := fParameters[aIndex]
- else
- raise Exception.Create(format('TMenuItem.GetParameters - index out of bounds', [aIndex]));
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuItem.GetParameterString: String;
- var
- i: Integer;
- begin
- result := '';
- for i := 0 to fParameters.Count-1 do begin
- if result <> '' then
- result := result + ' ';
- result := result + fParameters[i].GetString;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlMenuItem.SetCallback(aValue: TutlCallback);
- begin
- if fCallback = aValue then
- exit;
- fCallback := aValue;
- fExecutable := Assigned(fCallback);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlMenuItem.WriteConfig(const aMCF: TutlMCFSection);
- var
- i: Integer;
- begin
- with aMCF do begin
- SetString('command', fCommand);
- SetString('description', fDescription);
- SetBool ('executable', fExecutable);
- with Sections['parameters'] do begin
- SetInt('count', fParameters.Count);
- for i := 0 to fParameters.Count-1 do
- fParameters[i].WriteConfig(Sections[IntToStr(i)]);
- end;
- with Sections['menus'] do begin
- SetInt('count', fItems.Count);
- for i := 0 to fItems.Count-1 do
- fItems[i].WriteConfig(Sections[IntToStr(i)]);
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlMenuItem.ReadConfig(const aMCF: TutlMCFSection);
- var
- c, i: Integer;
- s: String;
- p: TutlMenuParameter;
- begin
- fItems.Clear;
- fParameters.Clear;
- with aMCF do begin
- fCommand := GetString('command', '');
- fDescription := GetString('description', '');
- fExecutable := GetBool ('executable', false);
- with Sections['parameters'] do begin
- c := GetInt('count', 0);
- for i := 0 to c-1 do begin
- s := Sections[IntToStr(i)].GetString('classname', '');
- p := nil;
- if (s = TutlMenuParameterSingle.ClassName) then
- p := TutlMenuParameterSingle.Create(true, '', '', ptPreset)
- else if (s = TutlMenuParameterGroup.ClassName) then
- p := TutlMenuParameterGroup.Create(true, '', '');
- if Assigned(p) then begin
- fParameters.Add(p);
- p.ReadConfig(Sections[IntToStr(i)]);
- end;
- end;
- end;
- with Sections['menus'] do begin
- c := GetInt('count', 0);
- for i := 0 to c-1 do
- AddItem('', '', nil).ReadConfig(Sections[IntToStr(i)]);
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlMenuItem.GetAutoCompleteStrings(const aList: TStrings; const aParameter: TutlMenuParameterList);
- var
- hasAllParam: Boolean;
- i: Integer;
- p: TutlMenuParameter;
- begin
- hasAllParam := true;
- for i := 0 to fParameters.Count-1 do begin
- p := fParameters[i];
- if not p.Optional then begin
- if not aParameter.HasParameter(p.Name) then begin
- p.GetAutoCompleteStrings(aList);
- hasAllParam := false;
- break;
- end;
- end else begin
- if not aParameter.HasParameter(p.Name) then
- p.GetAutoCompleteStrings(aList);
- end;
- end;
- if hasAllParam then begin
- for i := 0 to fItems.Count-1 do
- aList.Add(fItems[i].Command);
- if Command <> 'help' then
- aList.Add('help');
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuItem.GetString: String;
- var
- s: String;
- begin
- result := Command;
- s := ParameterString;
- if (Command <> '') and (s <> '') then
- result := result + ' ';
- result := result + s;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuItem.AddItem(const aCmd, aDesc: String; const aCallback: TutlCallback): TutlMenuItem;
- begin
- result := TutlMenuItem.Create(self, aCmd, aDesc, aCallback);
- fItems.Add(result);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuItem.AddItem(const aItem: TutlMenuItem): TutlMenuItem;
- begin
- result := aItem;
- fItems.Add(result);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlMenuItem.DelItem(const aIndex: Integer);
- begin
- if (aIndex >= 0) and (aIndex < fItems.Count) then
- fItems.Delete(aIndex)
- else
- raise Exception.Create(format('TMenuItem.DelItem - index out of bounds (%d)', [aIndex]));
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlMenuItem.AddParameter(const aParameter: TutlMenuParameter): TutlMenuParameter;
- begin
- result := aParameter;
- result.fParent := self;
- fParameters.Add(result);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlMenuItem.DelParameter(const aIndex: Integer);
- begin
- if (aIndex >= 0) and (aIndex < fParameters.Count) then
- fParameters.Delete(aIndex)
- else
- raise Exception.Create(format('TMenuItem.DelParameter - index out of bounds (%d)', [aIndex]));
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlMenuItem.Create(const aParent: TutlMenuItem; const aCmd, aDesc: String; const aCallback: TutlCallback);
- begin
- inherited Create;
- fParent := aParent;
- fCommand := aCmd;
- fDescription := aDesc;
- fCallback := aCallback;
- fExecutable := Assigned(fCallback);
- fItems := TutlMenuItemList.Create(true);
- fParameters := TutlMenuParameterList.Create(true);
-
- if aCmd <> 'help' then begin
- fHelpItem := TutlMenuItem.Create(self, 'help', 'shows the help. use ''all'' to display the menu tree. use ''detail'' to display command details', nil);
- with fHelpItem.AddParameter(TutlMenuParameterGroup.Create(true, 'mode', 'specify how to display the help menu')) as TutlMenuParameterGroup do begin
- AddParameter('all', 'displays the complete menu tree', ptPreset);
- AddParameter('detail', 'displays detailed information', ptPreset);
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TutlMenuItem.Destroy;
- begin
- FreeAndNil(fItems);
- FreeAndNil(fParameters);
- FreeAndNil(fHelpItem);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlCommandMenu//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlCommandMenu.GetCmdParameter: TutlMenuParameterList;
- begin
- result := fCmdParameter;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandMenu.SplitCmdString(const aText: String; const aChar: Char);
- var
- i: Integer;
- Buffer: String;
- Quote: Boolean;
- begin
- fCmdStack.Clear;
- Buffer := '';
- Quote := false;
- for i := 1 to Length(aText) do begin
- if (aText[i] = aChar) and not Quote then begin
- Buffer := Trim(Buffer);
- fCmdStack.Add(Buffer);
- Buffer := '';
- end else if (aText[i] = '"') then
- Quote := not Quote
- else
- Buffer := Buffer + aText[i];
- end;
- if Buffer <> '' then begin
- Buffer := Trim(Buffer);
- fCmdStack.Add(Buffer);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlCommandMenu.ParseCommand: TutlParseResult;
-
- procedure RestoreParameterStack(const aMenu: TutlMenuItem);
- var
- p: TutlMenuParameter;
- begin
- p := fCmdParameter.Seek;
- while Assigned(p) and (p.Parent = aMenu) do begin
- fCmdStack.Push(p.Value);
- fCmdParameter.Pop;
- p := fCmdParameter.Seek;
- end;
- end;
-
- function BackTrack(const aMenu: TutlMenuItem): TutlParseResult;
- var
- s, cmd: String;
- OptionalParamCount: Integer;
- i, c: Integer;
- m: TutlMenuItem;
- p: TutlMenuParameter;
- begin
- //Stack is empty
- if (fCmdStack.Count = 0) then begin
- if Assigned(aMenu.Callback) or (aMenu = fHelpItem) then
- result := prSuccess
- else
- result := prIncompleteCmd;
- fCurrentMenu := aMenu;
- exit;
- end;
- s := fCmdStack.Pop;
- cmd := LowerCase(s);
-
- //find command
- m := nil;
- for i := 0 to aMenu.Count-1 do
- if (LowerCase(aMenu[i].Command) = cmd) then begin
- m := aMenu[i];
- break;
- end;
- if not Assigned(m) and (cmd = 'help') then begin
- m := fHelpItem;
- m.fParent := aMenu;
- end;
-
- if Assigned(m) then begin
- //count optional parameters
- c := 0;
- for i := 0 to m.ParamCount-1 do
- if (m.Parameters[i].Optional) then
- inc(c);
- OptionalParamCount := (1 shl c) - 1;
-
- //backtrack optional parameters
- while (OptionalParamCount >= 0) do begin
- result := prSuccess;
- fCurrentParamCount := 0;
- c := 0;
- for i := 0 to m.ParamCount-1 do begin
- p := m.Parameters[i];
- if not p.Optional or (((OptionalParamCount shr c) and 1) = 1) then begin
- if (fCmdStack.Count <= 0) then begin
- result := prInvalidParamCount;
- RestoreParameterStack(m);
- fCurrentMenu := m;
- break;
- end else if (LowerCase(fCmdStack.Seek) = 'help') then begin
- break;
- end else if not (p.SetValue(fCmdStack.Seek)) then begin
- result := prInvalidParam;
- RestoreParameterStack(m);
- fCurrentMenu := m;
- break;
- end else begin
- inc(fCurrentParamCount);
- fCmdParameter.Push(p);
- fCmdStack.Pop;
- end;
- if p.Optional then
- inc(c);
- end;
- end;
-
- if (result = prSuccess) then begin
- result := BackTrack(m);
- if result = prUnknownCommand then
- fCurrentMenu := aMenu;
- end;
- if result <> prSuccess then
- dec(OptionalParamCount)
- else
- OptionalParamCount := -1;
- end;
- end else begin
- fCmdStack.Push(s);
- fUnknownCmd := s;
- result := prUnknownCommand;
- end;
- end;
-
- begin
- fCmdParameter.Clear;
- fCurrentParamCount := 0;
- fInvalidParam := '';
- fUnknownCmd := '';
- fCurrentMenu := nil;
- result := BackTrack(self);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandMenu.ExecuteCommand(const aCmd: String);
- var
- r: TutlParseResult;
- p: TutlMenuParameter;
- begin
- fLastCmd := aCmd;
- SplitCmdString(aCmd, ' ');
- r := ParseCommand;
- case r of
- prSuccess:
- if (fCurrentMenu = fHelpItem) then begin
- p := nil;
- if (fCmdParameter.Count > 0) and (fCmdParameter[fCmdParameter.Count-1].Parent = fHelpItem) then
- p := fCmdParameter[fCmdParameter.Count-1];
- if not Assigned(p) then
- DisplayHelp(fHelpItem.Parent)
- else if (p.Value = 'all') then
- DisplayHelp(fHelpItem.Parent, hoAll)
- else if (p.Value = 'detail') then
- DisplayHelp(fHelpItem.Parent, hoDetail)
- else
- DisplayHelp(fHelpItem.Parent);
- end else
- fCurrentMenu.Callback(self);
- prInvalidParam:
- DisplayInvalidParam(fInvalidParam);
- prInvalidParamCount:
- DisplayInvalidParamCount(fCurrentParamCount);
- prIncompleteCmd:
- DisplayIncompleteCommand;
- prUnknownCommand:
- DisplayUnknownCommand(fUnknownCmd);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandMenu.DisplayHelp(const aRefMenu: TutlMenuItem; const aOption: TutlHelpOption);
- var
- maxLength: Integer;
-
- function AddStr(const aOld, aNew, aPostfix: String): String;
- begin
- result := aOld;
- if (aOld <> '') and (aNew <> '') then
- result := result + aPostfix;
- result := result + aNew;
- end;
-
- function GetMaxLength(const aItem: TutlMenuItem): Integer;
- var
- i, l: Integer;
- m: TutlMenuItem;
- begin
- result := 0;
- for i := 0 to aItem.Count-1 do begin
- m := aItem[i];
- l := Length(m.GetString);
- if l > result then
- result := l;
- if (aOption = hoAll) then begin
- l := GetMaxLength(m) + 2;
- if l > result then
- result := l;
- end;
- end;
- end;
-
- function FillStr(const aStr: String; const aChar: Char; const aLength: Integer): String;
- begin
- result := aStr + StringOfChar(aChar, aLength-Length(aStr));
- end;
-
- procedure AddHelpText(var aMsg: String; const aPrefix: String; const aItem: TutlMenuItem);
- begin
- if (aMsg <> '') then
- aMsg := aMsg + sLineBreak;
- aMsg := aMsg + FillStr(aPrefix + aItem.GetString, ' ', maxLength) + ' ' + aItem.Description;
- end;
-
- procedure AddHelpItems(var aMsg: String; const aPrefix: String; const aItem: TutlMenuItem; const aDisplayHelpItem: Boolean = false);
- var
- i: Integer;
- m: TutlMenuItem;
- begin
- for i := 0 to aItem.Count-1 do begin
- m := aItem[i];
- AddHelpText(aMsg, aPrefix, m);
- if (aOption = hoAll) then
- AddHelpItems(aMsg, aPrefix+' ', m);
- end;
- if aDisplayHelpItem then
- AddHelpText(aMsg, aPrefix, fHelpItem);
- end;
-
- procedure DisplayGroupParameters(var aMsg: String; const aParamGroup: TutlMenuParameterGroup);
- var
- i, maxLen, l: Integer;
- p: TutlMenuParameter;
- begin
- maxLen := 0;
- for i := 0 to aParamGroup.Count-1 do begin
- l := Length(aParamGroup[i].GetString([]));
- if l > maxLen then
- maxLen := l;
- end;
- inc(maxLen, 3);
-
- for i := 0 to aParamGroup.Count-1 do begin
- p := aParamGroup[i];
- aMsg := aMsg + sLineBreak + ' ' +
- FillStr(p.GetString([]), ' ', maxLen) +
- p.Description;
- end;
- end;
-
- procedure DisplayParameters(var aMsg: String);
- var
- i, maxLen, l: Integer;
- p: TutlMenuParameter;
- begin
- maxLen := 0;
- for i := 0 to aRefMenu.ParamCount-1 do begin
- l := Length(aRefMenu.Parameters[i].GetString);
- if (l > maxLen) then
- maxLen := l;
- end;
- inc(maxLen, 3);
-
- aMsg := aMsg + sLineBreak + 'Parameters:';
- if (aRefMenu.ParamCount > 0) then begin
- for i := 0 to aRefMenu.ParamCount-1 do begin
- p := aRefMenu.Parameters[i];
- aMsg := aMsg + sLineBreak + ' ' + FillStr(p.GetString, ' ', maxLen);
- if p.Optional then
- aMsg := aMsg + '(optional) '
- else
- aMsg := aMsg + ' ';
- aMsg := aMsg + p.Description;
- if (p is TutlMenuParameterGroup) then
- DisplayGroupParameters(aMsg, p as TutlMenuParameterGroup);
- end;
- end else
- aMsg := aMsg + sLineBreak + ' [no Parameters]';
- end;
-
- var
- menu: TutlMenuItem;
- msg: String;
- begin
- if Assigned(aRefMenu) then
- menu := aRefMenu
- else
- menu := self;
-
- msg := AddStr(menu.MenuPath, menu.ParameterString, ' ');
- msg := AddStr(msg, menu.Description, ' - ');
- fHelpItem.fParent := nil;
- if (aOption = hoDetail) then
- msg := msg + sLineBreak + 'Submenus / Commands:';
- maxLength := max(GetMaxLength(menu), Length(fHelpItem.GetString)) + 2;
- if (msg = '') then
- msg := sLineBreak;
- AddHelpItems(msg, ' ', menu, true);
- if (aRefMenu is TutlConsoleMenu) then
- AddHelpText(msg, ' ', (self as TutlConsoleMenu).fExitMenu);
- if (aOption = hoDetail) then
- DisplayParameters(msg);
- utlLogger.Log(Self, msg, []);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandMenu.DisplayIncompleteCommand;
-
- function GetMenuPath: String;
- var
- s: String;
- begin
- s := '';
- if Assigned(fCurrentMenu) then
- s := fCurrentMenu.MenuPath;
- if (s <> '') then
- result := s+' '
- else
- result := '';
- end;
-
- begin
- utlLogger.Error(Self, 'incomplete command! type "%shelp" to get further information.', [GetMenuPath]);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandMenu.DisplayUnknownCommand(const aCmd: String);
-
- function GetMenuPath: String;
- var
- s: String;
- begin
- s := '';
- if Assigned(fCurrentMenu) then
- s := fCurrentMenu.MenuPath;
- if (s <> '') then
- result := s+' '
- else
- result := '';
- end;
-
- function GetCommand: String;
- begin
- if (aCmd <> '') then
- result := ' "'+aCmd+'"'
- else
- result := '';
- end;
-
- begin
- utlLogger.Error(Self, 'unknown command%s! type "%shelp" to get further information.', [GetCommand, GetMenuPath]);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandMenu.DisplayInvalidParamCount(const aParamCount: Integer);
-
- function GetMenuPath: String;
- var
- s: String;
- begin
- s := '';
- if Assigned(fCurrentMenu) then
- s := fCurrentMenu.MenuPath;
- if (s <> '') then
- result := s+' '
- else
- result := '';
- end;
-
- function GetParamCount: String;
- var
- i, c: Integer;
- begin
- result := ' (';
- if (aParamCount >= 0) then begin
- result := result + IntToStr(aParamCount);
- end;
- if Assigned(fCurrentMenu) then begin
- c := 0;
- for i := 0 to fCurrentMenu.ParamCount-1 do
- if not fCurrentMenu.Parameters[i].Optional then
- inc(c);
- result := result + ', expected '+IntToStr(c);
- end;
- result := result + ')';
- if (result = ' ()') then
- result := '';
- end;
-
- begin
- utlLogger.Log(Self, 'invalid parameter count%s! type "%shelp" to get further information.', [GetParamCount, GetMenuPath]);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandMenu.DisplayInvalidParam(const aParam: String);
-
- function GetMenuPath: String;
- var
- s: String;
- begin
- s := '';
- if Assigned(fCurrentMenu) then
- s := fCurrentMenu.MenuPath;
- if (s <> '') then
- result := s+' '
- else
- result := '';
- end;
-
- function GetParam: String;
- begin
- if (aParam <> '') then
- result := ' "'+aParam+'"'
- else
- result := '';
- end;
-
- begin
- utlLogger.Log(Self, 'invalid parameter%s! type "%shelp" to get further information.', [GetParam, GetMenuPath]);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlMenuItem.LoadFromStream(const aStream: TStream);
- var
- mcf: TutlMCFFile;
- begin
- mcf := TutlMCFFile.Create(nil);
- try
- mcf.LoadFromStream(aStream);
- ReadConfig(mcf);
- finally
- mcf.Free;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlMenuItem.SaveToStream(const aStream: TStream);
- var
- mcf: TutlMCFFile;
- begin
- mcf := TutlMCFFile.Create(nil);
- try
- WriteConfig(mcf);
- mcf.SaveToStream(aStream);
- finally
- mcf.Free;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlCommandMenu.Create(const aHelp: String);
- begin
- inherited Create(nil, '', aHelp, nil);
- fCmdStack := TutlStringStack.Create;
- fCmdParameter := TutlMenuParameterStack.Create(False);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TutlCommandMenu.Destroy;
- begin
- FreeAndNil(fCmdStack);
- FreeAndNil(fCmdParameter);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlCommandPrompt/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandPrompt.SetPrefix(aValue: String);
- begin
- if fPrefix = aValue then
- exit;
- DelInput(true);
- delete(fCurrent, 1, Length(fPrefix));
- if fHistoryID >= 0 then
- delete(fHistoryBackup, 1, Length(fPrefix));
- fPrefix := aValue;
- fStartIndex := Length(fPrefix)+1;
- fCurrent := fPrefix + fCurrent;
- if fHistoryID >= 0 then
- fHistoryBackup := fPrefix + fHistoryBackup;
- RestoreInput;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlCommandPrompt.GetCurrent: String;
- begin
- if fHistoryID = -1 then
- result := copy(fCurrent, fStartIndex, MaxInt)
- else
- result := copy(fHistoryBackup, fStartIndex, MaxInt);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandPrompt.SetCurrent(aValue: String);
- begin
- DelInput;
- fCurrent := fPrefix + aValue;
- fHistoryID := -1;
- RestoreInput;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandPrompt.SetHiddenChar(aValue: Char);
- begin
- if fHiddenChar = aValue then
- exit;
- DelInput(true);
- fHiddenChar := aValue;
- RestoreInput;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandPrompt.CursorToStart;
- begin
- Write(StringOfChar(#8, fCurID-fStartIndex));
- fCurID := fStartIndex;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandPrompt.CursorToEnd;
- begin
- Write(Copy(fCurrent, fCurID, MaxInt));
- fCurID := Length(fCurrent)+1;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandPrompt.DelInput(const aAll: Boolean);
- var
- l: Integer;
- begin
- if not aAll then
- l := fCurID - fStartIndex
- else
- l := fCurID - 1;
- Write(StringOfChar(#08, l));
- Write(StringOfChar(' ', l));
- Write(StringOfChar(#08, l));
- dec(fCurID, l);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandPrompt.RestoreInput;
- begin
- if (fHiddenChar <> #0) then begin
- while fCurID < fStartIndex do begin
- Write(fCurrent[fCurID]);
- inc(fCurID);
- end;
- Write(StringOfChar(fHiddenChar, Length(fCurrent) - fCurID + 1))
- end else
- Write(Copy(fCurrent, fCurID, MaxInt));
- fCurID := Length(fCurrent)+1;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandPrompt.CursorRight;
- begin
- if fCurID <= Length(fCurrent) then begin
- if (fHiddenChar <> #0) then
- Write(fHiddenChar)
- else
- Write(fCurrent[fCurID]);
- inc(fCurID);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandPrompt.CursorLeft;
- begin
- if fCurID > fStartIndex then begin
- Write(#8);
- dec(fCurID, 1);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandPrompt.DelChar(const aBeforeCursor: Boolean);
- begin
- if not aBeforeCursor and (fCurID <= Length(fCurrent)) then begin
- Delete(fCurrent, fCurID, 1);
- Write(copy(fCurrent, fCurID, MaxInt), ' ');
- Write(StringOfChar(#8, Length(fCurrent)-fCurID+2));
- end else if aBeforeCursor and (fCurID > fStartIndex) then begin
- Delete(fCurrent, fCurID-1, 1);
- Write(#8, copy(fCurrent, fCurID-1, MaxInt), ' ');
- Write(StringOfChar(#8, Length(fCurrent)-fCurID+3));
- dec(fCurID);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandPrompt.WriteChar(const c: Char);
- begin
- if (fCurID <= Length(fCurrent)) then begin
- Write('#', copy(fCurrent, fCurID, MaxInt));
- Write(StringOfChar(#8, Length(fCurrent)-fCurID+2));
- end;
- Insert(c, fCurrent, fCurID);
- inc(fCurID, 1);
- if (fHiddenChar <> #0) then
- Write(fHiddenChar)
- else
- Write(c);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlCommandPrompt.ReadLnEx: String;
- var
- c: Byte;
- key: Char;
- CtrlKey: Boolean;
- s: String;
- tabPressed: Boolean;
- begin
- fHistoryID := -1;
- CtrlKey := false;
- tabPressed := false;
-
- fConsoleCS.Enter;
- try
- DelInput(true);
- RestoreInput;
- finally
- fConsoleCS.Leave;
- end;
-
- while fRunning do begin
- key := ReadKey;
- c := Ord(key) and $FF;
- fConsoleCS.Enter;
- try
- if (CtrlKey) then begin
- CtrlKey := false;
- case c of
- 72: begin //KEY_UP
- if (fHistoryID+1 < fHistory.Count) then begin
- if (fHistoryID = -1) then
- fHistoryBackup := fCurrent;
- CursorToEnd;
- DelInput;
- inc(fHistoryID);
- fCurrent := fPrefix + fHistory[fHistoryID];
- RestoreInput;
- end;
- end;
- 80: begin //KEY_DOWN
- if (fHistoryID >= 0) then begin
- CursorToEnd;
- DelInput;
- dec(fHistoryID);
- if (fHistoryID >= 0) then
- fCurrent := fPrefix + fHistory[fHistoryID]
- else
- fCurrent := fHistoryBackup;
- RestoreInput;
- end;
- end;
- 75: begin //KEY_LEFT
- CursorLeft;
- end;
- 77: begin //KEY_RIGHT
- CursorRight;
- end;
- 82: begin //KEY_INSERT
- end;
- 83: begin //KEY_DELETE
- DelChar(false);
- end;
- 71: begin //KEY_HOME
- CursorToStart;
- end;
- 79: begin //KEY_END
- CursorToEnd;
- end;
- 73: begin //KEY_PGUP
- end;
- 81: begin //KEY_PGDOWN
- end;
- end;
- end else begin
- if (tabPressed) then
- tabPressed := (c = VK_TAB);
- case c of
- VK_UNKNOWN: begin
- CtrlKey := true;
- end;
- VK_BACK: begin
- DelChar(true);
- end;
- VK_TAB: begin
- CursorToEnd;
- DelInput;
- s := fCurrent;
- fCurrent := fPrefix +
- AutoComplete(copy(fCurrent, fStartIndex, MaxInt), tabPressed);
- RestoreInput;
- if s <> fCurrent then
- tabPressed := false
- else
- tabPressed := not tabPressed;
- end;
- VK_RETURN: begin //RETURN
- break;
- end;
- VK_ESCAPE: begin
- Reset;
- end;
- else
- WriteChar(Chr(c));
- end;
- end;
- finally
- fConsoleCS.Leave;
- end;
- end;
-
- fConsoleCS.Enter;
- try
- WriteLn;
- finally
- fConsoleCS.Leave;
- end;
- result := copy(fCurrent, Length(fPrefix)+1, MaxInt);
- Reset;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlCommandPrompt.AutoComplete(const aInput: String; const aDisplayPossibilities: Boolean): String;
- begin
- result := aInput;
- if Assigned(fOnAutoComplete) then
- result := fOnAutoComplete(self, aInput, aDisplayPossibilities);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandPrompt.AddHistory(const aInput: String);
- begin
- if fHistoryEnabled and (fHiddenChar = #0) and
- ((fHistory.Count <= 0) or (fHistory[0] <> aInput)) then
- fHistory.Insert(0, aInput);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandPrompt.DoInput;
- begin
- if Assigned(fOnInput) then
- fOnInput(self, fInput);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandPrompt.Start;
- begin
- Reset;
- fRunning := true;
- while fRunning do begin
- fInput := ReadLnEx;
- AddHistory(fInput);
- DoInput;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandPrompt.Stop;
- begin
- fRunning := false;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandPrompt.Reset;
- begin
- CursorToEnd;
- DelInput(true);
- fCurrent := fPrefix;
- fCurID := 1;
- Restore;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandPrompt.Clear;
- begin
- fConsoleCS.Enter;
- try
- DelInput(true);
- finally
- fConsoleCS.Leave;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlCommandPrompt.Restore;
- begin
- fConsoleCS.Enter;
- try
- RestoreInput;
- finally
- fConsoleCS.Leave;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlCommandPrompt.Create(const aConsoleCS: syncobjs.TCriticalSection);
- begin
- inherited Create;
- fConsoleCS := aConsoleCS;
- fPrefix := COMMAND_PROMPT_PREFIX;
- fHistory := TStringList.Create;
- fHistoryEnabled := true;
- fStartIndex := Length(fPrefix)+1;
- end;
-
- destructor TutlCommandPrompt.Destroy;
- begin
- FreeAndNil(fHistory);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlConsoleMenu//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlConsoleMenu.CommandInput(aSender: TObject; const aCmd: String);
- begin
- if fIsAsking then begin
- fIsAsking := false;
- fCommandPrompt.Current := fInputBackup;
- fCommandPrompt.Prefix := COMMAND_PROMPT_PREFIX;
- fCommandPrompt.OnAutoComplete := @AutoComplete;
- fCommandPrompt.HiddenChar := #0;
- fCommandPrompt.HistoryEnabled := true;
- DoAnswer(aCmd);
- end else begin
- utlLogger.Debug(Self, 'CMD: ' + aCmd, []);
- ExecuteCommand(aCmd);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlConsoleMenu.AutoComplete(aSender: TObject; const aCmd: String;
- const aDisplayPossibilities: Boolean): String;
- var
- r: TutlParseResult;
- s, cmd: String;
- c: Char;
- cmdList: TStringList;
- i, CharIndex, MaxLength: Integer;
-
- function TestParam(const aParam: String): Boolean;
- var
- i: Integer;
- c: QWord;
- begin
- if aParam = '[integer]' then
- result := TryStrToInt(s, i)
- else if aParam = '[hex]' then
- result := AnsiStartsStr('0x', s) and TryStrToQWord('$' + copy(s, 3, MaxInt), c)
- else
- result := true;
- end;
-
- function NextChar: Char;
- var
- i: Integer;
- c: String;
- begin
- result := #0;
- try
- for i := 0 to cmdList.Count-1 do begin
- c := cmdList[i];
- if (Length(c) > 0) and (c[1] <> '[') then begin
- if (Length(c) >= CharIndex) then begin
- if (result = #0) then
- result := c[CharIndex]
- else if (result <> c[CharIndex]) then begin
- result := #0;
- exit;
- end;
- end;
- end;
- end;
- finally
- inc(CharIndex);
- end;
- end;
-
- function GetMaxLength: Integer;
- var
- i, l: Integer;
- begin
- result := 0;
- for i := 0 to cmdList.Count-1 do begin
- l := Length(cmdList[i]);
- if l > result then
- result := l;
- end;
- end;
-
- begin
- SplitCmdString(aCmd, ' ');
- s := '';
- if (Length(aCmd) > 0) and (aCmd[Length(aCmd)] <> ' ') then begin
- s := fCmdStack[fCmdStack.Count-1];
- fCmdStack.Delete(fCmdStack.Count-1);
- end;
- r := ParseCommand;
- result := aCmd;
- if (r in [prSuccess, prIncompleteCmd, prInvalidParamCount]) and Assigned(fCurrentMenu) then begin
- cmdList := TStringList.Create;
- try
- fCurrentMenu.GetAutoCompleteStrings(cmdList, fCmdParameter);
- if (s <> '') then begin
- for i := cmdList.Count-1 downto 0 do begin
- cmd := cmdList[i];
- if (Length(cmd) > 0) and (cmd[1] = '[') then begin
- if not TestParam(cmd) then
- cmdList.Delete(i);
- end else if not AnsiStartsStr(s, cmd) then
- cmdList.Delete(i);
- end;
- end;
-
- CharIndex := Length(s)+1;
- c := NextChar;
- while c <> #0 do begin
- result := result + c;
- c := NextChar;
- end;
- if (cmdList.Count = 1) then
- result := result + ' ';
-
- if aDisplayPossibilities then begin
- WriteLn('');
- s := '';
- MaxLength := GetMaxLength+5;
- for i := 0 to cmdList.Count-1 do begin
- cmd := cmdList[i];
- s := s + cmd + StringOfChar(' ', MaxLength-Length(cmd));
- if ((i+1) mod 5) = 0 then begin
- writeln(s);
- s := '';
- end;
- end;
- if (s <> '') then
- WriteLn(s);
- if (cmdList.Count = 0) then
- WriteLn('[no possible commands]');
- end;
- finally
- cmdList.Free;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlConsoleMenu.DoAnswer(const aInput: String);
- begin
- if Assigned(fOnAnswer) then
- fOnAnswer(self, aInput);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlConsoleMenu.ExecuteCommand(const aCmd: String);
- begin
- if (LowerCase(AnsiLeftStr(trim(aCmd), 4)) = 'exit') then
- ExitMenu
- else
- inherited ExecuteCommand(aCmd);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlConsoleMenu.StartMenu;
- begin
- fCommandPrompt.Start;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlConsoleMenu.ExitMenu;
- begin
- fCommandPrompt.Stop;
- end;
-
- procedure TutlConsoleMenu.Ask(const aQuestion: String; const aHidden: Boolean; const aOnAnswer: TutlInputEvent);
- begin
- if Assigned(aOnAnswer) then
- fOnAnswer := aOnAnswer;
- fIsAsking := true;
- fInputBackup := fCommandPrompt.Current;
- if aHidden then
- fCommandPrompt.HiddenChar := '*'
- else
- fCommandPrompt.HiddenChar := #0;
- fCommandPrompt.HistoryEnabled := false;
- fCommandPrompt.OnAutoComplete := nil;
- fCommandPrompt.Prefix := aQuestion;
- fCommandPrompt.Current := '';
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlConsoleMenu.Create(const aHelp: String; const aConsoleCS: syncobjs.TCriticalSection);
- begin
- inherited Create(aHelp);
- fExitMenu := TutlMenuItem.Create(self, 'exit', 'exit programm', nil);
- fCommandPrompt := TutlCommandPrompt.Create(aConsoleCS);
- fCommandPrompt.OnAutoComplete := @AutoComplete;
- fCommandPrompt.OnInput := @CommandInput;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TutlConsoleMenu.Destroy;
- begin
- FreeAndNil(fCommandPrompt);
- FreeAndNil(fExitMenu);
- inherited Destroy;
- end;
-
- end.
|