83. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 10/18/2017 11:37:30 AM 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.

83.1 Files compared

#	Location	File	Last Modified
1	OSCIF_CPRS v32 Phase 2 Build 2OR3.0405_August_2017.zip\OR_30_405V36_SRC.zip\XE8\Broker\Source	Wsockc.pas	Wed Oct 11 20:08:07 2017 UTC
2	OSCIF_CPRS v32 Phase 2 Build 2OR3.0405_August_2017.zip\OR_30_405V36_SRC.zip\XE8\Broker\Source	Wsockc.pas	Tue Oct 17 19:58:08 2017 UTC

83.2 Comparison summary

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

83.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

83.4 Active regular expressions

No regular expressions were active.

83.5 Comparison detail

	1	{ ****** ****** ****** ****** ****** ****** **
	2	Pa ckage: XWB - Kernel RPCBroker
	3	Da te Created : Sept 18, 1997 (Ver sion 1.1)
	4	Si te Name: O akland, OI Field Off ice, Dept of Veteran Affairs
	5	De velopers: PII, PII, PII, PII,
	6	PII
	7	De scription: Contains TRPCBroker and relat ed compone nts.
	8	Unit: Ws ockc manag es WinSock connectio ns and cre ates/parse s messages .
	9	Cu rrent Rele ase: Versi on 1.1 Pat ch 65
	10	******** ****** ****** ****** ****** ****** * }
	11
	12	{ ****** ****** ****** ****** ******
	13	Changes in v1.1.65 (HGW 06/2 3/2016) XW B1.165
	14	1. Added error XWB _BadToken for SSOi t esting.
	15	2. Repla ced some A nsiString variables with Strin g variable s to resol ve
	16	type casting wa rnings.
	17
	18	Changes in v1.1.60 (HGW 11/1 9/2014) XW B1.160
	19	1. Fixed data type for varia ble pLocal name
	20	2. Updat ed version 'BrokerVe r'
	21	3. Updat ed error t ext for Wi nSock mess ages
	22	4. Symbo l 'AnsiStr Alloc' is deprecated in Delphi XE4, move d to the A nsiStrings
	23	unit.
	24	5. Symbo l 'StrDisp ose' is de precated i n Delphi X E4, moved to the Ans iStrings
	25	unit.
	26	6. Symbo l 'StrLen' is deprec ated in De lphi XE4, moved to t he AnsiStr ings unit.
	27	7. Symbo l 'StrNew' is deprec ated in De lphi XE4, moved to t he AnsiStr ings unit.
	28	8. Symbo l 'StrPas' is deprec ated in De lphi XE4, moved to t he AnsiStr ings unit.
	29	9. Upgra ded from W inSock 1.1 to WinSoc k 2.2
	30	10. Remo ved blocki ng hook fu nctions no t supporte d in WinSo ck 2.2
	31	11. Comb ined redun dant code in NetStar t and NetS tart1 into single fu nction
	32	NetS tart for I Pv4/IPv6-d ual stack connection s.
	33	12. Adde d data str uctures an d function definitio ns missing or incomp lete for
	34	Delp hi XE4 and XE5 imple mentation of WinSock 2.2 and I Pv6.
	35	13. Wrap ped a numb er of Wind ows APIs t o be used with the u pdated dat a
	36	stru ctures. Ca lling them from Delp hi Winapi. Winsock2 R TL caused error for
	37	form at of pass ed paramet ers.
	38	14. Made IPv6 chan ges in Net Start requ ired by Mi crosoft:
	39	a. Us ed WSAConn ectByName to establi sh a conne ction to a VistA ser ver given
	40	a host name and port. IPv6 was n ot working with Delp hi Winsock 2 RTL due
	41	to variable type defin itions. Wr apper func tion FWSAC onnectByNa me created .
	42	b. Re placed get hostbyname function calls with calls to getaddrinf o Windows
	43	So ckets func tion. Not included i n Delphi W insock2 RT L. Wrapper function
	44	FG etAddrInfo created.
	45	15. Depr ecated old -style bro ker which called bac k to clien t on a dif ferent
	46	port . VistA wi ll continu e to suppo rt the old -style bro ker for le gacy
	47	appl ications, but it is no longer supported in new ver sions of t he BDK.
	48	16. Reso lved vario us compile r warnings regarding data type casting t o
	49	prev ent buffer overruns (potential security issue).
	50
	51	Changes in v1.1.50 (JLI 6/24 /2008) XWB 1.150
	52	1. Remed y ticket I NC886661 f ix returne d error te xt that wa s illegibl e with
	53	chang es to func tion TXWBW insock.Get ServerPack et (Remedy ticket do cumentatio n
	54	inclu ded in pat ch 60 patc h descript ion).
	55
	56	Changes in v1.1.13 (JLI 8/23 /2000) XWB 1.113
	57	1. Made changes to cursor de pendent on current c urson bein g crDefaul t so
	58	that the applic ation can set it to a differen t cursor f or long or
	59	repea ted proces ses withou t the curs or 'flashi ng' repeat edly.
	60
	61	Changes in v1.1.8 (REM 6/18/ 1999) XWB* 1.1*8
	62	1. Updat e version 'BrokerVer '
	63
	64	Changes in v1.1.6 (DPC 6/7/1 999) XWB1 .16
	65	1. In tC all functi on, made c hanging cu rsor to ho urglass co nditional:
	66	don't do it if XWB IM HER E RPC is being invo ked.
	67
	68	Changes in v1.1.4 (DCM 9/18/ 1998) XWB* 1.1*4
	69	1. Chang ed the ine t_addr lin e in NetSt art to lon gint. Reas on: true 6 4 bit
	70	types in Delphi 4
	71	2. Chang ed the hSo cket line in NetStar t to @. Re ason: inco mpatible t ypes
	72	when recompilin g
	73	3. In Ne tStop, if socket <= 0, restore the defau lt cursor. Reason: g ave the
	74	impre ssion of a busy proc ess after the Kernel login pro cess times out.
	75	******** ****** ****** ****** ******** }
	76
	77	unit Wsock c;
	78	{******* ****** ****** ****** ****** ****** ******
	79	This imp lementatio n allows c ommunicati ons betwee n Delphi f orms and
	80	VistA se rvers thro ugh the us e of the V istA RPC B roker.
	81
	82	Usage: P ut Wsockc in your Us es clause of your De lphi form. See addi tional
	83	specs fo r RPC Brok er message formats.
	84	Programm er: Enriqu e Gomez - VA San Fra ncisco ISC - April 1 995
	85	******** ****** ****** ****** ****** ****** *****}
	86
	87	//p60 - Ex plicitly d efine mini mum Window s version, required by Windows API getad drinfo
	88	{$DEFINE M INWINXP}
	89
	90	interface
	91
	92	uses
	93	{System}
	94	AnsiStri ngs, SysUt ils, Class es, StrUti ls,
	95	{WinApi}
	96	Windows, WinTypes, WinProcs, WinSock2, //p60 Upg raded from WinSock 1 .1 to WinS ock 2.2
	97	{VA}
	98	XWBut1, Trpcb, Rpc bErr,
	99	{Vcl}
	100	Dialogs, Forms, Co ntrols, St dCtrls, Cl ipBrd;
	101
	102	const
	103	OneSecon d = 0.0000 11574;
	104	WS2_32_L IB = 'ws2_32.dl l'; // W indows Win sock 2.2 A PI source
	105	WinSockV er = $0202; // W inSock Ver sion = 2.2
	106	AI_PASSI VE = $00000001; // S ocket addr ess will b e used in bind() cal l
	107	AI_CANON NAME = $00000002; // R eturn cano nical name in first ai_canonna me
	108	AI_NUMER ICHOST = $00000004; // N odename mu st be a nu meric addr ess string
	109	AI_NUMER ICSERV = $00000008; // S ervicename must be a numeric p ort number
	110	AI_ALL = $00000100; // Q uery both IPv6 and I Pv4 with A I_V4MAPPED
	111	AI_FQDN = $00020000; // R eturn the FQDN in ai _canonname
	112	AF_UNSPE C = 0; // I P version unspecifie d
	113	AF_INET = 2; // I Pv4
	114	AF_INET6 = 23; // I Pv6
	115	PF_INET = AF_INET; // I Pv4 protoc ol
	116	PF_INET6 = AF_INET6; // I Pv6 protoc ol
	117	IPV6_V6O NLY = 27; // U sed to set sockopt fo r IPv4/IPv 6 dual-sta ck
	118	DHCP_NAM E = 'BROKE RSERVER';
	119	M_DEBUG = True;
	120	M_NORMAL = False;
	121	BrokerVe r = '1.160 ';
	122	Buffer64 K = 65520;
	123	Buffer32 K = 32767;
	124	Buffer24 K = 24576;
	125	Buffer16 K = 16384;
	126	Buffer8K = 8192;
	127	Buffer4K = 4096;
	128	DefBuffe r = 256;
	129	DebugOn: boolean = False;
	130	XWBBASEE RR = {WSAB ASEERR + 1 } 20000;
	131	//Broker Applicati on Error C onstants
	132	XWB_NO_H EAP = XWBBASE ERR + 1;
	133	XWB_M_RE JECT = XWBBASE ERR + 2;
	134	XWB_BadS ignOn = XWBBASE ERR + 4;
	135	XWB_BadR eads = XWBBASE ERR + 8;
	136	XWB_ExeN oMem = XWBBASE ERR + 100;
	137	XWB_ExeN oFile = XWB_Exe NoMem + 2 ;
	138	XWB_ExeN oPath = XWB_Exe NoMem + 3 ;
	139	XWB_ExeS hare = XWB_Exe NoMem + 5 ;
	140	XWB_ExeS epSeg = XWB_Exe NoMem + 6 ;
	141	XWB_ExeL oMem = XWB_Exe NoMem + 8 ;
	142	XWB_ExeW inVer = XWB_Exe NoMem + 10 ;
	143	XWB_ExeB adExe = XWB_Exe NoMem + 11 ;
	144	XWB_ExeD ifOS = XWB_Exe NoMem + 12 ;
	145	XWB_RpcN otReg = XWBBASE ERR + 201;
	146
	147	type
	148	//WinSoc k2 IPv4/IP v6 data ty pes that a re inadequ ately or i ncompletel y
	149	//define d in Delph i XE4 and XE5 Winapi .Winsock2 Run Time L ibrary.
	150	TSocket = Cardinal ;
	151	in6_addr = record // in6_addr ( IPv6)
	152	case B yte of
	153	0: ( u6_addr8 : array[0. .15] of By te);
	154	1: ( u6_addr16 : array[0. .7] of Wor d);
	155	end;
	156	TIn6_Add r = in6_ad dr;
	157	PIn6_Add r = ^in6_a ddr;
	158	//Struct ured type definition sockaddr storage fo r IPv4 or IPv6
	159	SockAddr = record
	160	case u _short of //u_s hort is a Word bound ary (2-byt e integer SmallInt)
	161	0: ( sa_family : u_sho rt; //g eneric soc kaddr stru cture
	162	sa_data : array [0..13] of AnsiChar) ;
	163	1: ( sin_family : short ; //IPv 4 sockaddr _in struct ure
	164	sin_port : u_sho rt;
	165	sin_addr : in_ad dr;
	166	sin_zero : array [0..7] of AnsiChar);
	167	2: ( sin6_famil y : short ; //IPv 6 sockaddr _in6 struc ture
	168	sin6_port : u_sho rt;
	169	sin6_flowi nfo: u_lon g;
	170	sin6_addr : in6_a ddr;
	171	sin6_scope _id: u_lon g);
	172	end;
	173	TSockAdd r = SockAd dr;
	174	PSockAdd r = ^TSock Addr;
	175	LPSOCKAD DR = ^TSoc kAddr;
	176	PAddrInf o = ^TAddr Info; // to supp ort functi on FGetAdd rInfo
	177	TAddrInf o = record
	178	ai_fla gs: Intege r;
	179	ai_fam ily: Integ er;
	180	ai_soc ktype: Int eger;
	181	ai_pro tocol: Int eger;
	182	ai_add rlen: Card inal;
	183	ai_can onname: PA nsiChar;
	184	ai_add r: PSockAd dr;
	185	ai_nex t: PAddrIn fo;
	186	end;
	187
	188	TXWBWins ock = clas s(TObject)
	189	private
	190	FCount Width: Int eger;
	191	public
	192	XNetCa llPending: Boolean;
	193	xFlush : Boolean;
	194	Socket Error: Int eger;
	195	XHookT imeOut: In teger;
	196	XNetTi merStart: TDateTime;
	197	BROKER SERVER: St ring;
	198	Securi tySegment: String;
	199	Applic ationSegme nt: String ;
	200	IsConn ected: Boo lean;
	201	IPprot ocol: Inte ger; //p65 - I Pv4=4, IPv 6=6, defau lt=0
	202	functi on NetCall (hSocket: TSocket; i msg: Strin g): PChar;
	203	functi on tCall(h Socket: TS ocket; api , apVer: S tring; Par ameters: T Params;
	204	var Sec , App: PCh ar; TimeOu t: integer ): PChar;
	205	functi on cRight( z: PChar; n: longi nt): PChar ;
	206	functi on cLeft( z: PChar; n: longint ): PChar;
	207	functi on BuildAp i ( n,p: s tring; f: longint): string;
	208	functi on BuildHd r ( wkid: string; wi nh: string ; prch: st ring;
	209	wish: s tring): st ring;
	210	functi on BuildPa r(hSocket: TSocket; api, RPCVe r: string;
	211	const P arameters: TParams): string;
	212	functi on StrPack (n: strin g; p: inte ger): stri ng;
	213	functi on VarPack (n: string ): string;
	214	functi on NetStar t(Foregrou ndM: boole an; Server : string; ListenerPo rt: intege r;
	215	var hSo cket: TSoc ket): inte ger;
	216	functi on Network Connect(Fo regroundM: boolean; Server: st ring; List enerPort,
	217	TimeOut : integer) : Integer;
	218	functi on libNetC reate (lpW SData : TW SAData): i nteger;
	219	functi on libNetD estroy: in teger;
	220	functi on GetServ erPacket(h Socket: TS ocket): st ring;
	221	proced ure Networ kDisconnec t(hSocket: TSocket);
	222	proced ure NetSto p(hSocket: TSocket);
	223	proced ure CloseS ockSystem( hSocket: T Socket; s: string);
	224	proced ure NetErr or(Action: string; E rrType: in teger);
	225	constr uctor Crea te;
	226	proper ty CountWi dth: Integ er read FC ountWidth write FCou ntWidth;
	227	end;
	228
	229	function LPack(Str : String; NDigits: I nteger): S tring;
	230	function SPack(Str : String): String;
	231	function FAddrToSt ring(Addr: TSockAddr ): String;
	232	function FGetAddrI nfo(nodena me,servnam e: PAnsiCh ar; phints : PAddrInf o;
	233	out res: PAddrInfo) : Integer; stdcall;
	234	external WS2_32_LIB name 'get addrinfo'; //p60 Win dows funct ion wrappe r
	235	function FWSAConne ctByName(c onst s: TS ocket; Nod eName, Ser viceName: PAnsiChar;
	236	var Local AddressLen gth: Cardi nal; var L ocalAddres s: TSockAd dr;
	237	var Remot eAddressLe ngth: Card inal; var RemoteAddr ess: TSock Addr;
	238	const tim eout: time val; Reser ved: LPWSA OVERLAPPED ): LongBoo l; stdcall ;
	239	external WS2_32_LIB name 'WSA ConnectByN ameA'; //p 60 Windows function wrapper
	240	function Fconnect( s: TSocket ; var name : TSockAdd r; namelen : Integer) : Integer; stdcall;
	241	external WS2_32_LIB name 'con nect'; //p 60 Windows function wrapper
	242	function Fgetsockn ame(s: TSo cket; var name: TSoc kAddr; var namelen: Integer): Integer; s tdcall;
	243	external WS2_32_LIB name 'get sockname'; //p60 Win dows funct ion wrappe r
	244	function Fbind(s: TSocket; v ar name: T SockAddr; namelen: I nteger): I nteger; st dcall;
	245	external WS2_32_LIB name 'bin d'; //p60 Windows fu nction wra pper
	246
	247
	248	var
	249	HookTime Out: Integ er;
	250	NetCallP ending: Bo olean;
	251	NetTimer Start: TDa teTime;
	252
	253	implementa tion
	254
	255	uses
	256	{VA}
	257	fDebugIn fo;
	258
	259	{--------- ---------- ---- LPack --------- ---------- ---------- ----
	260	---------- ---------- ---------- ---------- ---------- ---------- ----}
	261	function L Pack(Str: String; ND igits: Int eger): Str ing;
	262	var
	263	r: Integ er;
	264	t: Strin g;
	265	Width: I nteger;
	266	Ex1: Exc eption;
	267	begin
	268	r := Len gth(Str);
	269	// check for enoug h space in NDigits c haracters
	270	t := Int ToStr(r);
	271	Width := Length(t) ;
	272	if NDigi ts < Width then
	273	begin
	274	Ex1 := Exception .Create('I n generati on of mess age to ser ver, call to LPack w here Lengt h of strin g of '+Int ToStr(Widt h)+' chars exceeds n umber of c hars for o utput leng th ('+IntT oStr(NDigi ts)+')');
	275	Raise Ex1;
	276	end; //i f
	277	t := '00 0000000' + IntToStr( r); {e g 11-1-96}
	278	Result : = Copy(t, length(t)- (NDigits-1 ),length(t )) + Str;
	279	end; //fun ction LPac k
	280
	281
	282	{--------- ---------- ---- SPack --------- ---------- ---------- ----
	283	Prepends t he length of the str ing in one byte to t he value o f Str,
	284	thus Str m ust be les s than 256 character s.
	285	e.g., SP ack('DataV alue')
	286	returns #9 + 'Da taValue'
	287	---------- ---------- ---------- ---------- ---------- ---------- ----}
	288	function S Pack(Str: String): S tring;
	289	var
	290	r: Integ er;
	291	Ex1: Exc eption;
	292	begin
	293	r := Len gth(Str);
	294	// check for enoug h space in one byte
	295	if r > 2 55 then
	296	begin
	297	Ex1 := Exception .Create('I n generati on of mess age to ser ver, call to SPack w ith Length of string of '+IntT oStr(r)+' chars whic h exceeds max of 255 chars');
	298	Raise Ex1;
	299	end; //i f
	300	Result : = Char(r) + Str;
	301	end; //fun ction SPac k
	302
	303
	304	{--------- ---------- ---- FAddr ToString - ---------- ---------- ----
	305	Take IP ad dress in T SockAddr s tructure a nd return IPv4 or IP v6
	306	address in string fo rmat.
	307	---------- ---------- ---------- ---------- ---------- ---------- ----}
	308	function F AddrToStri ng(Addr: T SockAddr): String;
	309	var
	310	Str: Str ing;
	311	I: Integ er;
	312	begin
	313	Str := ' ';
	314	if Addr. sa_family = AF_INET6 then //a ddress is IPv6
	315	begin
	316	for I := 0 to 15 do
	317	begin
	318	Str := Str + I ntToHex(Ad dr.sin6_ad dr.u6_addr 8[I], 2);
	319	if ( Frac(I/2) > 0) and ( I < 15) th en
	320	St r := Str + ':';
	321	end;
	322	//if I Pv6 string is IPv4-m apped then set strin g to dotte d decimal IPv4
	323	if Ans iCompareTe xt(AnsiLef tStr(Str, 29), '0000 :0000:0000 :0000:0000 :FFFF') = 0 then
	324	begin
	325	Str := '';
	326	for I := 12 to 15 do
	327	begi n
	328	St r := Str + IntToStr( Addr.sin6_ addr.u6_ad dr8[I]);
	329	if I < 15 th en
	330	Str := Str + '.';
	331	end;
	332	end; / /if addres s is IPv4- mapped
	333	end //if address i s IPv6
	334	else //i f address is IPv4
	335	begin
	336	Str := IntToStr( Addr.sin_a ddr.S_un_b .s_b1) + ' .'
	337	+ IntToStr( Addr.sin_a ddr.S_un_b .s_b2) + ' .'
	338	+ IntToStr( Addr.sin_a ddr.S_un_b .s_b3) + ' .'
	339	+ IntToStr( Addr.sin_a ddr.S_un_b .s_b4);
	340	end; //i f address is IPv4
	341	Result : = Str;
	342	end; //fun ction FAdd rToString
	343
	344
	345	{--------- ---------- ---- TXWBW insock.lib NetCreate ---------- ----
	346	---------- ---------- ---------- ---------- ---------- ---------- ----}
	347	function T XWBWinsock .libNetCre ate (lpWSD ata : TWSA Data) : in teger;
	348	begin
	349	Result : = WSAStart up(WinSock Ver, lpWSD ata);
	350	end; //fun ction TXWB Winsock.li bNetCreat
	351
	352
	353	{--------- ---------- ---- TXWBW insock.lib NetDestroy --------- ----
	354	---------- ---------- ---------- ---------- ---------- ---------- ----}
	355	function T XWBWinsock .libNetDes troy :inte ger;
	356	begin
	357	WSAClean up; { -- shutd own TCP AP I};
	358	Result : = 1;
	359	end; //TXW BWinsock.l ibNetDestr oy
	360
	361
	362	{--------- ---------- ---- TXWBW insock.cRi ght ------ ---------- ----
	363	---------- ---------- ---------- ---------- ---------- ---------- ----}
	364	function T XWBWinsock .cRight;
	365	var
	366	i,t: lon gint;
	367	begin
	368	t := str len(z);
	369	if n < t then
	370	begin
	371	for i := 0 to n do
	372	z[i] := z[t-n+ i];
	373	z[n] : = chr(0);
	374	end; //i f
	375	cRight : = z;
	376	end; //fun ction TXWB Winsock.cR ight
	377
	378
	379	{--------- ---------- ---- TXWBW insock.cLe ft ------- ---------- ----
	380	---------- ---------- ---------- ---------- ---------- ---------- ----}
	381	function T XWBWinsock .cLeft;
	382	var
	383	t: longi nt;
	384	begin
	385	t := str len(z);
	386	if n > t then
	387	n := t ;
	388	z[n] := chr(0);
	389	cLeft := z;
	390	end; //fun ction TXBW insock.cLe ft
	391
	392
	393	{--------- ---------- ---- TXWBW insock.Bui ldApi ---- ---------- ----
	394	---------- ---------- ---------- ---------- ---------- ---------- ----}
	395	function T XWBWinsock .BuildApi ( n,p: Str ing; f: lo ngint): St ring;
	396	var
	397	x,s: Str ing;
	398	begin
	399	x := Int ToStr(f);
	400	s := Str Pack(p,5);
	401	result : = StrPack( x + n + '^ ' + s,5);
	402	end; //fun ction TXWB Winsock.Bu ildApi
	403
	404
	405	{--------- ---------- ---- TXWBW insock.Net workConnec t -------- ----
	406	---------- ---------- ---------- ---------- ---------- ---------- ----}
	407	function T XWBWinsock .NetworkCo nnect(Fore groundM: b oolean; Se rver: stri ng;
	408	Listener Port, Time Out: integ er): Integ er;
	409	var
	410	status: integer;
	411	hSocket: TSocket;
	412	begin
	413	xFlush : = False;
	414	IsConnec ted := Fal se;
	415	XHookTim eOut := Ti meOut;
	416	try
	417	begin
	418	//TODO - Impleme nt native SSL/TLS us ing Window s SChannel in Wsockc .NetStart
	419	status := NetSta rt(ForeGro undM, Serv er, Listen erPort, hS ocket);
	420	end; //t ry
	421	except
	422	on E: EBrokerErr or do
	423	begin
	424	rais e;
	425	end // do
	426	end; //e xcept
	427	if statu s = 0 then
	428	IsConn ected := T rue;
	429	Result : = hSocket; // return th e newly es tablished socket
	430	end; //fun ction TXWB Winsock.Ne tworkConne ct
	431
	432
	433	{--------- ---------- ---- TXWBW insock.Net workDiscon nect ----- ----
	434	---------- ---------- ---------- ---------- ---------- ---------- ----}
	435	procedure TXWBWinsoc k.NetworkD isconnect( hSocket: T Socket);
	436	begin
	437	xFlush : = False;
	438	if IsCon nected the n
	439	try
	440	NetS top(hSocke t);
	441	except on EBroke rError do
	442	Sock etError := WSACleanu p; // -- shutdow n TCP API
	443	end; //i f
	444	end; //pro cedure TXW BWinsock.N etworkDisc onnect
	445
	446
	447	{--------- ---------- ---- TXWBW insock.Bui ldHdr ---- ---------- ----
	448	---------- ---------- ---------- ---------- ---------- ---------- ----}
	449	function T XWBWinsock .BuildHdr ( wkid: st ring; winh : string; prch: stri ng; wish: string): s tring;
	450	var
	451	t: strin g;
	452	begin
	453	t := wki d + ';' + winh + ';' + prch + ';' + wish + ';';
	454	Result : = StrPack( t,3);
	455	end; //fun ction TXWB Winsock.Bu ildHdr
	456
	457
	458	{--------- ---------- ---- TXWBW insock.Bui ldPar ---- ---------- ----
	459	Builds the RPC Broke r call to be sent to the VistA server.
	460	---------- ---------- ---------- ---------- ---------- ---------- ----}
	461	function T XWBWinsock .BuildPar( hSocket: T Socket; ap i, RPCVer: string; c onst Param eters: TPa rams): str ing;
	462	var
	463	i,ParamC ount: inte ger;
	464	param: s tring;
	465	tResult: string;
	466	subscrip t: string;
	467	IsSeen: Boolean;
	468	begin
	469	param := '5';
	470	if Param eters = ni l then Par amCount := 0
	471	else Par amCount := Parameter s.Count;
	472	for i := 0 to Para mCount - 1 do
	473	begin
	474	if Par ameters[i] .PType <> undefined then
	475	begin
	476	with Parameter s[i] do
	477	begi n
	478	if PType = l iteral the n
	479	param := p aram + '0' +LPack(Val ue,CountWi dth)+'f'; // 03 0107 new m essage pro tocol
	480	if PType = r eference t hen
	481	param := p aram + '1' +LPack(Val ue,CountWi dth)+'f'; // 030 107 new me ssage prot ocol
	482	if PType = e mpty then
	483	param := p aram + '4f ';
	484	if (PType = list) or ( PType = gl obal) then
	485	be gin
	486	if PType = list then // 0 30107 new message pr otocol
	487	param := param + ' 2'
	488	else
	489	param := param + ' 3';
	490	IsSeen := False;
	491	subscript := Mult.Fi rst;
	492	while subs cript <> ' ' do
	493	begin
	494	if IsSee n then
	495	param := param + 't';
	496	if Mult[ subscript] = '' then
	497	Mult[s ubscript] := #1;
	498	param := param + L Pack(subsc ript,Count Width)+LPa ck(Mult[su bscript],C ountWidth) ;
	499	IsSeen : = True;
	500	subscrip t := Mult. Order(subs cript,1);
	501	end; //whi le subscri pt <> ''
	502	if not IsS een then // 040922 add ed to take care of l ist/global parameter s with no values
	503	param := param + L Pack('',Co untWidth);
	504	param := p aram + 'f' ;
	505	en d; //if (P Type = lis t) or (PTy pe = globa l)
	506	if PType = s tream then
	507	be gin
	508	param := p aram + '5' + LPack(V alue,Count Width) + ' f';
	509	en d; //if PT ype = stre am
	510	end; //with Pa rameters[i ] do
	511	end; / /if Parame ters[i].PT ype <> und efined
	512	end; //f or i := 0
	513	if param = '5' the n
	514	param := param + '4f';
	515	tresult := '[XWB]' + '11' + IntToStr(C ountWidth) + '0' + ' 2' + SPack (RPCVer) + SPack(api ) + param + #4;
	516	Result : = tresult;
	517	end; //fun ction TXWB Winsock.Bu ildPar
	518
	519
	520	{--------- ---------- ---- TXWBW insock.Str Pack ----- ---------- ----
	521	---------- ---------- ---------- ---------- ---------- ---------- ----}
	522	function T XWBWinsock .StrPack(n : String; p: Integer ): String;
	523	var
	524	s,l: Int eger;
	525	t,x,zero : shortstr ing;
	526	y: Strin g;
	527	begin
	528	s := Len gth(n);
	529	fillchar (zero,p+1, '0');
	530	SetLengt h(zero, p) ;
	531	str(s,x) ;
	532	t := zer o + x;
	533	l := len gth(x)+1;
	534	y := Cop y(t, l , p );
	535	y := y + n;
	536	Result : = y;
	537	end; //fun ction TXWB Winsock.St rPack
	538
	539
	540	{--------- ---------- ---- TXWBW insock.Var Pack ----- ---------- ----
	541	---------- ---------- ---------- ---------- ---------- ---------- ----}
	542	function T XWBWinsock .VarPack(n : string): string;
	543	var
	544	s: integ er;
	545	begin
	546	if n = ' ' then
	547	n := ' 0';
	548	s := Len gth(n);
	549	SetLengt h(Result, s+2);
	550	Result : = '\|' + ch r(s) + n;
	551	end; //fun ction TXWB Winsock.Va rPack
	552
	553
	554	{--------- ---------- ---- TXWBW insock.Net Call ----- ---------- ----
	555	---------- ---------- ---------- ---------- ---------- ---------- ----}
	556	function T XWBWinsock .NetCall(h Socket: TS ocket; ims g: String) : PChar; / / JLI 0908 05
	557	var
	558	BufSend, BufRecv, BufPtr: PA nsiChar;
	559	sBuf: st ring;
	560	OldTimeO ut: intege r;
	561	BytesRea d, BytesLe ft, BytesT otal: long int;
	562	TryNumbe r: Integer ;
	563	BadXfer: Boolean;
	564	xString: String;
	565	begin
	566	{ -- cle ar receive buffer pr ior to sen ding rpc }
	567	if xFlus h = True t hen
	568	begin
	569	OldTim eOut := Ho okTimeOut;
	570	HookTi meOut := 0 ;
	571	NetCal lPending : = True;
	572	BufRec v := PAnsi Char(StrAl loc(Buffer 32k));
	573	NetTim erStart := Now;
	574	BytesR ead := rec v(hSocket, BufRecv^, Buffer32k , 0);
	575	if Byt esRead > 0 then
	576	whil e BufRecv[ BytesRead- 1] <> #4 d o
	577	begi n
	578	By tesRead := recv(hSoc ket, BufRe cv^, Buffe r32k, 0);
	579	end; //while
	580	AnsiSt rings.StrD ispose(Buf Recv); //p 60
	581	xFlush := False;
	582	HookTi meOut := O ldTimeOut;
	583	end; //i f
	584	TryNumbe r := 0;
	585	BadXfer := True;
	586	{ -- sen d message length + m essage to server }
	587	BufRecv := PAnsiCh ar(StrAllo c(Buffer32 k));
	588	try // B ufRecv
	589	BufS end := Ans iStrings.S trNew(PAns iChar(Ansi String(ims g))); //p6 0
	590	try // BufSend
	591	Resu lt := PCha r('');
	592	whil e BadXfer and (TryNu mber < 4) do
	593	begi n
	594	Ne tCallPendi ng := True ;
	595	Ne tTimerStar t := Now;
	596	Tr yNumber := TryNumber + 1;
	597	Ba dXfer := F alse;
	598	So cketError := send(hS ocket, Buf Send^, Ans iStrings.S trLen(BufS end),0); / /p60
	599	if SocketErr or = SOCKE T_ERROR th en
	600	NetError(' send', 0);
	601	Bu fRecv[0] : = #0;
	602	tr y
	603	BufPtr := BufRecv;
	604	BytesLeft := Buffer3 2k;
	605	BytesTotal := 0;
	606	{ Get Securi ty and App lication p ackets}
	607	SecuritySe gment := G etServerPa cket(hSock et);
	608	Applicatio nSegment : = GetServe rPacket(hS ocket);
	609	sBuf := '' ;
	610	{ -- loop reading TC P buffer u ntil serve r is finis hed sendin g reply }
	611	repeat
	612	BytesRea d := recv( hSocket, B ufPtr^, By tesLeft, 0 );
	613	if Bytes Read > 0 t hen
	614	begin
	615	if Buf Ptr[BytesR ead-1] = # 4 then
	616	begin
	617	sBuf := ConCat (sBuf, Buf Ptr);
	618	end // if BufPtr
	619	else
	620	begin
	621	BufP tr[BytesRe ad] := #0;
	622	sBuf := ConCat (sBuf, Buf Ptr);
	623	end; / /else BufP tr
	624	Inc(By tesTotal, BytesRead) ;
	625	end; //i f BytesRea d > 0
	626	if Bytes Read <= 0 then
	627	begin
	628	if Byt esRead = S OCKET_ERRO R then
	629	NetE rror('recv ', 0)
	630	else
	631	NetE rror('conn ection los t', 0);
	632	break;
	633	end; //i f BytesRea d <= 0
	634	until BufP tr[BytesRe ad-1] = #4 ; //repeat
	635	sBuf := Co py(sBuf, 1 , BytesTot al - 1);
	636	Result := StrAlloc(B ytesTotal+ 1);
	637	StrCopy(Re sult, PCha r(sBuf));
	638	if Applica tionSegmen t = 'U411' then
	639	BadXfer := True;
	640	NetCallPen ding := Fa lse;
	641	fi nally //tr y
	642	sBuf := '' ;
	643	en d; //try
	644	end;
	645	finall y //try Bu fSend
	646	Ansi Strings.St rDispose(B ufSend); / /p60
	647	end; / /try BufSe nd
	648	if Bad Xfer then
	649	begin
	650	NetE rror(AnsiS trings.Str Pas('Repea ted Incomp lete Reads on the se rver'), XW B_BadReads ); //p60
	651	Resu lt := StrN ew('');
	652	end; / /if BadXfe r
	653	{ -- i f there wa s on error on the se rver, disp lay the er ror code }
	654	if Ans iChar(Resu lt[0]) = # 24 then
	655	begin
	656	xStr ing := Str ing(Result ); // JLI 090804
	657	xStr ing := Cop y(xString, 2,Length(x String)); // JLI 090 804
	658	NetE rror(xStri ng, XWB_M_ REJECT);
	659	Resu lt := StrN ew('');
	660	end; / /if AnsiCh ar(Result[ 0]) = #24
	661	finally //try BufR ecv
	662	AnsiSt rings.StrD ispose(Buf Recv); //p 60
	663	end; //t ry BufRecv
	664	end; //fun ction TXWB Winsock.Ne tCall
	665
	666
	667	{--------- ---------- ---- TXWBW insock.tCa ll ------- ---------- ----
	668	---------- ---------- ---------- ---------- ---------- ---------- ----}
	669	function T XWBWinsock .tCall(hSo cket: TSoc ket; api, apVer: Str ing; Param eters: TPa rams;
	670	v ar Sec , A pp: PChar; TimeOut: integer ): PChar;
	671	var
	672	tmp: str ing;
	673	ChangeCu rsor: Bool ean;
	674	begin
	675	HookTime Out := Tim eOut;
	676	if (stri ng(Api) <> 'XWB IM H ERE') and (Screen.Cu rsor = crD efault) th en
	677	Change Cursor := True
	678	else
	679	Change Cursor := False;
	680	if Chang eCursor th en
	681	Screen .Cursor := crHourGla ss; //P6
	682	tmp := B uildPar(hS ocket, api , apVer, P arameters) ;
	683	Result : = NetCall( hSocket, t mp);
	684	StrPCopy (Sec, Secu ritySegmen t);
	685	StrPCopy (App, Appl icationSeg ment);
	686	if Chang eCursor th en
	687	Screen .Cursor := crDefault ;
	688	end; //fun ction TXWB Winsock.tC all
	689
	690
	691	{--------- ---------- ---- TXWBW insock.Net Start ---- ---------- ----
	692	p60 Rewrot e NetStart to suppor t IPv4/IPv 6 dual-sta ck connect ions.
	693	---------- ---------- ---------- ---------- ---------- ---------- ----}
	694	function T XWBWinsock .NetStart (Foregroun dM: boolea n; Server: string;
	695	L istenerPor t: integer ; var hSoc ket: TSock et): integ er;
	696	var
	697	WinSockD ata: wsaDa ta; //WinS ock 2.2 in fo for Win dows APIs
	698	ChangeCu rsor: Bool ean;
	699	pLocalNa me, pVistA Name, pLis tenerPort: PAnsiChar ;
	700	pHint, p LocalResul t, pVistAR esult: PAd drInfo; // DNS lookup in getadd rinfo
	701	DNSLooku p: Integer ; //Succes s/fail for DNS looku p in getad drinfo
	702	Connecte d: Boolean ;
	703	LocalAdd ress, Vist AAddress: TSockAddr;
	704	LocalAdd ressString , VistAAdd ressString : string;
	705	LocalAdd ressLength , VistAAdd ressLength : DWORD;
	706	Timeout: timeval;
	707	ipv6only : DWORD;
	708	y, tmp, upArrow, r Accept, rL ost: strin g;
	709	tmpPchar : PChar;
	710	r: integ er;
	711	lin: TLi nger;
	712	s_lin: a rray [0..3 ] of AnsiC har absolu te lin;
	713	begin
	714	if Scree n.Cursor = crDefault then
	715	Change Cursor := True
	716	else
	717	Change Cursor := False;
	718	if Chang eCursor th en
	719	Screen .Cursor := crHourGla ss;
	720	ipv6only := 0; //W inSock def aults to I Pv6-only. We want bo th IPv4 an d IPv6.
	721	IPprotoc ol := 0;
	722	upArrow := string( '^');
	723	rAccept := string( 'accept');
	724	rLost := string('( connection lost)');
	725	//Set ti meout valu e seconds. millisecon ds to wait for a res ponse from the serve r before a borting.
	726	//Per MS DN, value may be NUL L. This mi ght not be needed, o r set it t o NIL.
	727	Timeout. tv_sec := 5; //Secon ds
	728	Timeout. tv_usec := 0; //Mill iseconds
	729	//TODO - Implement native SS L/TLS usin g Windows SChannel S SPI before WinSock i s initiali zed
	730	//Initia te Windows WinSock D LL
	731	SocketEr ror := WSA Startup(Wi nSockVer, WinSockDat a);
	732	if Socke tError > 0 then
	733	NetErr or('WSASta rtup',0);
	734	NetCallP ending := False;
	735	//Identi fy the Vis tA host (S erver) by FQDN, IPv4 address, or IPv6 ad dress
	736	pVistANa me := PAns iChar(Ansi String(Ser ver));
	737	New(pHin t);
	738	pHint.ai _flags := AI_CANONNA ME + AI_AL L;
	739	pHint.ai _family := AF_UNSPEC ;
	740	pHint.ai _socktype := SOCK_ST REAM;
	741	pHint.ai _protocol := IPPROTO _TCP;
	742	pHint.ai _addrlen : = 0;
	743	pHint.ai _canonname := NIL;
	744	pHint.ai _addr := N IL;
	745	pHint.ai _next := N IL;
	746	//Get ca nonical na me for Vis tA (Server )
	747	DNSLooku p := FGetA ddrInfo(pV istAName, NIL, pHint , pVistARe sult);
	748	if DNSLo okup <> 0 then
	749	NetErr or('getadd rinfo (Ser ver)',0);
	750	pVistANa me := pVis tAResult.a i_canonnam e; //Repla ce Server name with canonical name of se rver
	751	//Using AF_INET6 r eturns a d ual-stack socket tha t can be u sed for bo th IPv4 an d IPv6
	752	hSocket := socket( AF_INET6, SOCK_STREA M, IPPROTO _TCP);
	753	if hSock et = INVAL ID_SOCKET then
	754	NetErr or('socket ',0);
	755	//Disabl e the IPV6 _V6ONLY so cket optio n to suppo rt IPv4/IP v6 dual-st ack
	756	SocketEr ror := set sockopt(hS ocket, IPP ROTO_IPV6, IPV6_V6ON LY, PAnsiC har(@ipv6o nly), Size Of(ipv6onl y));
	757	if Socke tError = S OCKET_ERRO R then
	758	NetErr or ('setso cketopt (L ocal)',0);
	759	//Set ad dress spac e sufficie nt for IPv 4 or IPv6
	760	LocalAdd ressLength := SizeOf (SOCKADDR_ STORAGE);
	761	VistAAdd ressLength := SizeOf (SOCKADDR_ STORAGE);
	762	//Use WS AConnectBy Name to ma ke the ini tial broke r connecti on, trying all possi ble combin ations.
	763	pListene rPort := P AnsiChar(A nsiString( IntToStr(L istenerPor t)));
	764	Connecte d := FWSAC onnectByNa me(hSocket , pVistANa me, pListe nerPort,
	765	Local AddressLen gth, Local Address,
	766	VistA AddressLen gth, VistA Address, T imeout, NI L);
	767	if not C onnected t hen
	768	NetErr or('WSACon nectByName ',0);
	769	VistAAdd ressString := FAddrT oString(Vi stAAddress );
	770	if AnsiC ontainsStr (VistAAddr essString, ':') then
	771	IPprot ocol := 6 //IPv6
	772	else
	773	IPprot ocol := 4; //IPv4
	774	//Get ad dress of l ocal syste m that was used to m ake connec tion
	775	LocalAdd ressString := FAddrT oString(Lo calAddress );
	776	//Get ca nonical na me for loc al host (C lient) for that addr ess
	777	DNSLooku p := FGetA ddrInfo(PA nsiChar(An siString(L ocalAddres sString)), NIL, pHin t, pLocalR esult);
	778	if DNSLo okup <> 0 then
	779	NetErr or('getadd rinfo (Cli ent)',0);
	780	pLocalNa me := pLoc alResult.a i_canonnam e;
	781	//Don't send an IP v6 address as a host name due to VistA x -ref "AS2" in SIGN-O N LOG
	782	if AnsiC ontainsStr (pLocalNam e,':') the n
	783	begin
	784	DNSLoo kup := get hostname(p LocalName, 255); // get name o f local sy stem
	785	if DNS Lookup > 0 then
	786	NetE rror ('get hostname ( local)',0) ;
	787	end;
	788	y := '[X WB]' + '10 ' + IntToS tr(CountWi dth) + '0' + '4'+#$A + 'TCPCon nect50'
	789	+ L Pack(Local AddressStr ing,CountW idth) + 'f 0' + LPack (IntToStr( 0),CountWi dth)
	790	+ ' f0' + LPac k(String(p LocalName) ,CountWidt h) + 'f' + #4;
	791	HookTime Out := 30;
	792	tmpPChar := NetCal l(hSocket, PChar(y)) ;
	793	tmp := t mpPchar;
	794	StrDispo se(tmpPcha r);
	795	if Compa reStr(tmp, rlost) = 0 then
	796	begin
	797	lin.l_ onoff := 1 ;
	798	lin.l_ linger := 0;
	799	Socket Error := s etsockopt( hSocket, S OL_SOCKET, SO_LINGER , s_lin, s izeof(lin) );
	800	if Soc ketError = SOCKET_ER ROR then
	801	NetE rror( 'set sockopt (c onnect)',0 );
	802	closes ocket(hSoc ket);
	803	WSACle anup;
	804	Result := 10002;
	805	exit;
	806	end; //i f CompareS tr
	807	r := Com pareStr(tm p, rAccept );
	808	if r <> 0 then
	809	NetErr or ('NetCa ll',XWB_M_ REJECT);
	810	if Chang eCursor th en
	811	Screen .Cursor := crDefault ;
	812	Dispose( pHint);
	813	NetStart := 0;
	814	// -- co nnection e stablished , socket h andle now in: hSock et
	815	end; //fun ction TXWB Winsock.Ne tStart
	816
	817
	818	{--------- ---------- ---- TXWBW insock.Net Stop ----- ---------- ----
	819	---------- ---------- ---------- ---------- ---------- ---------- ----}
	820	procedure TXWBWinsoc k.NetStop( hSocket: T Socket);
	821	var
	822	tmp: str ing;
	823	lin: TLi nger;
	824	s_lin: a rray [0..3 ] of AnsiC har absolu te lin;
	825	ChangeCu rsor: Bool ean;
	826	tmpPChar : PChar;
	827	Str: Str ing;
	828	x: array [0..15] o f Char;
	829	begin
	830	if not I sConnected then exit ;
	831	if Scree n.Cursor = crDefault then
	832	Change Cursor := True
	833	else
	834	Change Cursor := False;
	835	if Chang eCursor th en
	836	Screen .Cursor := crHourGla ss;
	837	if hSock et <= 0 th en
	838	begin
	839	if Cha ngeCursor then
	840	scre en.cursor := crDefau lt;
	841	exit ;
	842	end; //i f hSocket <= 0
	843	StrPcopy (x, StrPac k(StrPack( '#BYE#',5) ,5));
	844	Str := ' [XWB]' + ' 10'+IntToS tr(CountWi dth)+'0' + '4'+#5+'#B YE#'+#4;
	845	if hSock et <> INVA LID_SOCKET then
	846	begin
	847	tmpPCh ar := NetC all(hSocke t,Str);
	848	tmp := tmp PChar;
	849	StrDis pose(tmpPC har);
	850	lin.l_ onoff := 1 ; { -- shut down the M handler} ;
	851	lin.l_ linger := 0;
	852	Socket Error := s etsockopt( hSocket, S OL_SOCKET, SO_LINGER , s_lin, s izeof(lin) );
	853	if Soc ketError = SOCKET_ER ROR then
	854	NetE rror( 'set sockopt (c onnect)',0 );
	855	So cketError := closeso cket(hSock et); { -- close the socket}
	856	end;
	857	SocketEr ror := WSA UnhookBloc kingHook; { -- r estore the default m echanism}
	858	SocketEr ror := WSA Cleanup; { -- s hutdown TC P API}
	859	if Socke tError > 0 then
	860	NetErr or( 'WSACl eanup',0); { -- ch eck blocki ng calls, etc.}
	861	if Chang eCursor th en
	862	Screen .Cursor := crDefault ;
	863	IsConnec ted := Fal se;
	864	end; //pro cedure TXW BWinsock.N etStop
	865
	866
	867	{--------- ---------- ---- TXWBW insock.Clo seSockSyst em ------- ---------- ---------
	868	---------- ---------- ---------- ---------- ---------- ---------- ----}
	869	procedure TXWBWinsoc k.CloseSoc kSystem(hS ocket: TSo cket; s: s tring);
	870	var
	871	lin: TLi nger;
	872	s_lin: a rray [0..3 ] of AnsiC har absolu te lin;
	873	begin
	874	lin.l_on off := 1;
	875	lin.l_li nger := 0;
	876	SocketEr ror := set sockopt(hS ocket, SOL _SOCKET, S O_LINGER, s_lin, siz eof(lin));
	877	if Socke tError = S OCKET_ERRO R then
	878	NetErr or( 'setso ckopt (con nect)',0);
	879	closesoc ket(hSocke t);
	880	WSAClean up;
	881	ShowMess age(s); / /TODO See NetStop fo r SocketEr ror := WSA Cleanup;
	882	halt(1);
	883	end; //pro cedure TXW BWinsock.C loseSockSy stem
	884
	885
	886	{--------- ---------- ---- TXWBW insock.Get ServerPack et ------- ---------- ---------
	887	---------- ---------- ---------- ---------- ---------- ---------- ----}
	888	function T XWBWinsock .GetServer Packet(hSo cket: TSoc ket): stri ng;
	889	var
	890	s,sb: PA nsiChar;
	891	buflen: integer;
	892	begin
	893	s := Ans iStrings.A nsiStrAllo c(1); //p6 0
	894	s[0] := #0;
	895	buflen : = recv(hSo cket, s^, 1, 0); //g et length of segment
	896	if bufle n = SOCKET _ERROR the n // che ck for tim ing proble m if initi al attempt to read d uring conn ection fai ls
	897	begin
	898	sleep( 100);
	899	buflen := recv(h Socket, s^ , 1, 0);
	900	end; //i f
	901	if bufle n = SOCKET _ERROR the n
	902	NetErr or( 'recv' ,0);
	903	buflen : = ord(s[0] );
	904	sb := An siStrings. AnsiStrAll oc(buflen+ 1); //p60
	905	sb[0] := #0;
	906	buflen : = recv(hSo cket, sb^, buflen, 0 ); {get se curity seg ment}
	907	if bufle n = SOCKET _ERROR the n
	908	NetErr or( 'recv' ,0);
	909	sb[bufle n] := #0;
	910	Result : = AnsiStri ngs.StrPas (sb); //p6 0
	911	AnsiStri ngs.StrDis pose(sb); //p60
	912	AnsiStri ngs.StrDis pose(s); / /p60
	913	end; //fun ction TXWB Winsock.Ge tServerPac ket
	914
	915
	916	{--------- ---------- ---- TXWBW insock.Cre ate ------ ---------- ----
	917	---------- ---------- ---------- ---------- ---------- ---------- ----}
	918	constructo r TXWBWins ock.Create ;
	919	begin
	920	inherite d;
	921	CountWid th := 3;
	922	end; //con structor T XWBWinsock .Create
	923
	924
	925	{--------- ---------- ---- TXWBW insock.Net Error ---- ---------- ----
	926	---------- ---------- ---------- ---------- ---------- ---------- ----}
	927	procedure TXWBWinsoc k.NetError (Action: s tring; Err Type: inte ger);
	928	var
	929	x,s: str ing;
	930	r: integ er;
	931	BrokerEr ror: EBrok erError;
	932	TimeOut: Double;
	933	begin
	934	Screen.C ursor := c rDefault;
	935	r := 0;
	936	if ErrTy pe > 0 the n r := Err Type;
	937	if ErrTy pe = 0 the n
	938	begin
	939	if Net callPendin g then
	940	begin
	941	//In dicate WSA ETIMEDOUT error inst ead of WSA EINTR when time out period exp ires
	942	if H ookTimeOut > 0 then
	943	begi n
	944	Ti meOut := H ookTimeOut * OneSeco nd;
	945	if Now > (Ne tTimerStar t + TimeOu t) then
	946	r := WSAET IMEDOUT;
	947	end; //if Hook TimeOut >0
	948	end; / /if Netcal lPending
	949	if r = 0 then
	950	r := WSAGetLas tError;
	951	if ( r = WSAEIN TR) or (r = WSAETIME DOUT) then
	952	xF lush := Tr ue;
	953	end; //i f ErrType = 0
	954	case r o f
	955	WSAEIN TR : x := 'WSAEINTR - Interrup ted functi on call.';
	956	WSAEBA DF : x := 'WSAEBADF - File han dle is not valid.';
	957	WSAEAC CES : x := 'WXAEACCES - Permiss ion denied .';
	958	WSAEFA ULT : x := 'WSAEFAULT - Bad add ress.';
	959	WSAEIN VAL : x := 'WSAEINVAL - Invalid argument. ';
	960	WSAEMF ILE : x := 'WSAEMFILE - Too man y open fil es.';
	961	WSAEWO ULDBLOCK : x := 'WSAEWOULD BLOCK - Re source tem porarily u navailable .';
	962	WSAEIN PROGRESS : x := 'WSAEINPRO GRESS - Op eration no w in progr ess.';
	963	WSAEAL READY : x := 'WSAEALREA DY - Opera tion alrea dy in prog ress.';
	964	WSAENO TSOCK : x := 'WSAENOTSO CK - Socke t operatio n on nonso cket.';
	965	WSAEDE STADDRREQ : x := 'WSAEDESTA DDRREQ - D estination address r equired.';
	966	WSAEMS GSIZE : x := 'WSAEMSGSI ZE - Messa ge too lon g.';
	967	WSAEPR OTOTYPE : x := 'WSAEPROTO TYPE - Pro tocol wron g type for socket.';
	968	WSAENO PROTOOPT : x := 'WSAENOPRO TOOPT - Ba d protocol option.';
	969	WSAEPR OTONOSUPPO RT : x := 'WSAEPROTO NOSUPPORT - Protocol not suppo rted.';
	970	WSAESO CKTNOSUPPO RT : x := 'WSAESOCKT NOSUPPORT - Socket t ype not su pported.';
	971	WSAEOP NOTSUPP : x := 'WSAEOPNOT SUPP - Ope ration not supported .';
	972	WSAEPF NOSUPPORT : x := 'WSAEPFNOS UPPORT - P rotocol fa mily not s upported.' ;
	973	WSAEAF NOSUPPORT : x := 'WSAEAFNOS UPPORT - A ddress fam ily not su pported by protocol family.';
	974	WSAEAD DRINUSE : x := 'WSAEADDRI NUSE - Add ress alrea dy in use. ';
	975	WSAEAD DRNOTAVAIL : x := 'WSAEADDRN OTAVAIL - Cannot ass ign reques ted addres s.';
	976	WSAENE TDOWN : x := 'WSAENETDO WN - Netwo rk is down .';
	977	WSAENE TUNREACH : x := 'WSAENETUN REACH - Ne twork is u nreachable .';
	978	WSAENE TRESET : x := 'WSAENETRE SET - Netw ork droppe d connecti on on rese t.';
	979	WSAECO NNABORTED : x := 'WSAECONNA BORTED - S oftware ca used conne ction abor t.';
	980	WSAECO NNRESET : x := 'WSAECONNR ESET - Con nection re set by pee r.';
	981	WSAENO BUFS : x := 'WSAENOBUF S - No buf fer space available. ';
	982	WSAEIS CONN : x := 'WSAEISCON N - Socket is alread y connecte d.';
	983	WSAENO TCONN : x := 'WSAENOTCO NN - Socke t is not c onnected.' ;
	984	WSAESH UTDOWN : x := 'WSAESHUTD OWN - Cann ot send af ter socket shutdown. ';
	985	WSAETO OMANYREFS : x := 'WSAETOOMA NYREFS - T oo many re ferences.' ;
	986	WSAETI MEDOUT : x := 'WSAETIMED OUT - Conn ection tim ed out.';
	987	WSAECO NNREFUSED : x := 'WSAECONNR EFUSED - C onnection refused.';
	988	WSAELO OP : x := 'WSAELOOP - Cannot t ranslate n ame.';
	989	WSAENA METOOLONG : x := 'WSAENAMET OOLONG - N ame too lo ng.';
	990	WSAEHO STDOWN : x := 'WSAEHOSTD OWN - Host is down.' ;
	991	WSAEHO STUNREACH : x := 'WSAEHOSTU NREACH - N o route to host.';
	992	WSAENO TEMPTY : x := 'WSAENOTEM PTY - Dire ctory not empty.';
	993	WSAEPR OCLIM : x := 'WSAEPROCL IM - Too m any proces ses.';
	994	WSAEUS ERS : x := 'WSAEUSERS - User qu ota exceed ed.';
	995	WSAEDQ UOT : x := 'WSAEDQUOT - Disk qu ota exceed ed.';
	996	WSAEST ALE : x := 'WSAESTALE - Stale f ile handle reference .';
	997	WSAERE MOTE : x := 'WSAEREMOT E - Item i s remote.' ;
	998	WSASYS NOTREADY : x := 'WSASYSNOT READY - Ne twork subs ystem is u navailable .';
	999	WSAVER NOTSUPPORT ED : x := 'WSAVERNOT SUPPORTED - Winsock. dll versio n out of r ange.';
	1000	WSANOT INITIALISE D : x := 'WSANOTINI TIALISED - Successfu l WSAStart up not yet performed .';
	1001	WSATYP E_NOT_FOUN D : x := 'WSATYPE_N OT_FOUND - Class typ e not foun d.';
	1002	WSAHOS T_NOT_FOUN D : x := 'WSAHOST_N OT_FOUND - Host not found.';
	1003	WSATRY _AGAIN : x := 'WSATRY_AG AIN - Nona uthoritati ve host no t found.';
	1004	WSANO_ RECOVERY : x := 'WSANO_REC OVERY - Th is is a no nrecoverab le error.' ;
	1005	WSANO_ DATA : x := 'WSANO_DAT A - Valid name, no d ata record of reques ted type.' ;
	1006
	1007	XWB_NO _HEAP : x := 'Insuffici ent Heap';
	1008	XWB_M_ REJECT : x := 'M Error - Use ^XTER ';
	1009	XWB_Ba dReads : x := 'Server un able to re ad input d ata correc tly.';
	1010	XWB_Ba dSignOn : x := 'Sign-on w as not com pleted.';
	1011	XWB_Ex eNoMem : x := 'System wa s out of m emory, exe cutable fi le was cor rupt, or r elocations were inva lid.';
	1012	XWB_Ex eNoFile : x := 'File was not found. ';
	1013	XWB_Ex eNoPath : x := 'Path was not found. ';
	1014	XWB_Ex eShare : x := 'Attempt w as made to dynamical ly link to a task,' +
	1015	' or there was a sha ring or ne twork-prot ection err or.';
	1016	XWB_Ex eSepSeg : x := 'Library r equired se parate dat a segments for each task.';
	1017	XWB_Ex eLoMem : x := 'There was insuffici ent memory to start the applic ation.';
	1018	XWB_Ex eWinVer : x := 'Windows v ersion was incorrect .';
	1019	XWB_Ex eBadExe : x := 'Executabl e file was invalid.' +
	1020	' Either i t was not a Windows applicatio n or there was an er ror in the .EXE imag e.';
	1021	XWB_Ex eDifOS : x := 'Applicati on was des igned for a differen t operatin g system.' ;
	1022	XWB_Rp cNotReg : x := 'Remote pr ocedure no t register ed to appl ication.';
	1023	XWB_Bl dConnectLi st : x := 'BrokerCon nections l ist could not be cre ated';
	1024	XWB_Nu llRpcVer : x := 'RpcVersio n cannot b e empty.' + #13 + 'D efault is 0 (zero).' ;
	1025	XWB_Ba dToken : x := 'Could not log on us ing STS to ken.';
	1026	else x := IntToS tr(r);
	1027	end;
	1028	if r = 0 then
	1029	x := ' No error c ode return ed';
	1030	s := 'Er ror encoun tered.' + chr(13)+ch r(10) + 'F unction wa s: ' + Act ion + chr( 13)+chr(10 ) + 'Error was: ' + x;
	1031	BrokerEr ror := EBr okerError. Create(s);
	1032	BrokerEr ror.Action := Action ;
	1033	BrokerEr ror.Code : = r;
	1034	BrokerEr ror.Mnemon ic := x;
	1035	raise Br okerError;
	1036	end; //pro cedure TXW BWinsock.N etError
	1037
	1038
	1039	end.
	1040