| [541] | 1 | unit fWebTab;
 | 
|---|
 | 2 | //kt Added entire unit and form.
 | 
|---|
 | 3 | 
 | 
|---|
 | 4 | interface
 | 
|---|
 | 5 | 
 | 
|---|
 | 6 | uses
 | 
|---|
 | 7 |   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 | 
|---|
 | 8 |   Dialogs, OleCtrls, SHDocVw, StdCtrls,fPage;
 | 
|---|
 | 9 | 
 | 
|---|
 | 10 | type
 | 
|---|
 | 11 |   TfrmWebTab = class(TfrmPage)
 | 
|---|
 | 12 |     WebBrowser: TWebBrowser;
 | 
|---|
 | 13 |   private
 | 
|---|
 | 14 |     { Private declarations }
 | 
|---|
 | 15 |   public
 | 
|---|
 | 16 |     { Public declarations }
 | 
|---|
 | 17 |     Procedure RequestPrint; override;
 | 
|---|
 | 18 |     Procedure NagivateTo(URL: Widestring);
 | 
|---|
 | 19 |   end;
 | 
|---|
 | 20 | 
 | 
|---|
 | 21 | function AskServerForURLs(URLList : TStringList) : string;
 | 
|---|
 | 22 | 
 | 
|---|
 | 23 | var
 | 
|---|
 | 24 |   frmWebTabs: TList;
 | 
|---|
 | 25 | 
 | 
|---|
 | 26 |   TMG_URL_RPC_Available : boolean;
 | 
|---|
 | 27 |   TMG_URL_RPC_Checked : boolean;
 | 
|---|
 | 28 | 
 | 
|---|
 | 29 | implementation
 | 
|---|
 | 30 | 
 | 
|---|
 | 31 | {$R *.dfm}
 | 
|---|
 | 32 | uses ORNet,ORFn,Trpcb,uConst;
 | 
|---|
 | 33 | 
 | 
|---|
 | 34 | 
 | 
|---|
 | 35 | Procedure TfrmWebTab.RequestPrint;
 | 
|---|
 | 36 | begin
 | 
|---|
 | 37 |   inherited;
 | 
|---|
 | 38 |   MessageDlg('Finish code: request printing from web browser...',mtInformation,[mbOK],0);
 | 
|---|
 | 39 | end;
 | 
|---|
 | 40 | 
 | 
|---|
 | 41 | 
 | 
|---|
 | 42 | Procedure TfrmWebTab.NagivateTo(URL: WideString);
 | 
|---|
 | 43 | begin
 | 
|---|
 | 44 |   WebBrowser.Navigate(URL);
 | 
|---|
 | 45 | end;
 | 
|---|
 | 46 | 
 | 
|---|
 | 47 | //=================================================================
 | 
|---|
 | 48 | //===== Globally available functions, not part of object ==========
 | 
|---|
 | 49 | //=================================================================
 | 
|---|
 | 50 | 
 | 
|---|
 | 51 | function AskServerForURLs(URLList : TStringList) : string;
 | 
|---|
 | 52 | //Get URL list from server.
 | 
|---|
 | 53 | //URLList is filled with RPCBroker.Results.  Should have this format:
 | 
|---|
 | 54 | //     URLList(0)='1^Success' pr '0^Failure'
 | 
|---|
 | 55 | //     URLList(1)="URL#1"  a URL to display in tab 1
 | 
|---|
 | 56 | //     URLList(2)="URL#2"  a URL to display in tab 2
 | 
|---|
 | 57 | //     URLList(3)="URL#3"  a URL to display in tab 3
 | 
|---|
 | 58 | //  Note: if URL='<!HIDE!>' then server is requesting tab to be hidden
 | 
|---|
 | 59 | //Results of Fn: Returns '1^Success' if success, or '0^ErrorMessage'
 | 
|---|
 | 60 | var
 | 
|---|
 | 61 |     RPCResult              : AnsiString;
 | 
|---|
 | 62 |     i                      : integer;
 | 
|---|
 | 63 | begin
 | 
|---|
 | 64 |   if TMG_URL_RPC_Checked = false then begin
 | 
|---|
 | 65 |     RPCBrokerV.remoteprocedure := 'XWB IS RPC AVAILABLE';
 | 
|---|
 | 66 |     RPCBrokerV.Param[0].Value := 'TMG CPRS GET URL LIST';
 | 
|---|
 | 67 |     RPCBrokerV.Param[0].ptype := literal;
 | 
|---|
 | 68 |     RPCBrokerV.Param[1].Value := 'R';
 | 
|---|
 | 69 |     RPCBrokerV.Param[1].ptype := literal;
 | 
|---|
 | 70 |     RPCResult := RPCBrokerV.StrCall;   {returns 1 if available, 0 if not available}
 | 
|---|
 | 71 |     TMG_URL_RPC_Checked := true;
 | 
|---|
 | 72 |     TMG_URL_RPC_Available := (RPCResult='1');
 | 
|---|
 | 73 |   end;
 | 
|---|
 | 74 | 
 | 
|---|
 | 75 |   if TMG_URL_RPC_Available= true then begin
 | 
|---|
 | 76 |     if (URLList <> nil) then begin
 | 
|---|
 | 77 |       RPCBrokerV.remoteprocedure := 'TMG CPRS GET URL LIST';
 | 
|---|
 | 78 |       RPCBrokerV.Call;
 | 
|---|
 | 79 |       URLList.Assign(RPCBrokerV.Results);
 | 
|---|
 | 80 |       if RPCBrokerV.Results.Count>0 then Result := RPCBrokerV.Results.Strings[0]
 | 
|---|
 | 81 |       else Result := '-1^Error: No URL''s returned from server.';
 | 
|---|
 | 82 |     end else begin
 | 
|---|
 | 83 |       Result := '0^Invalid TStringList URLList passed';
 | 
|---|
 | 84 |     end;
 | 
|---|
 | 85 |   end else begin
 | 
|---|
 | 86 |     Result := '-1^"TMG CPRS GET URL LIST" RPC Not available on server';
 | 
|---|
 | 87 |   end;
 | 
|---|
 | 88 | end;
 | 
|---|
 | 89 | 
 | 
|---|
 | 90 | 
 | 
|---|
 | 91 | initialization
 | 
|---|
 | 92 |   TMG_URL_RPC_Available := false;  //default to not avail.
 | 
|---|
 | 93 |   TMG_URL_RPC_Checked := false;   //default to not checked.
 | 
|---|
 | 94 |   frmWebTabs := TList.Create;
 | 
|---|
 | 95 |   frmWebTabs.Count := CT_LAST_WEBTAB-CT_WEBTAB1+1;   //fill up list with nil pointers
 | 
|---|
 | 96 | finalization
 | 
|---|
 | 97 |   frmWebTabs.Free;
 | 
|---|
 | 98 | end.
 | 
|---|
 | 99 | 
 | 
|---|