64. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 9/24/2019 1:37:50 PM Eastern Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.

64.1 Files compared

# Location File Last Modified
1 PCL-5_v1_build_8.zip\v1_build 8\Unredacted\spp_mha_web-development.zip\spp_mha_web-development\Delphi\MHA_WEB\RPCWebServer fRPCWebServer.pas Wed Jul 31 17:35:31 2019 UTC
2 PCL-5_v1_build_8.zip\v1_build 8\Unredacted\spp_mha_web-development.zip\spp_mha_web-development\Delphi\MHA_WEB\RPCWebServer fRPCWebServer.pas Mon Sep 23 16:20:20 2019 UTC

64.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 2 454
Changed 1 2
Inserted 0 0
Removed 0 0

64.3 Comparison options

Whitespace
Character case Differences in character case are significant
Line endings Differences in line endings (CR and LF characters) are ignored
CR/LF characters Not shown in the comparison detail

64.4 Active regular expressions

No regular expressions were active.

64.5 Comparison detail

  1   {
  2     aRPCWebS erver can  be used in  developme nt as a lo calhost-on ly web ser ver
  3     with RPC  calls tha t use HTTP /JSON as t he format  for the RP C contents .
  4  
  5     Command  Line Optio ns are:
  6  
  7       (S)ERV ER         VistA Serv er name or  IP addres s
  8       (P)ORT            VistA RPC  Listener P ort
  9       (O)PTI ON         VistA Cont ext Option
  10       (R)PC             VistA RPC  Front Cont roller
  11       (H)TTP Port       Localhost  port to re ceive REST ful calls
  12       (W)EBA PP         Path to we b app if s erving fil es locally
  13  
  14       Exampl e Paramete rs in Shor tcut ---
  15         S= URL          P=9084 O=" YTQREST MH A" R="YTQR EST QADMIN " H=8080
  16   }
  17  
  18   unit fRPCW ebServer;
  19  
  20   interface
  21  
  22   uses
  23     Winapi.W indows, Wi napi.Messa ges, Syste m.SysUtils , System.V ariants, S ystem.Clas ses, Syste m.StrUtils ,
  24     Vcl.Grap hics, Vcl. Controls,  Vcl.Forms,  Vcl.Dialo gs, Vcl.St dCtrls,
  25     Winapi.S HFolder, u WebTypes,  uWebRPC, u EmbeddedHT TPServer,  Vcl.Button s, Vcl.Men us;
  26  
  27   type
  28     TfrmRPCW ebServer =  class(TFo rm)
  29       lblBro ker: TLabe l;
  30       lblWeb App: TLabe l;
  31       memLog : TMemo;
  32       btnLog : TButton;
  33       btnNex t: TBitBtn ;
  34       btnPre v: TBitBtn ;
  35       lblTit le: TLabel ;
  36       popLog : TPopupMe nu;
  37       mnuCle arLog: TMe nuItem;
  38       proced ure FormCr eate(Sende r: TObject );
  39       proced ure FormDe stroy(Send er: TObjec t);
  40       proced ure FormSh ow(Sender:  TObject);
  41       proced ure btnLog Click(Send er: TObjec t);
  42       proced ure btnNex tClick(Sen der: TObje ct);
  43       proced ure btnPre vClick(Sen der: TObje ct);
  44       proced ure mnuCle arLogClick (Sender: T Object);
  45     private
  46       { Priv ate declar ations }
  47       FWebRP C: TWebRPC ;
  48       FRESTC allRPC: st ring;
  49       FLog:  TStringLis t;
  50       FLogSh owing: Boo lean;
  51       FHTTPS erver: TEm beddedHTTP Server;
  52       FHTTPP ort: strin g;
  53       FAppPa th: string ;
  54       FAppPa ge: string ;
  55       FRESTP attern: st ring;
  56       proced ure Handle LogUpdate( Sender: TO bject);
  57       proced ure SetCal lInfo(cons t nextCall : Boolean) ;
  58       proced ure LoadAp pConfigura tion;
  59       proced ure SetPat hAndPage(c onst aUrl:  string);
  60       proced ure Prepen dAppPath(v ar aPath:  string);
  61       proced ure DoFetc h(Sender:  TObject; R equest: TF etchReques t; var Res ponse: TFe tchRespons e);
  62     public
  63       { Publ ic declara tions }
  64     end;
  65  
  66   var
  67     frmRPCWe bServer: T frmRPCWebS erver;
  68  
  69   implementa tion
  70  
  71   {$R *.dfm}
  72  
  73   // command
  74  
  75   const
  76     REST_CAL L_RPC = 'Y TQREST QAD MIN';
  77  
  78   // public  methods -- ---------- ---------- ---------- ---------- ---------- -
  79  
  80   procedure  TfrmRPCWeb Server.For mCreate(Se nder: TObj ect);
  81   begin
  82     FWebRPC  := TWebRPC .Create;
  83     FLog :=  TStringLis t.Create;
  84     FLogShow ing := tru e;
  85     FLog.OnC hange := H andleLogUp date;
  86     lblTitle .Caption : = '';
  87     // used  if no WebA pp URL pas sed in
  88     FAppPath  := './';
  89     FAppPage  := 'RESTS erver';
  90   end;
  91  
  92   procedure  TfrmRPCWeb Server.For mDestroy(S ender: TOb ject);
  93   begin
  94     FLog.Fre e;
  95     FWebRPC. Free;
  96     if FHTTP Server <>  nil then F HTTPServer .Free;
  97   end;
  98  
  99   procedure  TfrmRPCWeb Server.For mShow(Send er: TObjec t);
  100   var
  101     anOption : string;
  102   begin
  103     anOption  := FWebRP C.ParseCom mandLine(' OPTION');
  104     FLog.Add ('Context  Option: '  + anOption );
  105     FRESTCal lRPC := FW ebRPC.Pars eCommandLi ne('RPC');
  106     if (Leng th(FRESTCa llRPC) = 0 ) then FRE STCallRPC  := REST_CA LL_RPC;
  107     FLog.Add ('REST Cal l RPC: ' +  FRESTCall RPC);
  108     if Lengt h(anOption ) > 0
  109       then F WebRPC.Con nectToVist a(anOption )
  110       else F Log.Add('U nable to c onnect to  VistA -- n o option s pecified i n command  line.');
  111  
  112     LoadAppC onfigurati on;
  113     if (Leng th(FAppPat h) > 0) an d (Length( FAppPage)  > 0) then
  114     begin
  115       FHTTPS erver := T EmbeddedHT TPServer.C reate(Self , FAppPath );
  116       FHTTPS erver.Port  := FWebRP C.ParseCom mandLine(' HTTPPort') ;
  117       FHTTPS erver.LogL ist := FLo g;
  118       FHTTPS erver.AddF etchPatter n(FRESTPat tern);
  119       FHTTPS erver.OnFe tch := DoF etch;
  120       FHTTPP ort := FHT TPServer.A ctivateLis teningPort ;
  121       FLog.A dd('HTTP s erver runn ing for lo calhost on ly on port  ' + FHTTP Port);
  122     end else
  123     begin
  124       FLog.A dd('Unable  to start  web server  -- initia l URL not  specified  in command  line.');
  125     end;
  126  
  127     lblBroke r.Caption  := FWebRPC .ParseComm andLine('S ERVER') +  ':' + FWeb RPC.ParseC ommandLine ('PORT');
  128     lblWebAp p.Caption  := FAppPat h + FAppPa ge + ':' +  FHTTPPort ;
  129   end;
  130  
  131   // private  methods - ---------- ---------- ---------- ---------- ---------- -
  132  
  133   procedure  TfrmRPCWeb Server.Han dleLogUpda te(Sender:  TObject);
  134   begin
  135     memLog.L ines := FL og;
  136   end;
  137  
  138   procedure  TfrmRPCWeb Server.btn LogClick(S ender: TOb ject);
  139   begin
  140     FLogShow ing := tru e;
  141     memLog.L ines := FL og;
  142     lblTitle .Caption : = '';
  143   end;
  144  
  145   procedure  TfrmRPCWeb Server.btn NextClick( Sender: TO bject);
  146   begin
  147     SetCallI nfo(True);
  148   end;
  149  
  150   procedure  TfrmRPCWeb Server.btn PrevClick( Sender: TO bject);
  151   begin
  152     SetCallI nfo(False) ;
  153   end;
  154  
  155   procedure  TfrmRPCWeb Server.Set CallInfo(c onst nextC all: Boole an);
  156   begin
  157     if FLogS howing the n
  158     begin
  159       FLogSh owing := f alse;
  160       FWebRP C.ResetCal lCursor;
  161     end;
  162     if FWebR PC <> nil  then
  163     begin
  164       if nex tCall
  165         then  memLog.Li nes := FWe bRPC.NextC all
  166         else  memLog.Li nes := FWe bRPC.PrevC all;
  167       lblTit le.Caption  := IntToS tr(FWebRPC .CursorPos ition) + '  of ' + In tToStr(FWe bRPC.CallC ount);
  168     end else
  169     begin
  170       memLog .Lines.Cle ar;
  171       memLog .Lines.Add ('No RPC B roker.');
  172     end;
  173   end;
  174  
  175   procedure  TfrmRPCWeb Server.DoF etch(Sende r: TObject ; Request:  TFetchReq uest; var  Response:  TFetchResp onse);
  176   begin
  177     FWebRPC. CallVista( FRESTCallR PC, Reques t, Respons e);
  178   end;
  179  
  180   // call RP C to get i nformation  about app lication t o run
  181   procedure  TfrmRPCWeb Server.Loa dAppConfig uration;
  182   var
  183     s: strin g;
  184   begin
  185     // check  command l ine for co nfiguratio n values
  186     s := FWe bRPC.Parse CommandLin e('WEBAPP' );
  187     if Lengt h(s) > 0 t hen SetPat hAndPage(s );
  188     FRESTPat tern := '/ api/';
  189  
  190     // poten tially cal l VistA fo r configur ation valu es
  191     // FWebR PC.CallVis ta('YTQRES T MANIFEST ', aReques t, aRespon se);
  192  
  193     FLog.Add ('AppPath:  ' + FAppP ath);
  194     FLog.Add ('AppPage:  ' + FAppP age);
  195     FLog.Add ('RESTPatt ern: ' + F RESTPatter n);
  196   end;
  197  
  198   procedure  TfrmRPCWeb Server.mnu ClearLogCl ick(Sender : TObject) ;
  199   begin
  200     FWebRPC. ClearHisto ry;
  201     FLog.Cle ar;
  202   end;
  203  
  204   // split U RL into cl eaned-up p ath and pa ge compone nts
  205   procedure  TfrmRPCWeb Server.Set PathAndPag e(const aU rl: string );
  206   var
  207     x, path,  page: str ing;
  208   begin
  209     x := Rep laceStr(aU rl, '\', ' /');
  210     page :=  ReverseStr ing(x);
  211     page :=  ReverseStr ing(Copy(p age, 1, Po s('/',page )-1));
  212     path :=  Copy(x, 1,  Length(x) -Length(pa ge));
  213     if (Copy (path, 1,  2) <> '//' ) and (pat h[2] <> ': ') then Pr ependAppPa th(path);
  214     if Lengt h(FAppPath ) = 0 then  FAppPath  := path;
  215     if Lengt h(FAppPage ) = 0 then  FAppPage  := page;
  216   end;
  217  
  218   // get app data path  to create  a full pat h
  219   procedure  TfrmRPCWeb Server.Pre pendAppPat h(var aPat h: string) ;
  220   var
  221     appDataP ath: array [0..MAX_PA TH] of Cha r;
  222   begin
  223     if SUCCE EDED(SHGet FolderPath (0,CSIDL_A PPDATA, 0,  SHGFP_TYP E_CURRENT,  @appDataP ath[0]))
  224       then a Path := ap pDataPath  + aPath
  225       else r aise Excep tion.Creat e('Path to  appdata n ot found') ;
  226   end;
  227  
  228   end.

Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.