--- Merging r21042 into '.':

U    packages/winunits-base/src/activex.pp
--- Merging r21340 into '.':
U    utils/fppkg/lnet/ltelnet.pp
--- Merging r21384 into '.':
G    packages/winunits-base/src/activex.pp

# revisions: 21042,21340,21384
r21042 | sergei | 2012-04-25 20:14:47 +0200 (Wed, 25 Apr 2012) | 1 line
Changed paths:
   M /trunk/packages/winunits-base/src/activex.pp

* Changed tagVariant.pbstrVal to ^WideString and added a comment about impossibility of having managed members in this record (Mantis #21075).
r21340 | marco | 2012-05-20 00:12:45 +0200 (Sun, 20 May 2012) | 2 lines
Changed paths:
   M /trunk/utils/fppkg/lnet/ltelnet.pp

 * Patch from Mark Morgan Lloyd to add subcommands to ltelnet. Mantis #22032
r21384 | marco | 2012-05-24 21:01:01 +0200 (Thu, 24 May 2012) | 3 lines
Changed paths:
   M /trunk/packages/winunits-base/src/activex.pp

 * Some more interfaces (include IOleCOmmandTarget). Patch by Ludo.
   Mantis #22109

git-svn-id: branches/fixes_2_6@21719 -

packages/winunits-base/src/activex.pp

@@ -71,6 +71,8 @@ type
 
 CONST
    GUID_NULL  : TGUID =  '{00000000-0000-0000-0000-000000000000}';
+   IID_IPrint : TGUID = '{B722BCC9-4E68-101B-A2BC-00AA00404770}';
+   IID_IOleCommandTarget : TGUID = '{B722BCCB-4E68-101B-A2BC-00AA00404770}';
 
      // bit flags for IExternalConnection
 CONST
@@ -805,6 +807,85 @@ Const
     PROPSETFLAG_NONSIMPLE = DWORD(1);
     PROPSETFLAG_ANSI      = DWORD(2);
 
+Type
+    OLECMDF 	  = LongWord;
+    OLECMDTEXTF   = LongWord;
+    OLECMDEXECOPT = LongWord;
+    OLECMDID      = LongWord;
+
+Const
+    OLECMDF_SUPPORTED     = $0000000000000001;
+    OLECMDF_ENABLED       = $0000000000000002;
+    OLECMDF_LATCHED 	  = $0000000000000004;
+    OLECMDF_NINCHED 	  = $0000000000000008;
+    OLECMDF_INVISIBLE 	  = $0000000000000010;
+    OLECMDF_DEFHIDEONCTXTMENU = $0000000000000020;
+
+    OLECMDTEXTF_NONE      = $0000000000000000;
+    OLECMDTEXTF_NAME      = $0000000000000001;
+    OLECMDTEXTF_STATUS    = $0000000000000002;
+
+    OLECMDEXECOPT_DODEFAULT = $0000000000000000;
+    OLECMDEXECOPT_PROMPTUSER= $0000000000000001;
+    OLECMDEXECOPT_DONTPROMPTUSER = $0000000000000002;
+    OLECMDEXECOPT_SHOWHELP  = $0000000000000003;
+
+    OLECMDID_OPEN         = $0000000000000001;
+    OLECMDID_NEW 	  = $0000000000000002;
+    OLECMDID_SAVE 	  = $0000000000000003;
+    OLECMDID_SAVEAS       = $0000000000000004;
+    OLECMDID_SAVECOPYAS   = $0000000000000005;
+    OLECMDID_PRINT 	  = $0000000000000006;
+    OLECMDID_PRINTPREVIEW = $0000000000000007;
+    OLECMDID_PAGESETUP    = $0000000000000008;
+    OLECMDID_SPELL 	  = $0000000000000009;
+    OLECMDID_PROPERTIES   = $000000000000000A;
+    OLECMDID_CUT 	  = $000000000000000B;
+    OLECMDID_COPY 	  = $000000000000000C;
+    OLECMDID_PASTE 	  = $000000000000000D;
+    OLECMDID_PASTESPECIAL = $000000000000000E;
+    OLECMDID_UNDO 	  = $000000000000000F;
+    OLECMDID_REDO 	  = $0000000000000010;
+    OLECMDID_SELECTALL    = $0000000000000011;
+    OLECMDID_CLEARSELECTION = $0000000000000012;
+    OLECMDID_ZOOM         = $0000000000000013;
+    OLECMDID_GETZOOMRANGE = $0000000000000014;
+    OLECMDID_UPDATECOMMANDS = $0000000000000015;
+    OLECMDID_REFRESH      = $0000000000000016;
+    OLECMDID_STOP 	  = $0000000000000017;
+    OLECMDID_HIDETOOLBARS = $0000000000000018;
+    OLECMDID_SETPROGRESSMAX = $0000000000000019;
+    OLECMDID_SETPROGRESSPOS = $000000000000001A;
+    OLECMDID_SETPROGRESSTEXT = $000000000000001B;
+    OLECMDID_SETTITLE     = $000000000000001C;
+    OLECMDID_SETDOWNLOADSTATE = $000000000000001D;
+    OLECMDID_STOPDOWNLOAD = $000000000000001E;
+    OLECMDID_ONTOOLBARACTIVATED = $000000000000001F;
+    OLECMDID_FIND         = $0000000000000020;
+    OLECMDID_DELETE 	  = $0000000000000021;
+    OLECMDID_HTTPEQUIV    = $0000000000000022;
+    OLECMDID_HTTPEQUIV_DONE = $0000000000000023;
+    OLECMDID_ENABLE_INTERACTION = $0000000000000024;
+    OLECMDID_ONUNLOAD     = $0000000000000025;
+    OLECMDID_PROPERTYBAG2 = $0000000000000026;
+    OLECMDID_PREREFRESH   = $0000000000000027;
+    OLECMDID_SHOWSCRIPTERROR = $0000000000000028;
+    OLECMDID_SHOWMESSAGE  = $0000000000000029;
+    OLECMDID_SHOWFIND     = $000000000000002A;
+    OLECMDID_SHOWPAGESETUP= $000000000000002B;
+    OLECMDID_SHOWPRINT    = $000000000000002C;
+    OLECMDID_CLOSE 	  = $000000000000002D;
+    OLECMDID_ALLOWUILESSSAVEAS = $000000000000002E;
+    OLECMDID_DONTDOWNLOADCSS = $000000000000002F;
+    OLECMDID_UPDATEPAGESTATUS = $0000000000000030;
+    OLECMDID_PRINT2       = $0000000000000031;
+    OLECMDID_PRINTPREVIEW2= $0000000000000032;
+    OLECMDID_SETPRINTTEMPLATE = $0000000000000033;
+    OLECMDID_GETPRINTTEMPLATE = $0000000000000034;
+    OLECMDID_UPDATEVSCROLL= $0000000000000035;
+    OLECMDID_UPDATEHSCROLL= $0000000000000036;
+    OLECMDID_FITTOSCREEN  = $0000000000000037;
+
 TYPE
     TVarType            = USHORT;
     VARTYPE             = TVarType deprecated;  // not in Delphi, and clashes with VarType function
@@ -1416,6 +1497,7 @@ TYPE
        VT_ERROR:                (scode: HResult);
        VT_CY:                   (cyVal: Currency);
        VT_DATE:                 (date: TOleDate);
+       { managed types cannot be used in a variant record like this one. }
        VT_BSTR:                 (bstrVal: POleStr{WideString});
        VT_UNKNOWN:              (unkVal: Pointer{IUnknown});
        VT_DISPATCH:             (dispVal: Pointer{IDispatch});
@@ -1434,7 +1516,7 @@ TYPE
        VT_BYREF or VT_ERROR:    (pscode: ^HResult);
        VT_BYREF or VT_CY:       (pcyVal: PCurrency);
        VT_BYREF or VT_DATE:     (pdate: POleDate);
-       VT_BYREF or VT_BSTR:     (pbstrVal: PPOleStr);
+       VT_BYREF or VT_BSTR:     (pbstrVal: ^WideString);
        VT_BYREF or VT_UNKNOWN:  (punkVal: ^IUnknown);
        VT_BYREF or VT_DISPATCH: (pdispVal: ^IDispatch);
        VT_BYREF or VT_ARRAY:    (pparray: PPSafeArray);
@@ -3216,6 +3298,38 @@ TYPE
   LPOleInPlaceFrameInfo = POleInPlaceFrameInfo;
   OLEINPLACEFRAMEINFO = tagOIFI;
 
+   PtagPAGESET = ^tagPAGESET;
+
+   PtagPAGERANGE = ^tagPAGERANGE;
+
+   tagPAGESET = packed record
+       cbStruct : LongWord;
+       fOddPages : Integer;
+       fEvenPages : Integer;
+       cPageRange : LongWord;
+       rgPages : PtagPAGERANGE;
+   end;
+
+   tagPAGERANGE = packed record
+       nFromPage : Integer;
+       nToPage : Integer;
+   end;
+
+   P_tagOLECMD = ^_tagOLECMD;
+
+   _tagOLECMD = packed record
+       cmdID : LongWord;
+       cmdf : LongWord;
+   end;
+
+   P_tagOLECMDTEXT = ^_tagOLECMDTEXT;
+
+   _tagOLECMDTEXT = packed record
+       cmdtextf : LongWord;
+       cwActual : LongWord;
+       cwBuf : LongWord;
+       rgwz : PWord;
+   end;
 
 { redefinitions }
   function CoCreateGuid(out _para1:TGUID):HRESULT;stdcall;external 'ole32.dll' name 'CoCreateGuid';
@@ -3230,6 +3344,9 @@ TYPE
 { OleIdl.h }
 type
   IOleInPlaceActiveObject = interface;
+  IPrint 		  = interface;
+  IOleCommandTarget 	  = interface;
+  IContinueCallback       = interface;
 
   IOleAdviseHolder = interface(IUnknown)
     ['{00000111-0000-0000-C000-000000000046}']
@@ -3390,13 +3507,25 @@ type
        function ActivateMe(pviewtoactivate:IOleDocumentView):hresult; stdcall;
        end;
 
+    IPrint = interface(IUnknown)
+       ['{B722BCC9-4E68-101B-A2BC-00AA00404770}']
+       procedure SetInitialPageNum(nFirstPage:Integer);stdcall;
+       procedure GetPageInfo(out pnFirstPage:Integer;out pcPages:Integer);stdcall;
+       procedure RemotePrint(grfFlags:LongWord;var pptd:PDVTARGETDEVICE;var pppageset:PtagPAGESET;var pstgmOptions:tagRemSTGMEDIUM;pcallback:IContinueCallback;nFirstPage:Integer;out pcPagesPrinted:Integer;out pnLastPage:Integer);stdcall;
+      end;
+
+    IOleCommandTarget = interface(IUnknown)
+       ['{B722BCCB-4E68-101B-A2BC-00AA00404770}']
+       procedure QueryStatus(var pguidCmdGroup:GUID;cCmds:LongWord;var prgCmds:_tagOLECMD;var pCmdText:_tagOLECMDTEXT);stdcall;
+       procedure Exec(var pguidCmdGroup:GUID;nCmdID:LongWord;nCmdexecopt:LongWord;var pvaIn:OleVariant;var pvaOut:OleVariant);stdcall;
+      end;
+
     IContinueCallback = interface(IUnknown)
        ['{b722bcca-4e68-101b-a2bc-00aa00404770}']
         function FContinue:HResult;Stdcall;
         function FContinuePrinting( nCntPrinted:LONG;nCurPage:Long;pwzprintstatus:polestr):HResult;Stdcall;
       end;
 
-
 { ObjSafe.idl}
   IObjectSafety = interface(IUnknown)
     ['{CB5BDC81-93C1-11cf-8F20-00805F2CD064}']

utils/fppkg/lnet/ltelnet.pp

@@ -68,7 +68,14 @@ type
   TLTelnetControlChars = set of Char;
 
   TLHowEnum = (TE_WILL = 251, TE_WONT, TE_DO, TE_DONW);
-  
+
+  TLSubcommandCallback= function(command: char; const parameters, defaultResponse: string): string;
+  TLSubcommandEntry= record
+                       callback: TLSubcommandCallback;
+                       defaultResponse: string
+                     end;
+  TLSubcommandArray= array[#$00..#$ff] of TLSubcommandEntry;
+
   { TLTelnet }
 
   TLTelnet = class(TLComponent, ILDirect)
@@ -89,6 +96,7 @@ type
     FBuffer: array of Char;
     FBufferIndex: Integer;
     FBufferEnd: Integer;
+    FSubcommandCallbacks: TLSubcommandArray;
     procedure InflateBuffer;
     function AddToBuffer(const aStr: string): Boolean; inline;
     
@@ -127,7 +135,9 @@ type
     function RegisterOption(const aOption: Char; const aCommand: Boolean): Boolean;
     procedure SetOption(const Option: Char);
     procedure UnSetOption(const Option: Char);
-    
+
+    function RegisterSubcommand(aOption: char; callback: TLSubcommandCallback; const defaultResponse: string= ''): boolean;
+
     procedure Disconnect(const Forced: Boolean = True); override;
     
     procedure SendCommand(const aCommand: Char; const How: TLHowEnum); virtual;
@@ -173,7 +183,10 @@ type
    public
     property LocalEcho: Boolean read FLocalEcho write FLocalEcho;
   end;
-  
+
+
+function LTelnetSubcommandCallback(command: char; const parameters, defaultResponse: string): string;
+
 implementation
 
 uses
@@ -379,6 +392,20 @@ begin
     SendCommand(Option, False);
 end;
 
+(* If already set, the callback can be reverted to nil but it can't be changed  *)
+(* in a single step. The default response, if specified, is used by the         *)
+(* LTelnetSubcommandCallback() function and is available to others.             *)
+//
+function TLTelnet.RegisterSubcommand(aOption: char; callback: TLSubcommandCallback; const defaultResponse: string= ''): boolean;
+
+begin
+  result := (not Assigned(FSubcommandCallbacks[aOption].callback)) or (@callback = nil);
+  if result then begin
+    FSubcommandCallbacks[aOption].callback := callback;
+    FSubcommandCallbacks[aOption].defaultResponse := defaultResponse
+  end
+end { TLTelnet.RegisterSubcommand } ;
+
 procedure TLTelnet.Disconnect(const Forced: Boolean = True);
 begin
   FConnection.Disconnect(Forced);
@@ -458,7 +485,33 @@ procedure TLTelnetClient.React(const Operation, Command: Char);
     AddToBuffer(TS_IAC + Operation + Command);
     OnCs(nil);
   end;
-  
+
+(* Retrieve the parameters from the current instance, and pass them explicitly  *)
+(* to the callback.                                                             *)
+//
+  procedure subcommand(command: char);
+
+  var   parameters, response: string;
+        i: integer;
+
+  begin
+    if FStack.ItemIndex > 5 then begin
+      SetLength(parameters, FStack.ItemIndex - 5);
+      Move(FStack[3], parameters[1], FStack.ItemIndex - 5);
+      i := 1;
+      while i <= Length(parameters) - 1 do      (* Undouble IACs                *)
+        if (parameters[i] = TS_IAC) and (parameters[i + 1] = TS_IAC) then
+          Delete(parameters, i, 1)
+        else
+          Inc(i)
+    end else
+      parameters := '';
+    response := FSubcommandCallbacks[command].callback(command, parameters, FSubcommandCallbacks[command].defaultResponse);
+    DoubleIAC(response);
+    AddToBuffer(TS_IAC + TS_SB + command + response + TS_IAC + TS_SE);
+    OnCs(nil)
+  end { subcommand } ;
+
 begin
   {$ifdef debug}
   Writeln('**GOT** ', TNames[Operation], ' ', TNames[Command]);
@@ -473,6 +526,10 @@ begin
               else Refuse(TS_DONT, Command);
                  
     TS_WONT : if Command in FPossible then FActiveOpts := FActiveOpts - [Command];
+    TS_SB   : if not Assigned(FSubcommandCallbacks[command].callback) then
+                refuse(TS_WONT, command)
+              else
+                subcommand(command)
   end;
 end;
 
@@ -556,6 +613,17 @@ begin
   FConnection.CallAction;
 end;
 
+(* This is a default callback for use with the RegisterSubcommand() method. It  *)
+(* may be used where the result is unchanging, for example in order to return   *)
+(* the terminal type.                                                           *)
+//
+function LTelnetSubcommandCallback(command: char; const parameters, defaultResponse: string): string;
+
+begin
+  result := defaultResponse
+end { LTelnetSubcommandCallback } ;
+
+
 initialization
   for zz := #0 to #255 do
     TNames[zz] := IntToStr(Ord(zz));