| [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 |  | 
|---|