| 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 | CallBroker; | 
|---|
| 80 | URLList.Assign(RPCBrokerV.Results); | 
|---|
| 81 | if RPCBrokerV.Results.Count>0 then Result := RPCBrokerV.Results.Strings[0] | 
|---|
| 82 | else Result := '-1^Error: No URL''s returned from server.'; | 
|---|
| 83 | end else begin | 
|---|
| 84 | Result := '0^Invalid TStringList URLList passed'; | 
|---|
| 85 | end; | 
|---|
| 86 | end else begin | 
|---|
| 87 | Result := '-1^"TMG CPRS GET URL LIST" RPC Not available on server'; | 
|---|
| 88 | end; | 
|---|
| 89 | end; | 
|---|
| 90 |  | 
|---|
| 91 |  | 
|---|
| 92 | initialization | 
|---|
| 93 | TMG_URL_RPC_Available := false;  //default to not avail. | 
|---|
| 94 | TMG_URL_RPC_Checked := false;   //default to not checked. | 
|---|
| 95 | frmWebTabs := TList.Create; | 
|---|
| 96 | frmWebTabs.Count := CT_LAST_WEBTAB-CT_WEBTAB1+1;   //fill up list with nil pointers | 
|---|
| 97 | finalization | 
|---|
| 98 | frmWebTabs.Free; | 
|---|
| 99 | end. | 
|---|
| 100 |  | 
|---|