Context Navigation

PrManUtl.VRS@ 83

Last change on this file since 83 was 83, checked in by Alex Taylor, 7 years ago
PrintMan: minor housekeeping.
File size: 41.6 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	/* DEPRECATED: do not use
360	* Determine if the specified PrinterPak driver already contains support
361	* for the specified printer model.
362	*
363	* If so, return the name of the model as found in the driver (necessary in
364	* order to make sure the correct case is retained, which may be different
365	* from what was requested). Otherwise return ''.
366	*/
367	PrinterExistsInDRV: PROCEDURE EXPOSE globals.
368	PARSE UPPER ARG driver_name, printer_name
369	printer_name = TRANSLATE( printer_name, '_', '.')
370
371	printer_drv = globals.!os2dir'\DLL\'driver_name'\'driver_name'.DRV'
372	/* ?? TODO: install driver_name if not found (prompt first) ?? */
373
374	IF SysGetEA( printer_drv, '.EXPAND', 'exist_ea') <> 0 THEN RETURN 0
375	PARSE VAR exist_ea 1 _eatype 3 .
376	IF C2X( _eatype ) <> 'FDFF' THEN RETURN 0
377
378	PARSE VAR exist_ea 3 _ealen 5 exist_models
379	total_len = C2D( REVERSE( _ealen ))
380
381	/* The variable exist_models now contains a null-separated list of printer
382	* models supported by the driver (including those from previously-imported
383	* PPD files). Next we check each one against our requested printer name.
384	*/
385	start = 1
386	found = ''
387	DO WHILE ( found == '') & ( start < total_len )
388	_strend = POS('0'x, exist_models, start )
389	IF _strend == 0 THEN LEAVE
390	_model = SUBSTR( exist_models, start, _strend - start )
391	IF TRANSLATE( _model ) == printer_name THEN
392	found = _model
393	ELSE
394	start = _strend + 1
395	END
396
397	RETURN found
398
399
400	/*:VRX CreateDriverList
401	*/
402	/* Generate a driver listfile from the .EXPAND EA
403	*/
404	CreateDriverList: PROCEDURE EXPOSE globals.
405	ARG driver, listfile
406
407	IF STREAM( listfile, 'C', 'QUERY EXISTS') <> '' THEN
408	CALL SysFileDelete listfile
409
410	drv_name = FILESPEC('NAME', driver )
411	IF SysGetEA( driver, '.EXPAND', 'eaval') == 0 THEN DO
412	PARSE VAR eaval 3 ealen 5 models
413	offs = 1
414	datalen = C2D( REVERSE( ealen ))
415	DO WHILE offs <= datalen
416	start = SUBSTR( models, offs )
417	inc = POS('00'x, start )
418	IF inc > 1 THEN DO
419	current_name = STRIP( SUBSTR( start, 1, inc-1 ))
420	CALL LINEOUT listfile, current_name':' current_name '('drv_name')'
421	END
422	offs = offs + inc
423	END
424	CALL LINEOUT listfile
425	CALL LINEOUT globals.!log1, 'Created driver list' listfile 'for' driver'.'
426	END
427	ELSE
428	CALL LINEOUT globals.!log1, 'No drivers found in' driver '(missing .EXPAND extended attribute?)'
429
430	RETURN 1
431
432
433	/*:VRX AddPort_CUPS
434	*/
435	/* Adds a new CUPS port. Returns 0 on full success, 1 if the port was created
436	* but could not be configured, and an OS/2 or PM error code otherwise.
437	*/
438	AddPort_CUPS: PROCEDURE EXPOSE globals.
439	PARSE ARG portname, hostname, queuename
440	CALL LINEOUT globals.!log1, 'Creating new port' portname
441	ADDRESS CMD '@cupsport' portname hostname queuename '>>' globals.!log2
442	IF rc == 1 THEN DO
443	CALL VRSetIni 'PM_'portname, 'INITIALIZATION', hostname'#'queuename\|\|'00'x, 'SYSTEM', 'NoClose'
444	CALL VRSetIni 'PM_'portname, 'DESCRIPTION', hostname':'queuename\|\|'00'x, 'SYSTEM'
445	END
446	RETURN rc
447
448
449	/*:VRX DeletePort
450	*/
451	/* Deletes a printer port (any type).
452	*/
453	DeletePort: PROCEDURE EXPOSE globals.
454	PARSE ARG portname
455	CALL SysIni 'SYSTEM', 'PM_'portname, 'DELETE:'
456	CALL SysIni 'SYSTEM', 'PM_SPOOLER_PORT', portname, 'DELETE:'
457	RETURN 1
458
459
460	/*:VRX GetNextPortName
461	*/
462	/* Get the next unique (non-existing) port name for the specified port driver.
463	*/
464	GetNextPortName: PROCEDURE
465	ARG portdrv
466
467	maxports = 64 /* should be smarter about this if possible */
468	exists = 1
469	x = 0
470	DO WHILE ( x < maxports ) & ( exists == 1 )
471	x = x + 1
472	portname = portdrv \|\| x
473	nextport = SysIni('SYSTEM', 'PM_SPOOLER_PORT', portname )
474	IF LEFT( nextport, 6 ) == 'ERROR:' THEN exists = 0
475	END
476	IF exists == 1 THEN
477	portname = ''
478
479	RETURN portname
480
481
482	/*:VRX GetPortDrivers
483	*/
484	/* Get the list of currently-installed port drivers. NOTE: we exclude LPRPDRVR
485	* from this list, because it has to be managed via the TCP/IP configuration
486	* program.
487	*/
488	GetPortDrivers: PROCEDURE EXPOSE portdrivers.
489	ok = SysIni('SYSTEM', 'PM_PORT_DRIVER', 'ALL:', 'installed.')
490	IF LEFT( ok, 6 ) == 'ERROR:' THEN RETURN 0
491	count = 0
492	DO i = 1 TO installed.0
493	IF installed.i = 'LPRPDRVR' THEN ITERATE
494	fullpath = STRIP( SysIni('SYSTEM', 'PM_PORT_DRIVER', installed.i ), 'T', '00'x )
495	IF LEFT( fullpath, 6 ) == 'ERROR:' THEN fullpath = ''
496	fullpath = STREAM( fullpath , 'C', 'QUERY EXISTS')
497	count = count + 1
498	portdrivers.count = installed.i \|\| ' ' \|\| fullpath
499	END
500	portdrivers.0 = count
501	RETURN portdrivers.0
502
503
504	/*:VRX GetQueueName
505	*/
506	/* Generate a unique queue name from the specified printer name.
507	*/
508	GetQueueName: PROCEDURE
509	ARG queuename
510
511	DO UNTIL badchar = 0
512	badchar = VERIFY( queuename, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ-_0123456789 ')
513	IF badchar > 0 THEN
514	queuename = OVERLAY(' ', queuename, badchar, 1 )
515	END
516	queuename = LEFT( SPACE( queuename, 0 ), 8 )
517
518	tail = 0
519	PARSE VALUE VRGetIni('PM_SPOOLER', 'DIR', 'SYSTEM') WITH spldir ';' .
520	DO WHILE VRFileExists( spldir'\'queuename ) == 1
521	tail = tail + 1
522	queuename = STRIP( LEFT( queuename, 8 - LENGTH( tail ))) \|\| tail
523	END
524
525	RETURN queuename
526
527
528	/*:VRX InstallPortDriver
529	*/
530	/* Installs a new port driver.
531	*
532	* Returns: 0 on success, 1 on error
533	*/
534	InstallPortDriver: PROCEDURE EXPOSE globals.
535	ARG new_pdr
536	filename = VRParseFileName( new_pdr, 'NE')
537	IF filename == '' THEN RETURN
538	installed_pdr = TRANSLATE( globals.!os2dir'\DLL\'filename )
539	IF installed_pdr <> new_pdr THEN DO
540	ok = VRCopyFile( new_pdr, installed_pdr )
541	IF ok == 0 THEN RETURN 1
542	/* Try to copy any optional files as well */
543	IF SysGetEA( new_pdr, 'OPTIONALDRIVERFILES', 'reqfiles') == 0 THEN DO
544	drv_dir = VRParseFilePath( new_pdr, 'DP')
545	PARSE VAR reqfiles 5 filelist
546	filelist = TRANSLATE( filelist, ' ', ',')
547	DO i = 1 TO WORDS( filelist )
548	copyfile = drv_dir'\' \|\| WORD( filelist, i )
549	IF STREAM( copyfile, 'C', 'QUERY EXISTS') == '' THEN ITERATE
550	ok = VRCopyFile( copyfile, newdrvdir'\' \|\| WORD( filelist, i ))
551	/CALL LINEOUT globals.!log1, ' -' copyfile '(OPTIONAL):' ok/
552	END
553	END
554	END
555
556	key = VRParseFileName( installed_pdr, 'N')
557	CALL VRSetIni 'PM_PORT_DRIVER', key, installed_pdr\|\|'00'x, 'SYSTEM'
558	RETURN 0
559
560
561	/*:VRX InstallPrintDriver
562	*/
563	/* 'Installs' (that is to say, registers with the spooler) an OS printer
564	* device driver/model. Installs the corresponding printerpak driver if
565	* necessary.
566	*
567	* driver - The name of the printerpak driver (without path or extension)
568	* driverfull - The fully-qualified filename of the printerpak driver
569	* model - The printer make/model name used by the driver
570	*
571	* Returns: 0 on success, 1 on error
572	*/
573	InstallPrintDriver: PROCEDURE EXPOSE globals.
574	PARSE ARG driver, driverfull, model
575
576	ok = 0
577	targetdir = globals.!os2dir'\DLL\'driver
578	targetdrv = targetdir'\'driver'.DRV'
579	CALL LINEOUT globals.!log1, 'Installing' driver'.'model 'from' driverfull '(target' targetdrv')'
580
581	IF ( VRFileExists( targetdrv ) == 0 ) THEN DO
582	CALL VRMkDir targetdir
583	r = CopyPrinterPak( driverfull, targetdir )
584	IF r <> 1 THEN ok = 1
585	END
586	IF ok == 0 THEN DO
587	IF VRGetIni('PM_DEVICE_DRIVERS', driver, 'USER') <> targetdrv THEN
588	CALL VRSetIni 'PM_DEVICE_DRIVERS', driver, targetdrv\|\|'00'x, 'USER'
589	CALL VRSetIni 'PM_SPOOLER_DD', driver'.'model, driver'.DRV;;;'\|\|'00'x, 'SYSTEM'
590	END
591	RETURN ok
592
593	/*:VRX DeletePrintDriver
594	*/
595	/* Removes (that is to say, de-registers with the spooler) a PM printer
596	* device driver/model.
597	*
598	* driver - The name of the printerpak driver (without path or extension)
599	* model - The printer make/model name used by the driver
600	*
601	* Returns: 0 on success, 1 on error
602	*/
603	DeletePrintDriver: PROCEDURE EXPOSE globals.
604	PARSE ARG driver, model
605
606	ok = VRDelIni('PM_SPOOLER_DD', driver'.'model, 'SYSTEM')
607	RETURN ok
608
609	/*:VRX CreatePrinterObject
610	*/
611	/* Create the specified printer using SysCreateObject (this should create the
612	* queue automatically).
613	*
614	* Returns: 0 on success or non-zero return code on error.
615	*/
616	CreatePrinterObject: PROCEDURE EXPOSE globals.
617	PARSE ARG driver, model, portname, queuename, printername
618
619	CALL LINEOUT globals.!log1, 'Creating new printer:' printername '('queuename')'
620	ok = RPUPrinterCreate( printername, queuename, portname, driver'.'model )
621	RETURN ok
622
623	/*:VRX GetNameFromPPD
624	*/
625	GetNameFromPPD: PROCEDURE
626	ARG ppd_file
627
628	IF STREAM( ppd_file, 'C', 'QUERY EXISTS') == '' THEN RETURN ''
629	nickname = ''
630	IF VRParseFilePath( ppd_file, 'E') == 'GZ' THEN DO
631	nq = RXQUEUE('CREATE')
632	oq = RXQUEUE('SET', nq )
633	ADDRESS CMD '@gzip -c -d' ppd_file '\| RXQUEUE' nq
634	DO QUEUED()
635	PARSE PULL line
636	line = STRIP( line )
637	IF LEFT( line, 15 ) == '*ShortNickName:' THEN DO
638	PARSE VAR line . ':' _nick '0D'x .
639	nickname = STRIP( _nick )
640	nickname = STRIP( nickname, 'B', '09'x )
641	nickname = STRIP( nickname, 'B', '"')
642	LEAVE
643	END
644	END
645	CALL RXQUEUE 'SET', oq
646	CALL RXQUEUE 'DELETE', nq
647	END
648	ELSE DO
649	CALL LINEIN ppd_file, 1, 0
650	DO WHILE LINES( ppd_file ) <> 0
651	line = STRIP( LINEIN( ppd_file ))
652	IF LEFT( line, 15 ) == '*ShortNickName:' THEN DO
653	PARSE VAR line . ':' _nick '0D'x .
654	nickname = STRIP( _nick )
655	nickname = STRIP( nickname, 'B', '09'x )
656	nickname = STRIP( nickname, 'B', '"')
657	LEAVE
658	END
659	END
660	CALL STREAM ppd_file, 'C', 'CLOSE'
661	END
662	nickname = TRANSLATE( nickname, ' ', '"')
663	nickname = TRANSLATE( nickname, ' ', "'")
664
665	RETURN nickname
666
667	/*:VRX CleanPPD
668	*/
669	/* Clean out lines from Gutenprint and Foomatic PPD files that are known to
670	* cause problems when importing with PIN. (Partially based on work by Paul
671	* Smedley and Peter Brown).
672	*/
673	CleanPPD: PROCEDURE
674	PARSE ARG in_ppd, logfile
675	IF logfile <> '' THEN
676	logfile = STREAM( logfile, 'C', 'QUERY EXISTS')
677
678	out_ppd = VRParseFilePath( in_ppd, 'DPN') \|\| '.TMP'
679	IF STREAM( out_ppd, 'C', 'QUERY EXISTS') \= '' THEN
680	CALL SysFileDelete out_ppd
681
682	IF logfile <> '' THEN
683	CALL CHAROUT logfile, 'Doing cleanup on' in_ppd '...'
684
685	skip_next = 0
686	DO WHILE LINES( in_ppd ) \= 0
687	line = LINEIN( in_ppd )
688	SELECT
689	WHEN skip_next == 1 THEN DO
690	line = STRIP( TRANSLATE( line ))
691	IF line == '*END' THEN skip_next = 0
692	END
693	WHEN LEFT( line, 11 ) == '*StpDefault' THEN NOP
694	WHEN LEFT( line, 7 ) == '*StpStp' THEN NOP
695	WHEN LEFT( line, 18 ) == '*StpResolutionMap:' THEN NOP
696	WHEN LEFT( line, 14 ) == '*OPOptionHints' THEN NOP
697	WHEN LEFT( line, 4 ) == '*da.' THEN NOP
698	WHEN LEFT( line, 4 ) == '*de.' THEN NOP
699	WHEN LEFT( line, 4 ) == '*es.' THEN NOP
700	WHEN LEFT( line, 4 ) == '*fi.' THEN NOP
701	WHEN LEFT( line, 4 ) == '*fr.' THEN NOP
702	WHEN LEFT( line, 4 ) == '*it.' THEN NOP
703	WHEN LEFT( line, 4 ) == '*ja.' THEN NOP
704	WHEN LEFT( line, 4 ) == '*ko.' THEN NOP
705	WHEN LEFT( line, 4 ) == '*nb.' THEN NOP
706	WHEN LEFT( line, 4 ) == '*nl.' THEN NOP
707	WHEN LEFT( line, 4 ) == '*pt.' THEN NOP
708	WHEN LEFT( line, 4 ) == '*sv.' THEN NOP
709	WHEN LEFT( line, 7 ) == '*zh_CN.' THEN NOP
710	WHEN LEFT( line, 7 ) == '*zh_TW.' THEN NOP
711	WHEN LEFT( line, 9 ) == '*Foomatic' THEN DO
712	line = STRIP( line )
713	IF RIGHT( line, 2 ) == '&&' THEN skip_next = 1
714	END
715	OTHERWISE DO
716	CALL LINEOUT out_ppd, line
717	skip_next = 0
718	END
719	END
720	END
721	CALL STREAM in_ppd, 'C', 'CLOSE'
722	CALL STREAM out_ppd, 'C', 'CLOSE'
723
724	ok = VRCopyFile( out_ppd, in_ppd )
725	IF logfile <> '' THEN DO
726	IF ok == 1 THEN
727	CALL LINEOUT logfile, 'OK'
728	ELSE DO
729	CALL LINEOUT logfile, 'Failed!'
730	CALL LINEOUT logfile, ' ->' VRError()
731	END
732	CALL LINEOUT logfile, ''
733	END
734	CALL SysFileDelete out_ppd
735
736	RETURN
737
738	/*:VRX MatchPrinterModel
739	*/
740	/* Find a set of printers supported by the OS/2 driver which mostly closely
741	* match the given name.
742	*/
743	MatchPrinterModel: PROCEDURE EXPOSE globals. models.
744	PARSE UPPER ARG driver_name, printer_name
745	printer_name = TRANSLATE( printer_name, '_', '.')
746	printer_drv = globals.!os2dir'\DLL\'driver_name'\'driver_name'.DRV'
747	models.0 = 0
748
749	IF SysGetEA( printer_drv, '.EXPAND', 'exist_ea') <> 0 THEN RETURN 0
750	PARSE VAR exist_ea 1 _eatype 3 .
751	IF C2X( _eatype ) <> 'FDFF' THEN RETURN 0
752
753	PARSE VAR exist_ea 3 _ealen 5 exist_models
754	total_len = C2D( REVERSE( _ealen ))
755
756	/* The variable exist_models now contains a null-separated list of printer
757	* models supported by the driver (including those from previously-imported
758	* PPD files). Next we check each one against our requested printer name.
759	*/
760	start = 1
761	count = 0
762	best = 0
763	DO WHILE start < total_len
764	_strend = POS('0'x, exist_models, start )
765	IF _strend == 0 THEN LEAVE
766	_model = TRANSLATE( SUBSTR( exist_models, start, _strend - start ))
767	_model = TRANSLATE( _model, ' ', '-')
768	_comp = COMPARE( _model, printer_name )
769	IF WORD( _model, 1 ) == WORD( printer_name, 1 ) THEN DO
770	count = count + 1
771	IF _comp == 0 THEN DO
772	_comp = 9999
773	best = count
774	END
775	ELSE IF ( best == 0 ) & ( _comp > LENGTH( printer_name )) THEN
776	best = count
777	/*
778	models.count = RIGHT( _comp, 4, '0') SUBSTR( exist_models, start, _strend - start )
779	*/
780	models.count = SUBSTR( exist_models, start, _strend - start )
781	END
782	start = _strend + 1
783	END
784	models.0 = count
785
786	/*
787	CALL SysStemSort 'models.', 'D', 'I',,, 1, 4
788	DO i = 1 TO count
789	models.i = SUBWORD( models.i, 2 )
790	END
791	*/
792	RETURN best
793
794
795	/*:VRX CheckWritablePath
796	*/
797	CheckWritablePath: PROCEDURE EXPOSE globals.
798	ARG path
799
800	/* Make sure path exists & is a directory */
801	IF \VRIsDir( path ) THEN RETURN 1
802
803	/* Make sure the drive is accessible */
804	di = SysDriveInfo( VRParseFilePath( path, 'DP'))
805	IF di == '' THEN RETURN 2
806
807	/* Make sure the drive has a supported filesystem */
808	fs = SysFileSystemType( prdrv )
809	IF WORDPOS( fs, 'HPFS JFS FAT FAT32') == 0 THEN RETURN 3
810
811	RETURN 0
812
813
814	/*:VRX QueryAvailableDrivers
815	*/
816	/* Determine which of our supported PrinterPak drivers are currently available.
817	*/
818	QueryAvailableDrivers: PROCEDURE EXPOSE globals. drv_list.
819	drv_list.0 = 0
820
821	test_drivers = 'ECUPS ECUPS-HP PSPRINT'
822	DO i = 1 TO WORDS( test_drivers )
823	driver = WORD( test_drivers, i )
824	ok = GetDriverSource( driver )
825	IF ok == '' THEN
826	ok = VRGetIni('PM_DEVICE_DRIVERS', driver, 'USER')
827	IF ok <> '' THEN
828	CALL SysStemInsert 'drv_list.', drv_list.0+1, driver
829	END
830
831	RETURN drv_list.0
832
833
834	/*:VRX PinWrapper
835	*/
836	/* Wrapper for PIN, which performs the following tasks:
837	* - Create a temporary working directory & copy the PrinterPak files there.
838	* - Pre-process the PPD file to make it ready for import, and saves it in
839	* a driver-specific 'saved PPDs' directory for future use.
840	* - Uses PIN to import the PPD into our temporary working copy of the driver.
841	* - Copy the updated driver back to our installable copy.
842	* - If update_all is 1 then also do the following:
843	* - If the driver is actually installed, copy the updated driver back
844	* over the installed version as well.
845	* - If this is a 'shipped' driver (i.e. one listed in PRDRV.LST) then
846	* add the newly-defined printer to PRDESC.LST.
847	*/
848	PinWrapper: PROCEDURE EXPOSE globals. driver_path driver_repo
849	ARG update_all, driver, ppdfile
850
851	CALL LINEOUT globals.!log1, 'Driver source: ' driver_path
852
853	workdir = SysTempFileName( globals.!tmpdir'\PPD_????')
854	ok = VRMkDir( workdir )
855	IF ok == 1 THEN ok = VrMkDir( workdir'\OUT')
856	IF ok <> 1 THEN
857	RETURN 5 /** RC=5 failed to create directory */
858
859	CALL LINEOUT globals.!log1, 'Temporary directory: ' workdir
860
861	SELECT
862	WHEN driver == 'ECUPS' THEN ppddir = globals.!repository'\PPD_E'
863	WHEN driver == 'ECUPS-HP' THEN ppddir = globals.!repository'\PPD_EHP'
864	WHEN driver == 'PSPRINT' THEN ppddir = globals.!repository'\PPD_PS'
865	WHEN driver == 'PSPRINT2' THEN ppddir = globals.!repository'\PPD_PS2'
866	WHEN driver == 'PSCRIPT2' THEN ppddir = globals.!repository'\PPD2'
867	WHEN driver == 'GUTENPRT' THEN ppddir = globals.!repository'\PPD_GP'
868	OTHERWISE ppddir = globals.!repository'\PPD'
869	END
870
871	/* Make sure ppddir (for keeping PPD files) exists */
872	CALL SysFileTree ppddir, 'dirs.', 'DO'
873	IF dirs.0 == 0 THEN DO
874	IF ppdfile == '' THEN RETURN 0 /* No PPDs - nothing to do */
875	ok = VRMkDir( ppddir )
876	IF ok <> 1 THEN
877	RETURN 5 /** RC=5 failed to create directory */
878	END
879
880	CALL LINEOUT globals.!log1, 'Directory for PPD files:' ppddir
881
882	/***
883	*** Now do the actual work.
884	***/
885
886	/* Copy the needed driver files to our working directories.
887	*/
888	drvr_dir = VRParseFileName( driver_path, 'DP')
889	drv_out = workdir'\OUT\'driver'.DRV'
890	pin_exe = workdir'\PIN.EXE'
891	ppd_exe = workdir'\PPDENC.EXE'
892	ok = VRCopyFile( driver_path, drv_out )
893	IF ok == 1 THEN ok = VRCopyFile( drvr_dir'\PIN.EXE', pin_exe )
894	IF ok == 1 THEN ok = VRCopyFile( drvr_dir'\PPDENC.EXE', ppd_exe )
895	IF ok == 0 THEN DO
896	RETURN 4 /* RC=4 Failed to copy driver files */
897	END
898
899	/* Set up the output redirection.
900	*/
901	nq = RXQUEUE('CREATE')
902	oq = RXQUEUE('SET', nq )
903
904	/* If we are importing a new PPD file, prep it first.
905	* (If ppdfile is undefined, it means we are reimporting a directory of
906	* previously-imported PPDs, and we can assume they are already prepped.)
907	*/
908	IF ppdfile <> '' THEN DO
909
910	/* If the PPD file is compressed, uncompress it.
911	*/
912	IF VRParseFilePath( ppdfile, 'E') == 'GZ' THEN DO
913	decppd = workdir'\' \|\| VRParseFilePath( ppdfile, 'N')
914	CALL LINEOUT globals.!log1, 'Decompressing' ppdfile 'to' decppd
915	ADDRESS CMD '@'globals.!programs.!gzip '-c -d' ppdfile '\| RXQUEUE' nq
916	DO QUEUED()
917	PARSE PULL line
918	CALL LINEOUT decppd, line
919	END
920	CALL LINEOUT decppd
921	ppdfile = decppd
922	END
923
924	IF VRFileExists( ppdfile ) == 0 THEN DO
925	CALL LINEOUT globals.!log1, 'PPD file' ppdfile 'could not be found.'
926	RETURN 6 / RC=6 PPD import failed /
927	END
928
929	ppd_use = ppddir'\' \|\| VRParseFileName( ppdfile, 'NE')
930
931	/* Now we have to clean up and validate the PPD file so PIN can use it.
932	* First, PPDENC converts the codepage if necessary, and copies the results
933	* to our working directory.
934	*/
935	CALL LINEOUT globals.!log1, 'Converting PPD with:' ppd_exe '"'ppdfile'" "'ppd_use'"'
936	ADDRESS CMD '@'ppd_exe '"'ppdfile'" "'ppd_use'" 2>NUL \| RXQUEUE' nq
937	DO QUEUED()
938	PULL output
939	CALL LINEOUT globals.!log2, output
940	END
941	CALL LINEOUT globals.!log2, ''
942	CALL LINEOUT globals.!log2
943
944	IF VRFileExists( ppd_use ) == 0 THEN DO
945	CALL LINEOUT globals.!log1, 'Hmm,' ppd_use 'was not created. Copying manually.'
946	CALL VRCopyFile ppdfile, ppd_use
947	END
948
949	/* Next we strip out some problematic PPD statements which are often
950	* encountered in (for example) CUPS-based PPD files.
951	*/
952	CALL CleanPPD ppd_use, globals.!log1
953
954	END
955
956	/* Preparation complete. Now do the import.
957	*/
958	count = 0
959	ADDRESS CMD '@'pin_exe 'ppd' ppddir drv_out '2>NUL \| RXQUEUE' nq
960	DO QUEUED()
961	PARSE PULL output
962	CALL LINEOUT globals.!log2, output
963	PARSE VAR output . 'OK (' nickname
964	IF nickname <> '' THEN DO
965	count = count + 1
966	newprinters.count = STRIP( nickname, 'T', ')')
967	END
968	END
969	newprinters.0 = count
970	CALL LINEOUT globals.!log2, ''
971	CALL LINEOUT globals.!log2
972
973	/* End the output redirection.
974	*/
975	CALL RXQUEUE 'SET', oq
976	CALL RXQUEUE 'DELETE', nq
977
978	IF newprinters.0 == 0 THEN DO
979	RETURN 6 / RC=6 PPD import failed /
980	END
981
982	/***
983	*** Post-import processing.
984	***/
985
986	IF ( driver_repo == 1 ) & ( update_all <> 0 ) THEN DO
987	/* If we're working out of the repository, we need to update the
988	* driver table in PRDESC.LST to add the new driver(s).
989	*/
990
991	CALL LINEOUT globals.!log1, 'Updating' globals.!prdesc 'with new entries from' drv_out
992
993	/* -- This causes a SYS3175 in the .DRV for some reason...
994	ok = UpdatePrDesc( driver'.DRV', drv_out )
995	IF ok <> 0 THEN
996	CALL LINEOUT globals.!log1, 'Failed to update' globals.!prdesc '(are EAs on' drv_out ' valid?)'
997	*/
998
999	count = 0
1000
1001	/* First, copy all lines that don't refer to the driver just updated */
1002	CALL LINEIN globals.!prdesc, 1, 0
1003	DO WHILE LINES( globals.!prdesc )
1004	_next = LINEIN( globals.!prdesc )
1005	PARSE UPPER VAR _next . ':' _rest
1006	_tail = LASTPOS('(', _rest )
1007	PARSE VAR _rest =(_tail) '('_prdrv')' .
1008	IF _prdrv == driver'.DRV' THEN ITERATE
1009	count = count + 1
1010	defs.count = _next
1011	END
1012	CALL STREAM globals.!prdesc, 'C', 'CLOSE'
1013
1014	/* Next, create a new list for the updated driver and merge that in */
1015	newlist = workdir'\'driver'.LST'
1016	CALL CreateDriverList drv_out, newlist
1017	DO WHILE LINES( newlist )
1018	_line = LINEIN( newlist )
1019	count = count + 1
1020	defs.count = _line
1021	END
1022	CALL STREAM newlist, 'C', 'CLOSE'
1023	defs.0 = count
1024
1025	/* Now sort the list and recreate PRDESC.LST */
1026	CALL SysStemSort 'defs.',, 'I'
1027	prdesc_tmp = workdir'\PRDESC.LST'
1028	IF STREAM( prdesc_tmp, 'C', 'QUERY EXISTS') <> '' THEN
1029	CALL VRDeleteFile prdesc_tmp
1030	DO i = 1 TO defs.0
1031	CALL LINEOUT prdesc_tmp, defs.i
1032	END
1033	CALL LINEOUT prdesc_tmp
1034	ok = VRCopyFile( prdesc_tmp, globals.!prdesc )
1035	IF ok == 0 THEN DO
1036	RETURN 7 / RC=7 Error updating PRDESC.LST /
1037	END
1038	CALL VRDeleteFile prdesc_tmp
1039
1040	END
1041
1042	/* Finally, copy the updated driver files.
1043	*/
1044	target = VRParseFilePath( driver_path, 'DP')
1045	CALL LINEOUT globals.!log1, 'Copying files from' workdir'\OUT to' target
1046	CALL PRReplaceModule target'\'driver'.DRV', '', ''
1047	ok = VRCopyFile( workdir'\OUT\'driver'.DRV', target'\'driver'.DRV')
1048	IF ok == 1 THEN
1049	ok = VRCopyFile( workdir'\OUT\AUXPRINT.PAK', target'\AUXPRINT.PAK')
1050
1051	IF ( ok == 1 ) & ( update_all <> 0 ) THEN DO
1052	/* Copy the updated files to \OS2\DLL\<driver>, replacing any
1053	* existing copies. (This prevents problems if the OS/2 driver
1054	* installation fails to copy them, which can happen under some
1055	* circumstances.)
1056	*/
1057	IF VRFileExists( globals.!os2dir'\DLL\'driver'\'driver'.DRV') THEN DO
1058	CALL VRCopyFile workdir'\OUT\AUXPRINT.PAK',,
1059	globals.!os2dir'\DLL\'driver'\AUXPRINT.PAK'
1060	CALL PRReplaceModule globals.!os2dir'\DLL\'driver'\'driver'.DRV', '', ''
1061	CALL VRCopyFile workdir'\OUT\'driver'.DRV', globals.!os2dir'\DLL\'driver'\'driver'.DRV'
1062	END
1063	END
1064	IF ok == 0 THEN DO
1065	CALL LINEOUT globals.!log1, VRError()
1066	RETURN 4 /* RC=4 Failed to copy driver files */
1067	END
1068
1069	CALL LINEOUT globals.!log1, newprinters.0 'printers imported successfully.'
1070	DO i = 1 TO newprinters.0
1071	CALL LINEOUT globals.!log1, ' ->' newprinters.i
1072	END
1073	CALL LINEOUT globals.!log1, ''
1074	CALL LINEOUT globals.!log1
1075
1076	/* Clean up our work directories.
1077	*/
1078	CALL VRDeleteFile workdir'\OUT\*'
1079	CALL VRDeleteFile workdir'\*'
1080	CALL VRRmDir( workdir'\OUT')
1081	CALL VRRmDir( workdir )
1082
1083	RETURN 0
1084
1085
1086	/*:VRX UpdatePrDesc
1087	*/
1088	UpdatePrDesc: PROCEDURE EXPOSE globals.
1089	ARG driver, fqn
1090
1091	IF globals.!prdesc == '' THEN RETURN 1
1092
1093	ok = RPUEnumModels( fqn, 'newdevs.')
1094	IF ok == 0 THEN RETURN 2
1095
1096	_count = 0
1097	CALL LINEIN globals.!prdesc, 1, 0
1098	DO WHILE LINES( globals.!prdesc )
1099	_next = LINEIN( globals.!prdesc )
1100	PARSE UPPER VAR _next WITH . ':' . '('_prdrv')' .
1101	IF _prdrv == driver THEN ITERATE
1102	_count = _count + 1
1103	prdefs.count = _next
1104	END
1105	CALL STREAM globals.!prdesc, 'C', 'CLOSE'
1106
1107	DO i = 1 TO newdevs.0
1108	_count = _count + 1
1109	prdefs._count = newdevs.i':' newdevs.i '('driver')'
1110	END
1111	prdefs.0 = count
1112
1113	CALL VRSortStem 'prdefs.'
1114
1115	_prdir = VRParseFileName( globals.!prdesc, 'DP')
1116	CALL VRCopyFile globals.!prdesc, _prdir'\PRDESC.BAK'
1117	CALL VRDeleteFile globals.!prdesc
1118	DO i = 1 TO prdefs.0
1119	CALL LINEOUT globals.!prdesc, prdefs.i
1120	END
1121	CALL LINEOUT globals.!prdesc
1122
1123	RETURN 0
1124
1125
1126	/*:VRX NLSGetMessage
1127	*/
1128	/*
1129	* Gets the message text associated with the given message number from the
1130	* current language file.
1131	*/
1132	NLSGetMessage: PROCEDURE EXPOSE globals.
1133	PARSE ARG msgnum, .
1134	args = ARG()
1135
1136	msgfile = globals.!messages
1137	IF msgnum == '' THEN RETURN ''
1138
1139	sub_parms = ''
1140	DO i = 2 TO args
1141	sub_parms = sub_parms', "'ARG( i )'"'
1142	END
1143
1144	INTERPRET 'msgfromfile = SysGetMessage( msgnum, msgfile' sub_parms ')'
1145
1146	PARSE VAR msgfromfile message '0D'x .
1147	IF SUBSTR( message, 1, 4 ) == 'SYS0' THEN message = ''
1148
1149	RETURN message
1150
1151
1152	/*:VRX NLSSetText
1153	*/
1154	/*
1155	* Sets the specified property of the specified control to the specified
1156	* message text.
1157	*/
1158	NLSSetText: PROCEDURE EXPOSE globals.
1159	PARSE ARG control, property, message, substitution
1160	args = ARG()
1161
1162	success = 1
1163	IF args < 4 THEN
1164	text = NLSGetMessage( message )
1165	ELSE DO
1166	sub_parms = ''
1167	DO i = 4 TO args
1168	sub_parms = sub_parms '"'\|\| ARG( i ) \|\|'",'
1169	END
1170	sub_parms = STRIP( sub_parms, 'T', ',')
1171	INTERPRET 'text = NLSGetMessage( message, 'sub_parms')'
1172	END
1173
1174	IF text == '' THEN success = 0
1175	ELSE CALL VRSet control, property, text
1176
1177	RETURN success
1178
1179	/*:VRX StringTokenize
1180	*/
1181	StringTokenize:
1182	PARSE ARG string, separator, __stem
1183	CALL __StringTokenize string, separator, __stem
1184	DROP __stem
1185	RETURN
1186
1187	/*:VRX __StringTokenize
1188	*/
1189	__StringTokenize: PROCEDURE EXPOSE (__stem)
1190	PARSE ARG string, separator, tokens
1191
1192	/* Note: this differs slightly from my usual implementation in that
1193	* each token is STRIPped of leading and trailing spaces.
1194	*/
1195
1196	IF ( string = '') THEN RETURN string
1197	IF ( separator = '') THEN separator = ' '
1198
1199	i = 0
1200	CALL VALUE tokens \|\| '0', i
1201	DO WHILE LENGTH( string ) > 0
1202	x = 1
1203	y = POS( separator, string, x )
1204	IF y > 0 THEN DO
1205	current = SUBSTR( string, 1, y-1 )
1206	x = y + 1
1207	i = i + 1
1208	CALL VALUE tokens \|\| 'i', STRIP( current )
1209	END
1210	ELSE DO
1211	current = STRIP( string, 'B', separator )
1212	i = i + 1
1213	CALL VALUE tokens \|\| 'i', STRIP( current )
1214	x = LENGTH( string ) + 1
1215	END
1216	string = SUBSTR( string, x )
1217	END
1218	CALL VALUE tokens \|\| '0', i
1219
1220	RETURN
1221

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

Download in other formats:

Original Format