Produced by Araxis Merge on 4/16/2019 12:20:46 PM Central 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.
# | Location | File | Last Modified |
---|---|---|---|
1 | C:\AraxisMergeCompare\Pri_un\CPRS_32_P2_PCE\OR_30_405V60_SRC\10_2\PKI\Source | oPKIEncryption.pas | Wed Dec 12 14:05:02 2018 UTC |
2 | C:\AraxisMergeCompare\Pri_re\CPRS v32 P2 PCE Standardization-redacted\CPRS_32_P2_PCE\OR_30_405V60_SRC\10_2\PKI\Source | oPKIEncryption.pas | Tue Apr 16 14:08:30 2019 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 5 | 946 |
Changed | 4 | 8 |
Inserted | 0 | 0 |
Removed | 0 | 0 |
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 |
No regular expressions were active.
1 | unit oPKIE ncryption; | |
2 | ||
3 | interface | |
4 | ||
5 | uses | |
6 | System.C lasses, | |
7 | System.S ysUtils, | |
8 | TRPCB, | |
9 | wcrypt2; | |
10 | ||
11 | type | |
12 | EPKIEncr yptionErro r = class( Exception) ; | |
13 | ||
14 | TPKIPINR esult = (p rOK, prCan cel, prLoc ked, prErr or); | |
15 | ||
16 | TPKISANL ink = (slO K, slBlank VistA, slM isMatch, s lNoCertFou nd, slVist AError, sl Error); | |
17 | ||
18 | TPKIHash Algorithm = (ha128, ha256, ha3 84, ha512) ; | |
19 | ||
20 | TPKIEncr yptionLogE vent = pro cedure(con st aMessag e: string) of object ; | |
21 | ||
22 | IPKIEncr yptionEngi ne = inter face; | |
23 | IPKIEncr yptionData = interfa ce; | |
24 | IPKIEncr yptionSign ature = in terface; | |
25 | ||
26 | IPKIEncr yptionEngi ne = inter face(IInte rface) | |
27 | ['{RED ACTED}'] | |
28 | functi on getVist AUserName: string; | |
29 | functi on getIsCa rdReaderRe ady: boole an; | |
30 | functi on getSANF romCard: s tring; | |
31 | functi on getSANF romVistA: string; | |
32 | functi on getSANL ink: TPKIS ANLink; | |
33 | functi on getEngi neVersion: string; | |
34 | functi on getCSPN ame: strin g; | |
35 | functi on getHash Algorithm: string; | |
36 | ||
37 | proced ure setOnL ogEvent(co nst aOnLog Event: TPK IEncryptio nLogEvent) ; | |
38 | ||
39 | proced ure ClearP IN; | |
40 | proced ure Displa yProviders ; | |
41 | proced ure GetCer tificates( aList: TSt rings); | |
42 | proced ure HashDa ta(aPKIEnc ryptionDat a: IPKIEnc ryptionDat a); | |
43 | proced ure LinkSA NtoVistA; | |
44 | proced ure SignDa ta(aPKIEnc ryptionDat a: IPKIEnc ryptionDat a); | |
45 | proced ure Valida teSignatur e(aPKIEncr yptionSign ature: IPK IEncryptio nSignature ); | |
46 | proced ure SaveSi gnature(aP KIEncrypti onData: IP KIEncrypti onData); | |
47 | ||
48 | proper ty OnLogEv ent: TPKIE ncryptionL ogEvent wr ite setOnL ogEvent; | |
49 | ||
50 | proper ty EngineV ersion: st ring read getEngineV ersion; | |
51 | proper ty IsCardR eaderReady : boolean read getIs CardReader Ready; | |
52 | proper ty SANFrom Card: stri ng read ge tSANFromCa rd; | |
53 | proper ty SANFrom VistA: str ing read g etSANFromV istA; | |
54 | proper ty VistAUs erName: st ring read getVistAUs erName; | |
55 | proper ty SANLink : TPKISANL ink read g etSANLink; | |
56 | proper ty CSPName : string r ead getCSP Name; | |
57 | proper ty HashAlg orithm: st ring read getHashAlg orithm; | |
58 | end; | |
59 | ||
60 | IPKIEncr yptionData = interfa ce(IInterf ace) | |
61 | ['{RED ACTED}'] | |
62 | functi on getBuff er: string ; | |
63 | functi on getHash Text: stri ng; | |
64 | functi on getHash Hex: strin g; | |
65 | functi on getHash Value: Ans iString; | |
66 | functi on getSign ature: str ing; | |
67 | functi on getSign atureID: s tring; | |
68 | functi on getCrlU RL: string ; | |
69 | functi on getDate TimeSigned : TDateTim e; | |
70 | functi on getFMDa teTimeSign ed: string ; | |
71 | ||
72 | proced ure setBuf fer(const aValue: st ring); | |
73 | ||
74 | proced ure Append ToBuffer(a Strings: a rray of st ring); | |
75 | proced ure Clear; | |
76 | proced ure Valida te; | |
77 | ||
78 | proper ty Buffer: string re ad getBuff er write s etBuffer; | |
79 | proper ty HashTex t: string read getHa shText; | |
80 | proper ty HashHex : string r ead getHas hHex; | |
81 | proper ty Signatu re: string read getS ignature; | |
82 | proper ty Signatu reID: stri ng read ge tSignature ID; | |
83 | proper ty CrlURL: string re ad getCrlU RL; | |
84 | proper ty DateTim eSigned: T DateTime r ead getDat eTimeSigne d; | |
85 | proper ty FMDateT imeSigned: string re ad getFMDa teTimeSign ed; | |
86 | end; | |
87 | ||
88 | IPKIEncr yptionData DEAOrder = interface (IPKIEncry ptionData) | |
89 | ['{RED ACTED}'] | |
90 | functi on getDEAN umber: str ing; | |
91 | functi on getDeto xNumber: s tring; | |
92 | functi on getDire ctions: st ring; | |
93 | functi on getDrug Name: stri ng; | |
94 | functi on getIsDE ASig: bool ean; | |
95 | functi on getIssu anceDate: string; | |
96 | functi on getOrde rNumber: s tring; | |
97 | functi on getPati entAddress : string; | |
98 | functi on getPati entName: s tring; | |
99 | functi on getProv iderAddres s: string; | |
100 | functi on getProv iderName: string; | |
101 | functi on getQuan tity: stri ng; | |
102 | ||
103 | proced ure setDEA Number(con st aValue: string); | |
104 | proced ure setDet oxNumber(c onst aValu e: string) ; | |
105 | proced ure setDir ections(co nst aValue : string); | |
106 | proced ure setDru gName(cons t aValue: string); | |
107 | proced ure setIsD EASig(cons t aValue: boolean); | |
108 | proced ure setIss uanceDate( const aVal ue: string ); | |
109 | proced ure setOrd erNumber(c onst aValu e: string) ; | |
110 | proced ure setPat ientAddres s(const aV alue: stri ng); | |
111 | proced ure setPat ientName(c onst aValu e: string) ; | |
112 | proced ure setPro viderAddre ss(const a Value: str ing); | |
113 | proced ure setPro viderName( const aVal ue: string ); | |
114 | proced ure setQua ntity(cons t aValue: string); | |
115 | ||
116 | proced ure LoadFr omVistA(aR PCBroker: TRPCBroker ; aPatient DFN, aUser DUZ, aCPRS OrderNumbe r: string) ; | |
117 | ||
118 | proper ty IsDEASi g: boolean read getI sDEASig wr ite setIsD EASig; | |
119 | proper ty Issuanc eDate: str ing read g etIssuance Date write setIssuan ceDate; | |
120 | proper ty Patient Name: stri ng read ge tPatientNa me write s etPatientN ame; | |
121 | proper ty Patient Address: s tring read getPatien tAddress w rite setPa tientAddre ss; | |
122 | proper ty DrugNam e: string read getDr ugName wri te setDrug Name; | |
123 | proper ty Quantit y: string read getQu antity wri te setQuan tity; | |
124 | proper ty Directi ons: strin g read get Directions write set Directions ; | |
125 | proper ty DetoxNu mber: stri ng read ge tDetoxNumb er write s etDetoxNum ber; | |
126 | proper ty Provide rName: str ing read g etProvider Name write setProvid erName; | |
127 | proper ty Provide rAddress: string rea d getProvi derAddress write set ProviderAd dress; | |
128 | proper ty DEANumb er: string read getD EANumber w rite setDE ANumber; | |
129 | proper ty OrderNu mber: stri ng read ge tOrderNumb er write s etOrderNum ber; | |
130 | end; | |
131 | ||
132 | IPKIEncr yptionSign ature = in terface(II nterface) | |
133 | ['{RED ACTED}'] | |
134 | functi on getHash Text: stri ng; | |
135 | functi on getDate TimeSigned : string; | |
136 | functi on getSign ature: str ing; | |
137 | ||
138 | proced ure setHas hText(cons t aValue: string); | |
139 | proced ure setDat eTimeSigne d(const aV alue: stri ng); | |
140 | proced ure setSig nature(con st aValue: string); | |
141 | ||
142 | proced ure LoadSi gnature(co nst aValue : TStringL ist); | |
143 | ||
144 | proper ty DataStr ing: strin g read get HashText w rite setHa shText; | |
145 | proper ty DateTim eSigned: s tring read getDateTi meSigned w rite setDa teTimeSign ed; | |
146 | proper ty Signatu re: string read getS ignature w rite setSi gnature; | |
147 | end; | |
148 | ||
149 | const | |
150 | Version = '1.0.2.1 '; | |
151 | ||
152 | PKI_VERS ION = 1; | |
153 | ||
154 | PKI_PIN_ RESULT: ar ray [TPKIP INResult] of string = ('OK', ' PIN Cancel ed', 'Card Locked', 'PIN Error '); | |
155 | ||
156 | PKI_PIN_ MESSAGE: a rray [TPKI PINResult] of string = ('OK', 'User canc eled signi ng.', 'Use r card is locked.', 'PIN Error '); | |
157 | ||
158 | PKI_SAN_ LINK_RESUL T: array [ TPKISANLin k] of stri ng = ('OK' , 'Blank v alue in Vi stA', 'Vis tA and PIV card valu es do not match', 'N o certific ate found on the car d', 'Error getting S AN from Vi stA', 'Unk nown syste m error'); | |
159 | ||
160 | PKI_ENGI NE_VERSION = '1.0.0. 1'; | |
161 | ||
162 | PKI_HASH _ALGORITHM : array [T PKIHashAlg orithm] of string = ('SHA1RSA' , 'SHA256R SA', 'SHA3 84RSA', 'S HA512RSA') ; | |
163 | ||
164 | // PKI_A CTIVE_CLIE NT = 'Acti vClient Cr yptographi c Service Provider'; Removed, using regi stry value | |
165 | ||
166 | PKI_ACTI VE_CLIENT_ TYPE = 1; // Should probably j ust use PR OV_RSA_FUL L from the wcrypt2.p as file in stead | |
167 | ||
168 | PKI_SCAR D_S_SUCCES S = 0; | |
169 | ||
170 | PKI_PROV IDER_TYPE = PROV_RSA _AES; // S hould prob ably just use PROV_R SA_AES in the engine to keep i t clean | |
171 | ||
172 | PKI_ENCO DING_TYPE = PKCS_7_A SN_ENCODIN G or X509_ ASN_ENCODI NG; // <-- OR of WCr ypt2.pas c onstants | |
173 | ||
174 | DLG_8980 2000 = '89 802000^Ord er text to be signed is empty. '; | |
175 | ||
176 | DLG_8980 2001 = '89 802001^Use r''s DEA # is missin g.'; | |
177 | ||
178 | DLG_8980 2002 = '89 802002^Dru g Schedule is missin g.'; | |
179 | ||
180 | DLG_8980 2003 = '89 802003^No Cert with a valid da te found.' ; | |
181 | ||
182 | DLG_8980 2004 = '89 802004^Val id Certifi cate was n ot found.' ; | |
183 | ||
184 | DLG_8980 2005 = '89 802005^Cou ldn''t loa d CSP.'; | |
185 | ||
186 | DLG_8980 2006 = '89 802006^Sma rt Card Re ader not f ound.'; | |
187 | ||
188 | DLG_8980 2007 = '89 802007^Cer t with DEA # not fou nd.'; | |
189 | ||
190 | DLG_8980 2008 = '89 802008^The Cert was not valid for the Dr ug Schedul e.'; | |
191 | ||
192 | DLG_8980 2009 = '89 802009^Sig nature Che ck failed (Invalid S ignature). '; | |
193 | ||
194 | DLG_8980 2010 = '89 802010^Err or reporte d by the C rypto API: '; | |
195 | { | |
196 | DLG_89 802010 is the genera l error th at is a ca tch all fo r several problems. | |
197 | Things that IRM should loo k at if us er reporti ng getting this erro r. | |
198 | 1. See that the PKIserver. exe routin e is insta lled on th e server | |
199 | in the WINNT\sys tem32 dire ctory. | |
200 | 2. See that the PKIserver. exe routin e has been registere d with | |
201 | window s. | |
202 | 3. See that in A dministrat or tools>s ervices th at PKIServ ice has a | |
203 | status of STARTE D and its Startup Ty pe is Auto matic. | |
204 | } | |
205 | ||
206 | DLG_8980 2011 = '89 802011^Cer tificate C hain not v alid.'; | |
207 | ||
208 | DLG_8980 2012 = '89 802012^Car d must be unlocked b efore link ing.'; | |
209 | ||
210 | DLG_8980 2013 = '89 802013^Err or validat ing PIN, a ccount lin kage cance led.'; | |
211 | ||
212 | DLG_8980 2014 = '89 802014^Una ble to sig n without valid PIN entry.'; | |
213 | ||
214 | DLG_8980 2015 = '89 802015^Cor rupted (De code failu re).'; | |
215 | ||
216 | DLG_8980 2016 = '89 802016^Cor rupted (Ha sh mismatc h).'; | |
217 | ||
218 | DLG_8980 2017 = '89 802017^Cer tificate r evoked.'; | |
219 | ||
220 | DLG_8980 2018 = '89 802018^Dig ital signa ture verif ication fa iled.'; | |
221 | ||
222 | DLG_8980 2019 = '89 802019^Bef ore the ce rtificate effective date.'; | |
223 | ||
224 | DLG_8980 2020 = '89 802020^Thi s certific ate or one of the ce rtificates in the ce rtificate chain is n ot time-va lid.'; | |
225 | ||
226 | DLG_8980 2021 = '89 802021^PIV card cann ot be link ed without the prope r PIN.'; | |
227 | ||
228 | DLG_8980 2022 = '89 802022^Doe s not have valid sig nature.'; | |
229 | ||
230 | DLG_8980 2023 = '89 802023^Cer tificate t rust is no t properly time-nest ed.'; | |
231 | ||
232 | DLG_8980 2024 = '89 802024^Cer tificate n ot valid i n it''s pr oposed usa ge.'; | |
233 | ||
234 | DLG_8980 2025 = '89 802025^The certifica te or cert ificate ch ain is bas ed on an u ntrusted r oot.'; | |
235 | ||
236 | DLG_8980 2026 = '89 802026^The revocatio n status o f the cert ificate or one of th e certific ates in th e certific ate chain is unknown .'; | |
237 | ||
238 | DLG_8980 2027 = '89 802027^One of the ce rtificates in the ch ain was is sued by a certificat ion author ity that t he origina l certific ate had ce rtified.'; | |
239 | ||
240 | DLG_8980 2028 = '89 802028^The certifica te chain i s not comp lete.'; | |
241 | ||
242 | DLG_8980 2029 = '89 802029^The certifica te or one of the cer tificates in the cer tificate c hain does not have a valid sig nature.'; | |
243 | ||
244 | DLG_8980 2030 = '89 802030^The certifica te or cert ificate ch ain is not valid in its propos ed usage.' ; | |
245 | ||
246 | DLG_8980 2031 = '89 802031^Una ble to acc ess encryp tion data via IPKIEn cryptionDa taEx Inter face.'; | |
247 | ||
248 | DLG_8980 2032 = '89 802032^Tru st for thi s certific ate or one of the ce rtificates in the ce rtificate chain has been revok ed.'; | |
249 | ||
250 | DLG_8980 2033 = '89 802033^Err or getting name valu e from cer tificate.' ; | |
251 | ||
252 | DLG_8980 2034 = '89 802034^Err or establi shing cont ext with t he card re ader.'; | |
253 | ||
254 | DLG_8980 2035 = '89 802035^Car d reader n ot ready o r card not inserted properly.' ; | |
255 | ||
256 | DLG_8980 2036 = '89 802036^Err or reporte d by the P KIServiceE ngine: '; | |
257 | ||
258 | DLG_8980 2037 = '89 802037^Inv alid Filem an DateTim e Conversi on.'; | |
259 | ||
260 | DLG_8980 2038 = '89 802038^Not marked as DEA Order .'; | |
261 | ||
262 | DLG_8980 2039 = '89 802039^DEA Orders ca n only be initialize d via indi vidual pro perty valu es.'; | |
263 | ||
264 | DLG_8980 2040 = '89 802040^Use r canceled connectio n.'; | |
265 | ||
266 | DLG_8980 2041 = '89 802041^Una ble to ret rieve SAN from card. '; | |
267 | ||
268 | DLG_8980 2042 = '89 802042^Con nection no t establis hed.'; | |
269 | ||
270 | DLG_8980 2043 = '89 802043^Use r must hav e the XU E PCS EDIT D ATA contex t option i n their me nu tree.'; | |
271 | ||
272 | DLG_8980 2044 = '89 802044^You cannot us e this app lication i f you hold the ORES key.'; | |
273 | ||
274 | DLG_8980 2045 = '89 802045^You must hold the XUEPC SEDIT key to use thi s applicat ion.'; | |
275 | ||
276 | DLG_8980 2046 = '89 802046^Sub ject Alter nate Name (SAN) on c ard and in VistA do not Match. '; | |
277 | ||
278 | DLG_8980 2047 = '89 802047^Err or communi cating wit h VistA vi a the RPC Broker Con nection.'; | |
279 | ||
280 | DLG_8980 2048 = '89 802048^Vis tA Subject Alternate Name (SAN ) is blank .'; | |
281 | ||
282 | DLG_8980 2049 = '89 802049^Una ble to upd ate VistA Subject Al ternate Na me (SAN).' ; | |
283 | ||
284 | DLG_8980 2050 = '89 802050^PKI Server Sta tus: '; | |
285 | ||
286 | { Interf ace Factor ies and Ot her Utilit ies } | |
287 | procedure NewPKIEncr yptionData (var aPKIE ncryptionD ata: IPKIE ncryptionD ata); | |
288 | procedure NewPKIEncr yptionData DEAOrder(v ar aPKIEnc ryptionDat aDEAOrder: IPKIEncry ptionDataD EAOrder); | |
289 | procedure NewPKIEncr yptionEngi ne(aRPCBro ker: TRPCB roker; var aPKIEncry ptionEngin e: IPKIEnc ryptionEng ine); | |
290 | procedure NewPKIEncr yptionSign ature(var aPKIEncryp tionSignat ure: IPKIE ncryptionS ignature); | |
291 | ||
292 | procedure TDateTime2 FMDateTime (const aTD ateTime: T DateTime; var aFMDat eTime: str ing; aIncl udeTime: b oolean = T rue; aIncl udeSeconds : boolean = True); | |
293 | procedure FMDateTime 2TDateTime (const aFM DateTime: string; va r aDateTim e: TDateTi me); | |
294 | procedure GetPINValu e(var aPin Value: str ing); | |
295 | ||
296 | function G etLastSyst emError: s tring; | |
297 | function I sDigitalSi gnatureAva ilable(aPK IEncryptio nEngine: I PKIEncrypt ionEngine; var aMess age: strin g; aSucces sfulLinkMe ssage: str ing = ''): boolean; | |
298 | function V erifyPKIPI N(aPKIEncr yptionEngi ne: IPKIEn cryptionEn gine): TPK IPINResult ; | |
299 | function D ialogAsMes sage(aDial og: string ): string; | |
300 | ||
301 | implementa tion | |
302 | ||
303 | uses | |
304 | VAUtils, | |
305 | System.U ITypes, | |
306 | fPKIPINP rompt, | |
307 | oPKIEncr yptionEngi ne, | |
308 | oPKIEncr yptionData , | |
309 | oPKIEncr yptionData DEAOrder, | |
310 | oPKIEncr yptionSign ature; | |
311 | ||
312 | const | |
313 | SAN_LINK _NEEDED = | |
314 | 'Your VistA acco unt has no t been lin ked to thi s PIV card .' + #13#1 0 + | |
315 | 'Would you like to link th is PIV car d now?'; | |
316 | ||
317 | SAN_LINK _SUCCESS = | |
318 | 'Your PIV card ( %s) has be en success fully link ed' + #13# 10 + | |
319 | 'to yo ur VistA a ccount, wh ich will a llow you t o digitall y sign.'; | |
320 | ||
321 | SAN_LINK _FAILURE = | |
322 | '%s' + #13#10 + | |
323 | 'VistA was not a ble to lin k this PIV card to y our accoun t.' + #13# 10 + | |
324 | 'One p ossible ca use is tha t your car d is alrea dy linked to another VistA acc ount.'; | |
325 | ||
326 | { Factor ies } | |
327 | ||
328 | procedure NewPKIEncr yptionEngi ne(aRPCBro ker: TRPCB roker; var aPKIEncry ptionEngin e: IPKIEnc ryptionEng ine); | |
329 | begin | |
330 | TPKIEncr yptionEngi ne.Create( aRPCBroker ).GetInter face(IPKIE ncryptionE ngine, aPK IEncryptio nEngine); | |
331 | end; | |
332 | ||
333 | procedure NewPKIEncr yptionData (var aPKIE ncryptionD ata: IPKIE ncryptionD ata); | |
334 | begin | |
335 | TPKIEncr yptionData .Create.Ge tInterface (IPKIEncry ptionData, aPKIEncry ptionData) ; | |
336 | end; | |
337 | ||
338 | procedure NewPKIEncr yptionData DEAOrder(v ar aPKIEnc ryptionDat aDEAOrder: IPKIEncry ptionDataD EAOrder); | |
339 | begin | |
340 | TPKIEncr yptionData DEAOrder.C reate.GetI nterface(I PKIEncrypt ionDataDEA Order, aPK IEncryptio nDataDEAOr der); | |
341 | end; | |
342 | ||
343 | procedure NewPKIEncr yptionSign ature(var aPKIEncryp tionSignat ure: IPKIE ncryptionS ignature); | |
344 | begin | |
345 | TPKIEncr yptionSign ature.Crea te.GetInte rface(IPKI Encryption Signature, aPKIEncry ptionSigna ture); | |
346 | end; | |
347 | ||
348 | { Utilitie s } | |
349 | ||
350 | function G etLastSyst emError: s tring; | |
351 | begin | |
352 | Result : = Format(' %s x%8x: % s', [DLG_8 9802010, G etLastErro r, SysErro rMessage(G etLastErro r)]); | |
353 | end; | |
354 | ||
355 | function D ialogAsMes sage(aDial og: string ): string; | |
356 | begin | |
357 | Result : = Copy(aDi alog, 1, P os('^', aD ialog) - 1 ) + | |
358 | ': ' + | |
359 | Copy(a Dialog, Po s('^', aDi alog) + 1, Length(aD ialog)); | |
360 | end; | |
361 | ||
362 | procedure TDateTime2 FMDateTime (const aTD ateTime: T DateTime; var aFMDat eTime: str ing; aIncl udeTime: b oolean = T rue; aIncl udeSeconds : boolean = True); | |
363 | var | |
364 | aYear, a Month, aDa y: Word; | |
365 | aHour, a Minute, aS econd, aMi lliSecond: Word; | |
366 | begin | |
367 | DecodeDa te(aTDateT ime, aYear , aMonth, aDay); | |
368 | aFMDateT ime := Int ToStr(aYea r - 1700) + Format(' %.2d', [aM onth]) + F ormat('%.2 d', [aDay] ); | |
369 | if aIncl udeTime th en | |
370 | begin | |
371 | Deco deTime(aTD ateTime, a Hour, aMin ute, aSeco nd, aMilli Second); | |
372 | aFMD ateTime := aFMDateTi me + '.' + Format('% .2d', [aHo ur]) + For mat('%.2d' , [aMinute ]); | |
373 | if a IncludeSec onds then | |
374 | aF MDateTime := aFMDate Time + For mat('%.2d' , [aSecond ]); | |
375 | end; | |
376 | while (L ength(aFMD ateTime) > 7) and (( Copy(aFMDa teTime, Le ngth(aFMDa teTime), 1 ) = '0') o r (Copy(aF MDateTime, Length(aF MDateTime) , 1) = '.' )) do | |
377 | aFMDat eTime := C opy(aFMDat eTime, 1, Length(aFM DateTime) - 1); | |
378 | end; | |
379 | ||
380 | procedure FMDateTime 2TDateTime (const aFM DateTime: string; va r aDateTim e: TDateTi me); | |
381 | var | |
382 | aFMDateS tring: str ing; | |
383 | aYear, a Month, aDa y: Word; | |
384 | aHour, a Minute, aS econd: Wor d; | |
385 | begin | |
386 | try | |
387 | aDateT ime := 0; | |
388 | aFMDat eString := Format('% 0.6f', [St rToFloat(a FMDateTime ) + 0.0000 001]); | |
389 | aYear := StrToIn tDef(Copy( aFMDateStr ing, 1, 3) , -1); | |
390 | if aYe ar > 0 the n | |
391 | inc( aYear, 170 0); | |
392 | aMonth := StrToI ntDef(Copy (aFMDateSt ring, 4, 2 ), -1); | |
393 | aDay : = StrToInt Def(Copy(a FMDateStri ng, 6, 2), -1); | |
394 | ||
395 | aHour := StrToIn tDef(Copy( aFMDateStr ing, 9, 2) , 0); | |
396 | aMinut e := StrTo IntDef(Cop y(aFMDateS tring, 11, 2), 0); | |
397 | aSecon d := StrTo IntDef(Cop y(aFMDateS tring, 13, 2), 0); | |
398 | ||
399 | aDateT ime := Enc odeDate(aY ear, aMont h, aDay) + EncodeTim e(aHour, a Minute, aS econd, 0); | |
400 | except | |
401 | raise EPKIEncryp tionError. Create(DLG _89802037 + aFMDateT ime); | |
402 | end; | |
403 | end; | |
404 | ||
405 | function V erifyPKIPI N(aPKIEncr yptionEngi ne: IPKIEn cryptionEn gine): TPK IPINResult ; | |
406 | begin | |
407 | Result : = prOK; | |
408 | //Result := TfrmPK IPINPrompt .VerifyPKI PIN(aPKIEn cryptionEn gine); | |
409 | end; | |
410 | ||
411 | procedure GetPINValu e(var aPin Value: str ing); | |
412 | begin | |
413 | aPinValu e := TfrmP KIPINPromp t.GetPINVa lue; | |
414 | end; | |
415 | ||
416 | function I sDigitalSi gnatureAva ilable(aPK IEncryptio nEngine: I PKIEncrypt ionEngine; var aMess age: strin g; aSucces sfulLinkMe ssage: str ing = ''): boolean; | |
417 | { Does the prelimina ry work of verifying the card is ready a nd the SAN linkage i s correct } | |
418 | var | |
419 | aSuccess Message: s tring; | |
420 | begin | |
421 | try | |
422 | while not aPKIEn cryptionEn gine.IsCar dReaderRea dy do | |
423 | begi n | |
424 | if ShowMsg(' Please ins ert your P IV card or press can cel to exi t.', 'Card Reader No t Ready', smiInfo, s mbRetryCan cel) <> sm rRetry the n | |
425 | raise EPKI Encryption Error.Crea te(DLG_898 02035); | |
426 | Sl eep(4000); // Painfu l but the card will need time to synch u p | |
427 | end; | |
428 | ||
429 | case a PKIEncrypt ionEngine. SANLink of | |
430 | slOK : // Good To Go! | |
431 | be gin | |
432 | aMessage : = 'OK'; | |
433 | en d; | |
434 | ||
435 | slBl ankVistA: // Offer t o Update t he SAN in VistA, oth erwise bai l with exc eption | |
436 | be gin | |
437 | if ShowMsg (SAN_LINK_ NEEDED, 'L ink PIV Ca rd', smiQu estion, sm bYesNo) = smrYes the n | |
438 | try | |
439 | aPKIEn cryptionEn gine.LinkS ANtoVistA; // This w ill raise an excepti on if it f ails, othe rwise upda te is good | |
440 | ||
441 | // Bui ld default success m essage | |
442 | aSucce ssMessage := Format( SAN_LINK_S UCCESS, [a PKIEncrypt ionEngine. VistAUserN ame]); | |
443 | ||
444 | // if aSuccessfu lLinkMessa ge has tex t, append it to the success me ssage | |
445 | if aSu ccessfulLi nkMessage <> '' then | |
446 | aSuc cessMessag e := aSucc essMessage + #13#10 + aSuccess fulLinkMes sage; | |
447 | ||
448 | // Rep ort the su ccessful l inking | |
449 | ShowMs g(aSuccess Message, ' Successful ly Linked' , smiInfo, smbOK); | |
450 | except | |
451 | raise EPKIEncryp tionError. CreateFmt( SAN_LINK_F AILURE, [a PKIEncrypt ionEngine. VistAUserN ame]); | |
452 | end | |
453 | else | |
454 | raise EP KIEncrypti onError.Cr eate(DLG_8 9802048); | |
455 | en d; | |
456 | ||
457 | slMi sMatch: // Both name s exist bu t are diff erent (Non -Case Sens itive matc h used) | |
458 | ra ise EPKIEn cryptionEr ror.Create (DLG_89802 046); | |
459 | ||
460 | slNo CertFound: // Proble m finding the cert o n the card , SAN is r eturned bl ank | |
461 | ra ise EPKIEn cryptionEr ror.Create (DLG_89802 041); | |
462 | else | |
463 | rais e EPKIEncr yptionErro r.Create(D LG_8980204 1); | |
464 | end; | |
465 | ||
466 | aMessa ge := 'OK' ; | |
467 | Result := True; | |
468 | except | |
469 | on E: Exception do | |
470 | begi n | |
471 | Re sult := Fa lse; | |
472 | aM essage := E.Message; | |
473 | end; | |
474 | end; | |
475 | end; | |
476 | ||
477 | end. |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.