Context Navigation

PrManUtl.VRS@ 78

Last change on this file since 78 was 77, checked in by Alex Taylor, 7 years ago
Fix PrintMan adding duplicate entries to PRDESC.LST on PPD import.
File size: 41.5 KB

Line
1	/*:VRX DriverIsInstalled
2	*/
3	/* Checks if a given print driver (without extension) is installed, and if so
4	* returns the path to the active files. Returns '' if the driver is not
5	* installed.
6	*/
7	DriverIsInstalled: PROCEDURE
8	ARG driver
9	PARSE VALUE VRGetIni('PM_DEVICE_DRIVERS', driver, 'USER') WITH drv_path '00'x .
10	IF ( drv_path <> '') THEN
11	drv_path = STREAM( drv_path, 'C', 'QUERY EXISTS')
12	RETURN drv_path
13
14
15	/*:VRX GetDriverFileList
16	*/
17	GetDriverFileList: PROCEDURE
18	PARSE ARG eaname, driver
19	filelist = ''
20
21	/* Read the list of required driver files from the EAs, and copy them
22	* all to the target directory.
23	*/
24	IF SysGetEA( driver, eaname, 'reqfiles') == 0 THEN DO
25	PARSE VAR reqfiles 1 eatype 3 .
26	eatype = C2X( eatype )
27
28	IF eatype == 'FDFF' THEN DO /* Single ASCII value from byte 5 */
29	PARSE VAR reqfiles 5 filelist
30	END
31	ELSE IF eatype = 'DEFF' THEN DO /* Single-type list from byte 7 */
32	PARSE VAR reqfiles 7 fl_type 9 fl_items
33
34	/* Parse the first value out of the list. The first two bytes are the
35	* length of the value.
36	*/
37	PARSE VAR fl_items 1 i_len 3 i_val
38	len = C2D( REVERSE( i_len ))
39	filelist = SUBSTR( i_val, 1, len )
40	END
41	ELSE IF eatype = 'DFFF' THEN DO /* Multi-type list from byte 7 */
42	PARSE VAR reqfiles 7 fl_items
43
44	/* Parse the first value out of the list. The first two bytes are the
45	* data type; this should always be ASCII ('FDFF') so we can skip it.
46	* The following word holds the length of the value.
47	*/
48	PARSE VAR fl_items 3 i_len 5 i_val
49	len = C2D( REVERSE( i_len ))
50	filelist = SUBSTR( i_val, 1, len )
51	END
52	filelist = TRANSLATE( filelist, ' ', ',')
53	END
54
55	RETURN filelist
56
57
58	/*:VRX GetDriverSource
59	*/
60	/* Figure out where to look for the PrinterPak driver files used as the install
61	* source. Preference is given to the local repository (PDR_DIR); if it's not
62	* there, we look in a couple of other places where it might have ended up.
63	* Note that we don't look for the actual installed driver files under \OS2\DLL;
64	* that logic is handled in LocateDriverFiles(), which calls this routine.
65	*
66	* Various global values are assumed to be set already:
67	* - globals.!prdrv: filespec of \OS2\INSTALL\PRDRV.LST
68	* - globals.!repository: value indicated by PM_INSTALL->PDR_DIR in OS2.INI
69	*
70	* Arguments: The print driver name without path or extension
71	*
72	* Returns the path, or '' if not found. Also, 'pmdx' will be 0-9 if the
73	* driver is in the repository (indicating the repository subdirectory), or
74	* '' if the driver is not in the repository.
75	*/
76	GetDriverSource: PROCEDURE EXPOSE globals. pmdx
77	ARG driver
78	IF driver == '' THEN RETURN ''
79
80	drv_file = ''
81	IF globals.!repository <> '' THEN DO
82
83	/* See if the driver is defined in the local repository. (This is the
84	* directory where installable printer drivers are kept. OS/2 gets them
85	* from here when you select 'Printer driver included with OS/2'.)
86	*/
87	pmdx = GetDriverPMDD( driver, globals.!prdrv )
88	IF pmdx == '' THEN DO
89	/* Hmm, the driver isn't listed in PRDRV.LST. Let's check to see if
90	* it's in the default repository location anyway.
91	*/
92	IF WORDPOS( driver, 'ECUPS ECUPS-HP PSPRINT PSPRINT2') > 0 THEN
93	pmdx = '9'
94	ELSE
95	pmdx = '0'
96	drv_file = STREAM( globals.!repository'\PMDD_'pmdx'\'driver'.DRV', 'C', 'QUERY EXISTS')
97	IF drv_file <> '' THEN DO
98	/* We found the driver in the repository, even though it isn't
99	* defined as such. So let's add the proper definition to
100	* PRDRV.LST now.
101	*/
102	CALL LINEOUT globals.!prdrv, LEFT( driver'.DRV', 14 ) pmdx \|\|,
103	' (added automatically)'
104	CALL LINEOUT globals.!prdrv
105	END
106	ELSE
107	pmdx = ''
108	END
109	ELSE DO
110	/* The driver is listed; now make sure it's actually there.
111	*/
112	drv_file = STREAM( globals.!repository'\PMDD_'pmdx'\'driver'.DRV', 'C', 'QUERY EXISTS')
113	END
114	END
115
116	IF drv_file == '' THEN DO
117	CALL LINEOUT globals.!log1, 'Driver' driver 'is not in the local repository.'
118	/* If the driver really isn't in the repository, there are a couple of
119	* other places that various install utilities might have put it...
120	*/
121	PARSE VALUE VRGetIni('PM_INSTALL', driver'_DIR', 'USER') WITH drvr_dir '00'x .
122	IF drvr_dir == '' THEN
123	PARSE VALUE VRGetIni('InstPDR', 'PATH_TO_'driver, 'USER') WITH drvr_dir '00'x .
124	IF drvr_dir <> '' THEN DO
125	drv_file = drvr_dir'\'driver'.DRV'
126	CALL LINEOUT globals.!log1, 'Found driver in' drvr_dir'.'
127	END
128	END
129
130	RETURN drv_file
131
132
133	/*:VRX GetDriverPMDD
134	*/
135	/* Check to see which repository directory the specified driver resides in.
136	* Returns the number suffix of the PMDD_* subdirectory name, or '' if either
137	* the driver or the index file could not be located.
138	*
139	* Arguments: The print driver name without path or extension
140	*/
141	GetDriverPMDD: PROCEDURE
142	PARSE ARG driver, prdrv_lst
143
144	IF prdrv_lst <> '' THEN DO
145	CALL LINEIN prdrv_lst, 1, 0
146	DO WHILE LINES( prdrv_lst ) > 0
147	PARSE VALUE LINEIN( prdrv_lst ) WITH (driver)'.DRV' pmdx .
148	IF pmdx <> '' THEN LEAVE
149	END
150	CALL STREAM prdrv_lst, 'C', 'CLOSE'
151	END
152	ELSE pmdx = ''
153
154	RETURN pmdx
155
156
157	/*:VRX LocateDriverFiles
158	*/
159	/* Locates the source files for a PostScript-based driver that will be required in
160	* order to import a PPD using PIN. Not to be used with non-PostScript drivers,
161	* since it will fail if PIN or PPDENC are not found.
162	*
163	* Arguments: The print driver name without path or extension
164	*
165	* Returns:
166	* 0 - Driver files not found.
167	* 1 - Driver files found, path saved in 'driver_path'; 'driver_repo' will be 1
168	* if the driver is 'shipped' (i.e. defined in PRDRV.LST) or 0 otherwise.
169	* 2 - Only found installed driver files in (\OS2\DLL\xxx, saved in 'driver_path');
170	* will need to copy them somewhere for future installs.
171	*/
172	LocateDriverFiles: PROCEDURE EXPOSE globals. driver_path driver_repo
173	ARG driver
174	IF driver == '' THEN driver = 'PSCRIPT'
175
176	CALL LINEOUT globals.!log1, 'Looking for' driver 'files'
177
178	mustcopy = 0
179	driver_path = GetDriverSource( driver )
180
181	IF driver_path == '' THEN DO
182	/* No source found. We'll have to try copying the actual installed
183	* driver files from under \OS2\DLL.
184	*/
185	CALL LINEOUT globals.!log1, 'Driver source not found. Trying installed driver.'
186	PARSE VALUE VRGetIni('PM_DEVICE_DRIVERS', driver, 'USER') WITH drv_used '00'x .
187	IF ( drv_used <> '') & VRFileExists( drv_used ) THEN
188	driver_path = drv_used
189	END
190	IF driver_path <> '' THEN DO
191	srcdir = VRParseFilePath( driver_path, 'DP')
192	pin = STREAM( srcdir'\PIN.EXE', 'C', 'QUERY EXISTS')
193	ppdenc = STREAM( srcdir'\PPDENC.EXE', 'C', 'QUERY EXISTS')
194	/* TODO should we check for all the REQUIREDDRIVER FILES as well? */
195	END
196
197	IF pmdx == '' THEN
198	driver_repo = 0
199	ELSE
200	driver_repo = 1
201
202	/* Driver (or one of its required files) was not found.
203	*/
204	IF ( driver_path == '') \| ( pin == '') \| ( ppdenc == '') \| ,
205	( VerifyDriverEAs( driver_path ) == 0 ) THEN
206	DO
207	CALL LINEOUT globals.!log1, ' - Missing required driver files.'
208	RETURN 0
209	END
210
211	IF mustcopy THEN RETURN 2
212	RETURN 1
213
214
215	/*:VRX VerifyDriverEAs
216	*/
217	/* Make sure the driver has its extended attributes. If not, look for an
218	* accompanying .EA or .EA_ file, and join it to the driver.
219	*/
220	VerifyDriverEAs: PROCEDURE EXPOSE globals.
221	PARSE ARG driver
222	eas.0 = 0
223	CALL SysQueryEAList driver, 'eas.'
224	IF eas.0 == 0 THEN DO
225	ea_file = SUBSTR( driver, 1, LASTPOS('.', driver )) \|\| 'EA'
226	IF STREAM( ea_file, 'C', 'QUERY EXISTS') == '' THEN
227	ea_file = ea_file \|\| '_'
228	IF STREAM( ea_file, 'C', 'QUERY EXISTS') == '' THEN
229	RETURN 0
230
231	ADDRESS CMD '@UNLOCK' driver '2>NUL 1>NUL'
232	ADDRESS CMD '@EAUTIL' driver ea_file '/j /p 2>NUL 1>NUL'
233	END
234	RETURN 1
235
236
237	/*:VRX BldLevelVersion
238	*/
239	/* Parse the revision (version) number from a BLDLEVEL string
240	*/
241	BldLevelVersion: PROCEDURE EXPOSE globals.
242	ARG module
243	revision = ''
244
245	_nq = RXQUEUE('CREATE')
246	_oq = RXQUEUE('SET', _nq )
247
248	ADDRESS CMD '@bldlevel' module '2>&1 \| RXQUEUE' _nq
249	DO QUEUED()
250	PARSE PULL _blline
251	IF LEFT( _blline, 9 ) == 'Revision:' THEN DO
252	PARSE VAR _blline 'Revision:' revision .
253	LEAVE
254	END
255	END
256
257	CALL RXQUEUE 'SET', _oq
258	CALL RXQUEUE 'DELETE', _nq
259
260	IF revision == '' THEN revision = '-'
261
262	RETURN revision
263
264
265	/*:VRX CopyPrinterPak
266	*/
267	/* Copies a printerpak driver and all its dependent files from one directory
268	* to another.
269	*
270	* driver - The fully-qualified filename of the printerpak .DRV
271	* newdrvdir - The directory where the files will be copied; must exist
272	*
273	* Returns: 1 on success, 0 on failure
274	*/
275	CopyPrinterPak: PROCEDURE EXPOSE globals.
276	PARSE ARG driver, newdrvdir
277
278	drv_dir = VRParseFilePath( driver, 'DP')
279	drv_name = VRParseFilePath( driver, 'NE')
280	IF drv_dir == '' THEN RETURN 0
281
282	IF VerifyDriverEAs( driver ) == 0 THEN RETURN 0
283
284	CALL LINEOUT globals.!log1, 'Copying driver files from' drv_dir 'to' newdrvdir'...'
285
286	/* Read the list of required driver files from the EAs, and copy them
287	* all to the target directory.
288	*/
289	/**** OLD
290	IF SysGetEA( driver, 'REQUIREDDRIVERFILES', 'reqfiles') == 0 THEN DO
291	PARSE VAR reqfiles 5 filelist
292	filelist = TRANSLATE( filelist, ' ', ',')
293	DO i = 1 TO WORDS( filelist )
294	copyfile = drv_dir'\' \|\| WORD( filelist, i )
295	ok = VRCopyFile( copyfile, newdrvdir'\' \|\| WORD( filelist, i ))
296	CALL LINEOUT globals.!log1, ' -' copyfile '(REQUIRED):' ok
297	END
298	DROP copyfile
299	DROP filelist
300	END
301	****/
302	filelist = GetDriverFileList('REQUIREDDRIVERFILES', driver )
303	IF filelist <> '' THEN DO
304	DO i = 1 TO WORDS( filelist )
305	copyfile = drv_dir'\' \|\| WORD( filelist, i )
306	ok = VRCopyFile( copyfile, newdrvdir'\' \|\| WORD( filelist, i ))
307	CALL LINEOUT globals.!log1, ' -' copyfile '(REQUIRED):' ok
308	END
309	DROP copyfile
310	DROP filelist
311	END
312	ELSE RETURN 0
313
314	/* If there are optional files defined as well, try to copy those also.
315	*/
316	/**** OLD
317	IF SysGetEA( driver, 'OPTIONALDRIVERFILES', 'reqfiles') == 0 THEN DO
318	PARSE VAR reqfiles 5 filelist
319	filelist = TRANSLATE( filelist, ' ', ',')
320	DO i = 1 TO WORDS( filelist )
321	copyfile = drv_dir'\' \|\| WORD( filelist, i )
322	IF STREAM( copyfile, 'C', 'QUERY EXISTS') == '' THEN ITERATE
323	ok = VRCopyFile( copyfile, newdrvdir'\' \|\| WORD( filelist, i ))
324	CALL LINEOUT globals.!log1, ' -' copyfile '(OPTIONAL):' ok
325	END
326	DROP copyfile
327	DROP filelist
328	END
329	****/
330	filelist = GetDriverFileList('OPTIONALDRIVERFILES', driver )
331	IF filelist <> '' THEN DO
332	DO i = 1 TO WORDS( filelist )
333	copyfile = drv_dir'\' \|\| WORD( filelist, i )
334	ok = VRCopyFile( copyfile, newdrvdir'\' \|\| WORD( filelist, i ))
335	CALL LINEOUT globals.!log1, ' -' copyfile '(OPTIONAL):' ok
336	END
337	DROP copyfile
338	DROP filelist
339	END
340
341	/* If AUXPRINT.PAK exists, copy it as well */
342	copyfile = drv_dir'\AUXPRINT.PAK'
343	IF STREAM( copyfile, 'C', 'QUERY EXISTS') <> '' THEN DO
344	ok = VRCopyFile( copyfile, newdrvdir'\AUXPRINT.PAK')
345	CALL LINEOUT globals.!log1, ' -' copyfile ':' ok
346	END
347
348	/* Create an EA file if necessary */
349	eafile = VRParseFilePath( driver, 'N') \|\| '.EA'
350	IF VRFileExists( newdrvdir'\'eafile ) THEN
351	CALL VRDeleteFile newdrvdir'\'eafile
352	ADDRESS CMD '@EAUTIL' newdrvdir'\'drv_name newdrvdir'\'eafile '/s /p 2>NUL 1>NUL'
353
354	RETURN 1
355
356
357	/*:VRX PrinterExistsInDRV
358	*/
359	/* Determine if the specified PrinterPak driver already contains support
360	* for the specified printer model.
361	*
362	* If so, return the name of the model as found in the driver (necessary in
363	* order to make sure the correct case is retained, which may be different
364	* from what was requested). Otherwise return ''.
365	*/
366	PrinterExistsInDRV: PROCEDURE EXPOSE globals.
367	PARSE UPPER ARG driver_name, printer_name
368	printer_name = TRANSLATE( printer_name, '_', '.')
369
370	printer_drv = globals.!os2dir'\DLL\'driver_name'\'driver_name'.DRV'
371	/* ?? TODO: install driver_name if not found (prompt first) ?? */
372
373	IF SysGetEA( printer_drv, '.EXPAND', 'exist_ea') <> 0 THEN RETURN 0
374	PARSE VAR exist_ea 1 _eatype 3 .
375	IF C2X( _eatype ) <> 'FDFF' THEN RETURN 0
376
377	PARSE VAR exist_ea 3 _ealen 5 exist_models
378	total_len = C2D( REVERSE( _ealen ))
379
380	/* The variable exist_models now contains a null-separated list of printer
381	* models supported by the driver (including those from previously-imported
382	* PPD files). Next we check each one against our requested printer name.
383	*/
384	start = 1
385	found = ''
386	DO WHILE ( found == 0 ) & ( start < total_len )
387	_strend = POS('0'x, exist_models, start )
388	IF _strend == 0 THEN LEAVE
389	_model = SUBSTR( exist_models, start, _strend - start )
390	IF TRANSLATE( _model ) == printer_name THEN
391	found = _model
392	ELSE
393	start = _strend + 1
394	END
395
396	RETURN found
397
398
399	/*:VRX CreateDriverList
400	*/
401	/* Generate a driver listfile from the .EXPAND EA
402	*/
403	CreateDriverList: PROCEDURE EXPOSE globals.
404	ARG driver, listfile
405
406	IF STREAM( listfile, 'C', 'QUERY EXISTS') <> '' THEN
407	CALL SysFileDelete listfile
408
409	drv_name = FILESPEC('NAME', driver )
410	IF SysGetEA( driver, '.EXPAND', 'eaval') == 0 THEN DO
411	PARSE VAR eaval 3 ealen 5 models
412	offs = 1
413	datalen = C2D( REVERSE( ealen ))
414	DO WHILE offs <= datalen
415	start = SUBSTR( models, offs )
416	inc = POS('00'x, start )
417	IF inc > 1 THEN DO
418	current_name = STRIP( SUBSTR( start, 1, inc-1 ))
419	CALL LINEOUT listfile, current_name':' current_name '('drv_name')'
420	END
421	offs = offs + inc
422	END
423	CALL LINEOUT listfile
424	CALL LINEOUT globals.!log1, 'Created driver list' listfile 'for' driver'.'
425	END
426	ELSE
427	CALL LINEOUT globals.!log1, 'No drivers found in' driver '(missing .EXPAND extended attribute?)'
428
429	RETURN 1
430
431
432	/*:VRX AddPort_CUPS
433	*/
434	/* Adds a new CUPS port. Returns 0 on full success, 1 if the port was created
435	* but could not be configured, and an OS/2 or PM error code otherwise.
436	*/
437	AddPort_CUPS: PROCEDURE EXPOSE globals.
438	PARSE ARG portname, hostname, queuename
439	CALL LINEOUT globals.!log1, 'Creating new port' portname
440	ADDRESS CMD '@cupsport' portname hostname queuename '>>' globals.!log2
441	IF rc == 1 THEN DO
442	CALL VRSetIni 'PM_'portname, 'INITIALIZATION', hostname'#'queuename\|\|'00'x, 'SYSTEM', 'NoClose'
443	CALL VRSetIni 'PM_'portname, 'DESCRIPTION', hostname':'queuename\|\|'00'x, 'SYSTEM'
444	END
445	RETURN rc
446
447
448	/*:VRX DeletePort
449	*/
450	/* Deletes a printer port (any type).
451	*/
452	DeletePort: PROCEDURE EXPOSE globals.
453	PARSE ARG portname
454	CALL SysIni 'SYSTEM', 'PM_'portname, 'DELETE:'
455	CALL SysIni 'SYSTEM', 'PM_SPOOLER_PORT', portname, 'DELETE:'
456	RETURN 1
457
458
459	/*:VRX GetNextPortName
460	*/
461	/* Get the next unique (non-existing) port name for the specified port driver.
462	*/
463	GetNextPortName: PROCEDURE
464	ARG portdrv
465
466	maxports = 64 /* should be smarter about this if possible */
467	exists = 1
468	x = 0
469	DO WHILE ( x < maxports ) & ( exists == 1 )
470	x = x + 1
471	portname = portdrv \|\| x
472	nextport = SysIni('SYSTEM', 'PM_SPOOLER_PORT', portname )
473	IF LEFT( nextport, 6 ) == 'ERROR:' THEN exists = 0
474	END
475	IF exists == 1 THEN
476	portname = ''
477
478	RETURN portname
479
480
481	/*:VRX GetPortDrivers
482	*/
483	/* Get the list of currently-installed port drivers. NOTE: we exclude LPRPDRVR
484	* from this list, because it has to be managed via the TCP/IP configuration
485	* program.
486	*/
487	GetPortDrivers: PROCEDURE EXPOSE portdrivers.
488	ok = SysIni('SYSTEM', 'PM_PORT_DRIVER', 'ALL:', 'installed.')
489	IF LEFT( ok, 6 ) == 'ERROR:' THEN RETURN 0
490	count = 0
491	DO i = 1 TO installed.0
492	IF installed.i = 'LPRPDRVR' THEN ITERATE
493	fullpath = STRIP( SysIni('SYSTEM', 'PM_PORT_DRIVER', installed.i ), 'T', '00'x )
494	IF LEFT( fullpath, 6 ) == 'ERROR:' THEN fullpath = ''
495	fullpath = STREAM( fullpath , 'C', 'QUERY EXISTS')
496	count = count + 1
497	portdrivers.count = installed.i \|\| ' ' \|\| fullpath
498	END
499	portdrivers.0 = count
500	RETURN portdrivers.0
501
502
503	/*:VRX GetQueueName
504	*/
505	/* Generate a unique queue name from the specified printer name.
506	*/
507	GetQueueName: PROCEDURE
508	ARG queuename
509
510	DO UNTIL badchar = 0
511	badchar = VERIFY( queuename, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ-_0123456789 ')
512	IF badchar > 0 THEN
513	queuename = OVERLAY(' ', queuename, badchar, 1 )
514	END
515	queuename = LEFT( SPACE( queuename, 0 ), 8 )
516
517	tail = 0
518	PARSE VALUE VRGetIni('PM_SPOOLER', 'DIR', 'SYSTEM') WITH spldir ';' .
519	DO WHILE VRFileExists( spldir'\'queuename ) == 1
520	tail = tail + 1
521	queuename = STRIP( LEFT( queuename, 8 - LENGTH( tail ))) \|\| tail
522	END
523
524	RETURN queuename
525
526
527	/*:VRX InstallPortDriver
528	*/
529	/* Installs a new port driver.
530	*
531	* Returns: 0 on success, 1 on error
532	*/
533	InstallPortDriver: PROCEDURE EXPOSE globals.
534	ARG new_pdr
535	filename = VRParseFileName( new_pdr, 'NE')
536	IF filename == '' THEN RETURN
537	installed_pdr = TRANSLATE( globals.!os2dir'\DLL\'filename )
538	IF installed_pdr <> new_pdr THEN DO
539	ok = VRCopyFile( new_pdr, installed_pdr )
540	IF ok == 0 THEN RETURN 1
541	/* Try to copy any optional files as well */
542	IF SysGetEA( new_pdr, 'OPTIONALDRIVERFILES', 'reqfiles') == 0 THEN DO
543	drv_dir = VRParseFilePath( new_pdr, 'DP')
544	PARSE VAR reqfiles 5 filelist
545	filelist = TRANSLATE( filelist, ' ', ',')
546	DO i = 1 TO WORDS( filelist )
547	copyfile = drv_dir'\' \|\| WORD( filelist, i )
548	IF STREAM( copyfile, 'C', 'QUERY EXISTS') == '' THEN ITERATE
549	ok = VRCopyFile( copyfile, newdrvdir'\' \|\| WORD( filelist, i ))
550	/CALL LINEOUT globals.!log1, ' -' copyfile '(OPTIONAL):' ok/
551	END
552	END
553	END
554
555	key = VRParseFileName( installed_pdr, 'N')
556	CALL VRSetIni 'PM_PORT_DRIVER', key, installed_pdr\|\|'00'x, 'SYSTEM'
557	RETURN 0
558
559
560	/*:VRX InstallPrintDriver
561	*/
562	/* 'Installs' (that is to say, registers with the spooler) an OS printer
563	* device driver/model. Installs the corresponding printerpak driver if
564	* necessary.
565	*
566	* driver - The name of the printerpak driver (without path or extension)
567	* driverfull - The fully-qualified filename of the printerpak driver
568	* model - The printer make/model name used by the driver
569	*
570	* Returns: 0 on success, 1 on error
571	*/
572	InstallPrintDriver: PROCEDURE EXPOSE globals.
573	PARSE ARG driver, driverfull, model
574
575	ok = 0
576	targetdir = globals.!os2dir'\DLL\'driver
577	targetdrv = targetdir'\'driver'.DRV'
578	CALL LINEOUT globals.!log1, 'Installing' driver'.'model 'from' driverfull '(target' targetdrv')'
579
580	IF ( VRFileExists( targetdrv ) == 0 ) THEN DO
581	CALL VRMkDir targetdir
582	r = CopyPrinterPak( driverfull, targetdir )
583	IF r <> 1 THEN ok = 1
584	END
585	IF ok == 0 THEN DO
586	IF VRGetIni('PM_DEVICE_DRIVERS', driver, 'USER') <> targetdrv THEN
587	CALL VRSetIni 'PM_DEVICE_DRIVERS', driver, targetdrv\|\|'00'x, 'USER'
588	CALL VRSetIni 'PM_SPOOLER_DD', driver'.'model, driver'.DRV;;;'\|\|'00'x, 'SYSTEM'
589	END
590	RETURN ok
591
592	/*:VRX DeletePrintDriver
593	*/
594	/* Removes (that is to say, de-registers with the spooler) a PM printer
595	* device driver/model.
596	*
597	* driver - The name of the printerpak driver (without path or extension)
598	* model - The printer make/model name used by the driver
599	*
600	* Returns: 0 on success, 1 on error
601	*/
602	DeletePrintDriver: PROCEDURE EXPOSE globals.
603	PARSE ARG driver, model
604
605	ok = VRDelIni('PM_SPOOLER_DD', driver'.'model, 'SYSTEM')
606	RETURN ok
607
608	/*:VRX CreatePrinterObject
609	*/
610	/* Create the specified printer using SysCreateObject (this should create the
611	* queue automatically).
612	*
613	* Returns: 0 on success or non-zero return code on error.
614	*/
615	CreatePrinterObject: PROCEDURE EXPOSE globals.
616	PARSE ARG driver, model, portname, queuename, printername
617
618	CALL LINEOUT globals.!log1, 'Creating new printer:' printername '('queuename')'
619	ok = RPUPrinterCreate( printername, queuename, portname, driver'.'model )
620	RETURN ok
621
622	/*:VRX GetNameFromPPD
623	*/
624	GetNameFromPPD: PROCEDURE
625	ARG ppd_file
626
627	IF STREAM( ppd_file, 'C', 'QUERY EXISTS') == '' THEN RETURN ''
628	nickname = ''
629	IF VRParseFilePath( ppd_file, 'E') == 'GZ' THEN DO
630	nq = RXQUEUE('CREATE')
631	oq = RXQUEUE('SET', nq )
632	ADDRESS CMD '@gzip -c -d' ppd_file '\| RXQUEUE' nq
633	DO QUEUED()
634	PARSE PULL line
635	line = STRIP( line )
636	IF LEFT( line, 15 ) == '*ShortNickName:' THEN DO
637	PARSE VAR line . ':' _nick '0D'x .
638	nickname = STRIP( _nick )
639	nickname = STRIP( nickname, 'B', '09'x )
640	nickname = STRIP( nickname, 'B', '"')
641	LEAVE
642	END
643	END
644	CALL RXQUEUE 'SET', oq
645	CALL RXQUEUE 'DELETE', nq
646	END
647	ELSE DO
648	CALL LINEIN ppd_file, 1, 0
649	DO WHILE LINES( ppd_file ) <> 0
650	line = STRIP( LINEIN( ppd_file ))
651	IF LEFT( line, 15 ) == '*ShortNickName:' THEN DO
652	PARSE VAR line . ':' _nick '0D'x .
653	nickname = STRIP( _nick )
654	nickname = STRIP( nickname, 'B', '09'x )
655	nickname = STRIP( nickname, 'B', '"')
656	LEAVE
657	END
658	END
659	CALL STREAM ppd_file, 'C', 'CLOSE'
660	END
661	nickname = TRANSLATE( nickname, ' ', '"')
662	nickname = TRANSLATE( nickname, ' ', "'")
663
664	RETURN nickname
665
666	/*:VRX CleanPPD
667	*/
668	/* Clean out lines from Gutenprint and Foomatic PPD files that are known to
669	* cause problems when importing with PIN. (Partially based on work by Paul
670	* Smedley and Peter Brown).
671	*/
672	CleanPPD: PROCEDURE
673	PARSE ARG in_ppd, logfile
674	IF logfile <> '' THEN
675	logfile = STREAM( logfile, 'C', 'QUERY EXISTS')
676
677	out_ppd = VRParseFilePath( in_ppd, 'DPN') \|\| '.TMP'
678	IF STREAM( out_ppd, 'C', 'QUERY EXISTS') \= '' THEN
679	CALL SysFileDelete out_ppd
680
681	IF logfile <> '' THEN
682	CALL CHAROUT logfile, 'Doing cleanup on' in_ppd '...'
683
684	skip_next = 0
685	DO WHILE LINES( in_ppd ) \= 0
686	line = LINEIN( in_ppd )
687	SELECT
688	WHEN skip_next == 1 THEN DO
689	line = STRIP( TRANSLATE( line ))
690	IF line == '*END' THEN skip_next = 0
691	END
692	WHEN LEFT( line, 11 ) == '*StpDefault' THEN NOP
693	WHEN LEFT( line, 7 ) == '*StpStp' THEN NOP
694	WHEN LEFT( line, 18 ) == '*StpResolutionMap:' THEN NOP
695	WHEN LEFT( line, 14 ) == '*OPOptionHints' THEN NOP
696	WHEN LEFT( line, 4 ) == '*da.' THEN NOP
697	WHEN LEFT( line, 4 ) == '*de.' THEN NOP
698	WHEN LEFT( line, 4 ) == '*es.' THEN NOP
699	WHEN LEFT( line, 4 ) == '*fi.' THEN NOP
700	WHEN LEFT( line, 4 ) == '*fr.' THEN NOP
701	WHEN LEFT( line, 4 ) == '*it.' THEN NOP
702	WHEN LEFT( line, 4 ) == '*ja.' THEN NOP
703	WHEN LEFT( line, 4 ) == '*ko.' THEN NOP
704	WHEN LEFT( line, 4 ) == '*nb.' THEN NOP
705	WHEN LEFT( line, 4 ) == '*nl.' THEN NOP
706	WHEN LEFT( line, 4 ) == '*pt.' THEN NOP
707	WHEN LEFT( line, 4 ) == '*sv.' THEN NOP
708	WHEN LEFT( line, 7 ) == '*zh_CN.' THEN NOP
709	WHEN LEFT( line, 7 ) == '*zh_TW.' THEN NOP
710	WHEN LEFT( line, 9 ) == '*Foomatic' THEN DO
711	line = STRIP( line )
712	IF RIGHT( line, 2 ) == '&&' THEN skip_next = 1
713	END
714	OTHERWISE DO
715	CALL LINEOUT out_ppd, line
716	skip_next = 0
717	END
718	END
719	END
720	CALL STREAM in_ppd, 'C', 'CLOSE'
721	CALL STREAM out_ppd, 'C', 'CLOSE'
722
723	ok = VRCopyFile( out_ppd, in_ppd )
724	IF logfile <> '' THEN DO
725	IF ok == 1 THEN
726	CALL LINEOUT logfile, 'OK'
727	ELSE DO
728	CALL LINEOUT logfile, 'Failed!'
729	CALL LINEOUT logfile, ' ->' VRError()
730	END
731	CALL LINEOUT logfile, ''
732	END
733	CALL SysFileDelete out_ppd
734
735	RETURN
736
737	/*:VRX MatchPrinterModel
738	*/
739	/* Find a set of printers supported by the OS/2 driver which mostly closely
740	* match the given name.
741	*/
742	MatchPrinterModel: PROCEDURE EXPOSE globals. models.
743	PARSE UPPER ARG driver_name, printer_name
744	printer_name = TRANSLATE( printer_name, '_', '.')
745	printer_drv = globals.!os2dir'\DLL\'driver_name'\'driver_name'.DRV'
746	models.0 = 0
747
748	IF SysGetEA( printer_drv, '.EXPAND', 'exist_ea') <> 0 THEN RETURN 0
749	PARSE VAR exist_ea 1 _eatype 3 .
750	IF C2X( _eatype ) <> 'FDFF' THEN RETURN 0
751
752	PARSE VAR exist_ea 3 _ealen 5 exist_models
753	total_len = C2D( REVERSE( _ealen ))
754
755	/* The variable exist_models now contains a null-separated list of printer
756	* models supported by the driver (including those from previously-imported
757	* PPD files). Next we check each one against our requested printer name.
758	*/
759	start = 1
760	count = 0
761	best = 0
762	DO WHILE start < total_len
763	_strend = POS('0'x, exist_models, start )
764	IF _strend == 0 THEN LEAVE
765	_model = TRANSLATE( SUBSTR( exist_models, start, _strend - start ))
766	_model = TRANSLATE( _model, ' ', '-')
767	_comp = COMPARE( _model, printer_name )
768	IF WORD( _model, 1 ) == WORD( printer_name, 1 ) THEN DO
769	count = count + 1
770	IF _comp == 0 THEN DO
771	_comp = 9999
772	best = count
773	END
774	ELSE IF ( best == 0 ) & ( _comp > LENGTH( printer_name )) THEN
775	best = count
776	/*
777	models.count = RIGHT( _comp, 4, '0') SUBSTR( exist_models, start, _strend - start )
778	*/
779	models.count = SUBSTR( exist_models, start, _strend - start )
780	END
781	start = _strend + 1
782	END
783	models.0 = count
784
785	/*
786	CALL SysStemSort 'models.', 'D', 'I',,, 1, 4
787	DO i = 1 TO count
788	models.i = SUBWORD( models.i, 2 )
789	END
790	*/
791	RETURN best
792
793
794	/*:VRX CheckWritablePath
795	*/
796	CheckWritablePath: PROCEDURE EXPOSE globals.
797	ARG path
798
799	/* Make sure path exists & is a directory */
800	IF \VRIsDir( path ) THEN RETURN 1
801
802	/* Make sure the drive is accessible */
803	di = SysDriveInfo( VRParseFilePath( path, 'DP'))
804	IF di == '' THEN RETURN 2
805
806	/* Make sure the drive has a supported filesystem */
807	fs = SysFileSystemType( prdrv )
808	IF WORDPOS( fs, 'HPFS JFS FAT FAT32') == 0 THEN RETURN 3
809
810	RETURN 0
811
812
813	/*:VRX QueryAvailableDrivers
814	*/
815	/* Determine which of our supported PrinterPak drivers are currently available.
816	*/
817	QueryAvailableDrivers: PROCEDURE EXPOSE globals. drv_list.
818	drv_list.0 = 0
819
820	test_drivers = 'ECUPS ECUPS-HP PSPRINT'
821	DO i = 1 TO WORDS( test_drivers )
822	driver = WORD( test_drivers, i )
823	ok = GetDriverSource( driver )
824	IF ok == '' THEN
825	ok = VRGetIni('PM_DEVICE_DRIVERS', driver, 'USER')
826	IF ok <> '' THEN
827	CALL SysStemInsert 'drv_list.', drv_list.0+1, driver
828	END
829
830	RETURN drv_list.0
831
832
833	/*:VRX PinWrapper
834	*/
835	/* Wrapper for PIN, which performs the following tasks:
836	* - Create a temporary working directory & copy the PrinterPak files there.
837	* - Pre-process the PPD file to make it ready for import, and saves it in
838	* a driver-specific 'saved PPDs' directory for future use.
839	* - Uses PIN to import the PPD into our temporary working copy of the driver.
840	* - Copy the updated driver back to our installable copy.
841	* - If update_all is 1 then also do the following:
842	* - If the driver is actually installed, copy the updated driver back
843	* over the installed version as well.
844	* - If this is a 'shipped' driver (i.e. one listed in PRDRV.LST) then
845	* add the newly-defined printer to PRDESC.LST.
846	*/
847	PinWrapper: PROCEDURE EXPOSE globals. driver_path driver_repo
848	ARG update_all, driver, ppdfile
849
850	CALL LINEOUT globals.!log1, 'Driver source: ' driver_path
851
852	workdir = SysTempFileName( globals.!tmpdir'\PPD_????')
853	ok = VRMkDir( workdir )
854	IF ok == 1 THEN ok = VrMkDir( workdir'\OUT')
855	IF ok <> 1 THEN
856	RETURN 5 /** RC=5 failed to create directory */
857
858	CALL LINEOUT globals.!log1, 'Temporary directory: ' workdir
859
860	SELECT
861	WHEN driver == 'ECUPS' THEN ppddir = globals.!repository'\PPD_E'
862	WHEN driver == 'ECUPS-HP' THEN ppddir = globals.!repository'\PPD_EHP'
863	WHEN driver == 'PSPRINT' THEN ppddir = globals.!repository'\PPD_PS'
864	WHEN driver == 'PSPRINT2' THEN ppddir = globals.!repository'\PPD_PS2'
865	WHEN driver == 'PSCRIPT2' THEN ppddir = globals.!repository'\PPD2'
866	WHEN driver == 'GUTENPRT' THEN ppddir = globals.!repository'\PPD_GP'
867	OTHERWISE ppddir = globals.!repository'\PPD'
868	END
869
870	/* Make sure ppddir (for keeping PPD files) exists */
871	CALL SysFileTree ppddir, 'dirs.', 'DO'
872	IF dirs.0 == 0 THEN DO
873	IF ppdfile == '' THEN RETURN 0 /* No PPDs - nothing to do */
874	ok = VRMkDir( ppddir )
875	IF ok <> 1 THEN
876	RETURN 5 /** RC=5 failed to create directory */
877	END
878
879	CALL LINEOUT globals.!log1, 'Directory for PPD files:' ppddir
880
881	/***
882	*** Now do the actual work.
883	***/
884
885	/* Copy the needed driver files to our working directories.
886	*/
887	drvr_dir = VRParseFileName( driver_path, 'DP')
888	drv_out = workdir'\OUT\'driver'.DRV'
889	pin_exe = workdir'\PIN.EXE'
890	ppd_exe = workdir'\PPDENC.EXE'
891	ok = VRCopyFile( driver_path, drv_out )
892	IF ok == 1 THEN ok = VRCopyFile( drvr_dir'\PIN.EXE', pin_exe )
893	IF ok == 1 THEN ok = VRCopyFile( drvr_dir'\PPDENC.EXE', ppd_exe )
894	IF ok == 0 THEN DO
895	RETURN 4 /* RC=4 Failed to copy driver files */
896	END
897
898	/* Set up the output redirection.
899	*/
900	nq = RXQUEUE('CREATE')
901	oq = RXQUEUE('SET', nq )
902
903	/* If we are importing a new PPD file, prep it first.
904	* (If ppdfile is undefined, it means we are reimporting a directory of
905	* previously-imported PPDs, and we can assume they are already prepped.)
906	*/
907	IF ppdfile <> '' THEN DO
908
909	/* If the PPD file is compressed, uncompress it.
910	*/
911	IF VRParseFilePath( ppdfile, 'E') == 'GZ' THEN DO
912	decppd = workdir'\' \|\| VRParseFilePath( ppdfile, 'N')
913	CALL LINEOUT globals.!log1, 'Decompressing' ppdfile 'to' decppd
914	ADDRESS CMD '@'globals.!programs.!gzip '-c -d' ppdfile '\| RXQUEUE' nq
915	DO QUEUED()
916	PARSE PULL line
917	CALL LINEOUT decppd, line
918	END
919	CALL LINEOUT decppd
920	ppdfile = decppd
921	END
922
923	IF VRFileExists( ppdfile ) == 0 THEN DO
924	CALL LINEOUT globals.!log1, 'PPD file' ppdfile 'could not be found.'
925	RETURN 6 / RC=6 PPD import failed /
926	END
927
928	ppd_use = ppddir'\' \|\| VRParseFileName( ppdfile, 'NE')
929
930	/* Now we have to clean up and validate the PPD file so PIN can use it.
931	* First, PPDENC converts the codepage if necessary, and copies the results
932	* to our working directory.
933	*/
934	CALL LINEOUT globals.!log1, 'Converting PPD with:' ppd_exe '"'ppdfile'" "'ppd_use'"'
935	ADDRESS CMD '@'ppd_exe '"'ppdfile'" "'ppd_use'" 2>NUL \| RXQUEUE' nq
936	DO QUEUED()
937	PULL output
938	CALL LINEOUT globals.!log2, output
939	END
940	CALL LINEOUT globals.!log2, ''
941	CALL LINEOUT globals.!log2
942
943	IF VRFileExists( ppd_use ) == 0 THEN DO
944	CALL LINEOUT globals.!log1, 'Hmm,' ppd_use 'was not created. Copying manually.'
945	CALL VRCopyFile ppdfile, ppd_use
946	END
947
948	/* Next we strip out some problematic PPD statements which are often
949	* encountered in (for example) CUPS-based PPD files.
950	*/
951	CALL CleanPPD ppd_use, globals.!log1
952
953	END
954
955	/* Preparation complete. Now do the import.
956	*/
957	count = 0
958	ADDRESS CMD '@'pin_exe 'ppd' ppddir drv_out '2>NUL \| RXQUEUE' nq
959	DO QUEUED()
960	PARSE PULL output
961	CALL LINEOUT globals.!log2, output
962	PARSE VAR output . 'OK (' nickname
963	IF nickname <> '' THEN DO
964	count = count + 1
965	newprinters.count = STRIP( nickname, 'T', ')')
966	END
967	END
968	newprinters.0 = count
969	CALL LINEOUT globals.!log2, ''
970	CALL LINEOUT globals.!log2
971
972	/* End the output redirection.
973	*/
974	CALL RXQUEUE 'SET', oq
975	CALL RXQUEUE 'DELETE', nq
976
977	IF newprinters.0 == 0 THEN DO
978	RETURN 6 / RC=6 PPD import failed /
979	END
980
981	/***
982	*** Post-import processing.
983	***/
984
985	IF ( driver_repo == 1 ) & ( update_all <> 0 ) THEN DO
986	/* If we're working out of the repository, we need to update the
987	* driver table in PRDESC.LST to add the new driver(s).
988	*/
989
990	CALL LINEOUT globals.!log1, 'Updating' globals.!prdesc 'with new entries from' drv_out
991
992	/* -- This causes a SYS3175 in the .DRV for some reason...
993	ok = UpdatePrDesc( driver'.DRV', drv_out )
994	IF ok <> 0 THEN
995	CALL LINEOUT globals.!log1, 'Failed to update' globals.!prdesc '(are EAs on' drv_out ' valid?)'
996	*/
997
998	count = 0
999
1000	/* First, copy all lines that don't refer to the driver just updated */
1001	CALL LINEIN globals.!prdesc, 1, 0
1002	DO WHILE LINES( globals.!prdesc )
1003	_next = LINEIN( globals.!prdesc )
1004	PARSE UPPER VAR _next . ':' _rest
1005	_tail = LASTPOS('(', _rest )
1006	PARSE VAR _rest =(_tail) '('_prdrv')' .
1007	IF _prdrv == driver'.DRV' THEN ITERATE
1008	count = count + 1
1009	defs.count = _next
1010	END
1011	CALL STREAM globals.!prdesc, 'C', 'CLOSE'
1012
1013	/* Next, create a new list for the updated driver and merge that in */
1014	newlist = workdir'\'driver'.LST'
1015	CALL CreateDriverList drv_out, newlist
1016	DO WHILE LINES( newlist )
1017	_line = LINEIN( newlist )
1018	count = count + 1
1019	defs.count = _line
1020	END
1021	CALL STREAM newlist, 'C', 'CLOSE'
1022	defs.0 = count
1023
1024	/* Now sort the list and recreate PRDESC.LST */
1025	CALL SysStemSort 'defs.',, 'I'
1026	prdesc_tmp = workdir'\PRDESC.LST'
1027	IF STREAM( prdesc_tmp, 'C', 'QUERY EXISTS') <> '' THEN
1028	CALL VRDeleteFile prdesc_tmp
1029	DO i = 1 TO defs.0
1030	CALL LINEOUT prdesc_tmp, defs.i
1031	END
1032	CALL LINEOUT prdesc_tmp
1033	ok = VRCopyFile( prdesc_tmp, globals.!prdesc )
1034	IF ok == 0 THEN DO
1035	RETURN 7 / RC=7 Error updating PRDESC.LST /
1036	END
1037	CALL VRDeleteFile prdesc_tmp
1038
1039	END
1040
1041	/* Finally, copy the updated driver files.
1042	*/
1043	target = VRParseFilePath( driver_path, 'DP')
1044	CALL LINEOUT globals.!log1, 'Copying files from' workdir'\OUT to' target
1045	CALL PRReplaceModule target'\'driver'.DRV', '', ''
1046	ok = VRCopyFile( workdir'\OUT\'driver'.DRV', target'\'driver'.DRV')
1047	IF ok == 1 THEN
1048	ok = VRCopyFile( workdir'\OUT\AUXPRINT.PAK', target'\AUXPRINT.PAK')
1049
1050	IF ( ok == 1 ) & ( update_all <> 0 ) THEN DO
1051	/* Copy the updated files to \OS2\DLL\<driver>, replacing any
1052	* existing copies. (This prevents problems if the OS/2 driver
1053	* installation fails to copy them, which can happen under some
1054	* circumstances.)
1055	*/
1056	IF VRFileExists( globals.!os2dir'\DLL\'driver'\'driver'.DRV') THEN DO
1057	CALL VRCopyFile workdir'\OUT\AUXPRINT.PAK',,
1058	globals.!os2dir'\DLL\'driver'\AUXPRINT.PAK'
1059	CALL PRReplaceModule globals.!os2dir'\DLL\'driver'\'driver'.DRV', '', ''
1060	CALL VRCopyFile workdir'\OUT\'driver'.DRV', globals.!os2dir'\DLL\'driver'\'driver'.DRV'
1061	END
1062	END
1063	IF ok == 0 THEN DO
1064	CALL LINEOUT globals.!log1, VRError()
1065	RETURN 4 /* RC=4 Failed to copy driver files */
1066	END
1067
1068	CALL LINEOUT globals.!log1, newprinters.0 'printers imported successfully.'
1069	DO i = 1 TO newprinters.0
1070	CALL LINEOUT globals.!log1, ' ->' newprinters.i
1071	END
1072	CALL LINEOUT globals.!log1, ''
1073	CALL LINEOUT globals.!log1
1074
1075	/* Clean up our work directories.
1076	*/
1077	CALL VRDeleteFile workdir'\OUT\*'
1078	CALL VRDeleteFile workdir'\*'
1079	CALL VRRmDir( workdir'\OUT')
1080	CALL VRRmDir( workdir )
1081
1082	RETURN 0
1083
1084
1085	/*:VRX UpdatePrDesc
1086	*/
1087	UpdatePrDesc: PROCEDURE EXPOSE globals.
1088	ARG driver, fqn
1089
1090	IF globals.!prdesc == '' THEN RETURN 1
1091
1092	ok = RPUEnumModels( fqn, 'newdevs.')
1093	IF ok == 0 THEN RETURN 2
1094
1095	_count = 0
1096	CALL LINEIN globals.!prdesc, 1, 0
1097	DO WHILE LINES( globals.!prdesc )
1098	_next = LINEIN( globals.!prdesc )
1099	PARSE UPPER VAR _next WITH . ':' . '('_prdrv')' .
1100	IF _prdrv == driver THEN ITERATE
1101	_count = _count + 1
1102	prdefs.count = _next
1103	END
1104	CALL STREAM globals.!prdesc, 'C', 'CLOSE'
1105
1106	DO i = 1 TO newdevs.0
1107	_count = _count + 1
1108	prdefs._count = newdevs.i':' newdevs.i '('driver')'
1109	END
1110	prdefs.0 = count
1111
1112	CALL VRSortStem 'prdefs.'
1113
1114	_prdir = VRParseFileName( globals.!prdesc, 'DP')
1115	CALL VRCopyFile globals.!prdesc, _prdir'\PRDESC.BAK'
1116	CALL VRDeleteFile globals.!prdesc
1117	DO i = 1 TO prdefs.0
1118	CALL LINEOUT globals.!prdesc, prdefs.i
1119	END
1120	CALL LINEOUT globals.!prdesc
1121
1122	RETURN 0
1123
1124
1125	/*:VRX NLSGetMessage
1126	*/
1127	/*
1128	* Gets the message text associated with the given message number from the
1129	* current language file.
1130	*/
1131	NLSGetMessage: PROCEDURE EXPOSE globals.
1132	PARSE ARG msgnum, .
1133	args = ARG()
1134
1135	msgfile = globals.!messages
1136	IF msgnum == '' THEN RETURN ''
1137
1138	sub_parms = ''
1139	DO i = 2 TO args
1140	sub_parms = sub_parms', "'ARG( i )'"'
1141	END
1142
1143	INTERPRET 'msgfromfile = SysGetMessage( msgnum, msgfile' sub_parms ')'
1144
1145	PARSE VAR msgfromfile message '0D'x .
1146	IF SUBSTR( message, 1, 4 ) == 'SYS0' THEN message = ''
1147
1148	RETURN message
1149
1150
1151	/*:VRX NLSSetText
1152	*/
1153	/*
1154	* Sets the specified property of the specified control to the specified
1155	* message text.
1156	*/
1157	NLSSetText: PROCEDURE EXPOSE globals.
1158	PARSE ARG control, property, message, substitution
1159	args = ARG()
1160
1161	success = 1
1162	IF args < 4 THEN
1163	text = NLSGetMessage( message )
1164	ELSE DO
1165	sub_parms = ''
1166	DO i = 4 TO args
1167	sub_parms = sub_parms '"'\|\| ARG( i ) \|\|'",'
1168	END
1169	sub_parms = STRIP( sub_parms, 'T', ',')
1170	INTERPRET 'text = NLSGetMessage( message, 'sub_parms')'
1171	END
1172
1173	IF text == '' THEN success = 0
1174	ELSE CALL VRSet control, property, text
1175
1176	RETURN success
1177
1178	/*:VRX StringTokenize
1179	*/
1180	StringTokenize:
1181	PARSE ARG string, separator, __stem
1182	CALL __StringTokenize string, separator, __stem
1183	DROP __stem
1184	RETURN
1185
1186	/*:VRX __StringTokenize
1187	*/
1188	__StringTokenize: PROCEDURE EXPOSE (__stem)
1189	PARSE ARG string, separator, tokens
1190
1191	/* Note: this differs slightly from my usual implementation in that
1192	* each token is STRIPped of leading and trailing spaces.
1193	*/
1194
1195	IF ( string = '') THEN RETURN string
1196	IF ( separator = '') THEN separator = ' '
1197
1198	i = 0
1199	CALL VALUE tokens \|\| '0', i
1200	DO WHILE LENGTH( string ) > 0
1201	x = 1
1202	y = POS( separator, string, x )
1203	IF y > 0 THEN DO
1204	current = SUBSTR( string, 1, y-1 )
1205	x = y + 1
1206	i = i + 1
1207	CALL VALUE tokens \|\| 'i', STRIP( current )
1208	END
1209	ELSE DO
1210	current = STRIP( string, 'B', separator )
1211	i = i + 1
1212	CALL VALUE tokens \|\| 'i', STRIP( current )
1213	x = LENGTH( string ) + 1
1214	END
1215	string = SUBSTR( string, x )
1216	END
1217	CALL VALUE tokens \|\| '0', i
1218
1219	RETURN
1220

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format