Context Navigation

PrManUtl.VRS@ 58

Last change on this file since 58 was 58, checked in by Alex Taylor, 8 years ago
Incremented version to 0.7. Fix population of shipped driver list when opening Install Driver dialog. Fix installation of non-PostScript drivers from Drivers tab (parsing of DFFF EA type). Refresh properly when deleting the only printer, driver, or port. Add 'ArcaOS' to branding logic. Added more logging (still needs work).
File size: 41.3 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', '"')
640	LEAVE
641	END
642	END
643	CALL RXQUEUE 'SET', oq
644	CALL RXQUEUE 'DELETE', nq
645	END
646	ELSE DO
647	CALL LINEIN ppd_file, 1, 0
648	DO WHILE LINES( ppd_file ) <> 0
649	line = STRIP( LINEIN( ppd_file ))
650	IF LEFT( line, 15 ) == '*ShortNickName:' THEN DO
651	PARSE VAR line . ':' _nick '0D'x .
652	nickname = STRIP( _nick )
653	nickname = STRIP( nickname, 'B', '"')
654	LEAVE
655	END
656	END
657	CALL STREAM ppd_file, 'C', 'CLOSE'
658	END
659
660	RETURN nickname
661
662	/*:VRX CleanPPD
663	*/
664	/* Clean out lines from Gutenprint and Foomatic PPD files that are known to
665	* cause problems when importing with PIN. (Partially based on work by Paul
666	* Smedley and Peter Brown).
667	*/
668	CleanPPD: PROCEDURE
669	PARSE ARG in_ppd, logfile
670	IF logfile <> '' THEN
671	logfile = STREAM( logfile, 'C', 'QUERY EXISTS')
672
673	out_ppd = VRParseFilePath( in_ppd, 'DPN') \|\| '.TMP'
674	IF STREAM( out_ppd, 'C', 'QUERY EXISTS') \= '' THEN
675	CALL SysFileDelete out_ppd
676
677	IF logfile <> '' THEN
678	CALL CHAROUT logfile, 'Doing cleanup on' in_ppd '...'
679
680	skip_next = 0
681	DO WHILE LINES( in_ppd ) \= 0
682	line = LINEIN( in_ppd )
683	SELECT
684	WHEN skip_next == 1 THEN DO
685	line = STRIP( TRANSLATE( line ))
686	IF line == '*END' THEN skip_next = 0
687	END
688	WHEN LEFT( line, 11 ) == '*StpDefault' THEN NOP
689	WHEN LEFT( line, 7 ) == '*StpStp' THEN NOP
690	WHEN LEFT( line, 18 ) == '*StpResolutionMap:' THEN NOP
691	WHEN LEFT( line, 14 ) == '*OPOptionHints' THEN NOP
692	WHEN LEFT( line, 4 ) == '*da.' THEN NOP
693	WHEN LEFT( line, 4 ) == '*de.' THEN NOP
694	WHEN LEFT( line, 4 ) == '*es.' THEN NOP
695	WHEN LEFT( line, 4 ) == '*fi.' THEN NOP
696	WHEN LEFT( line, 4 ) == '*fr.' THEN NOP
697	WHEN LEFT( line, 4 ) == '*it.' THEN NOP
698	WHEN LEFT( line, 4 ) == '*ja.' THEN NOP
699	WHEN LEFT( line, 4 ) == '*ko.' THEN NOP
700	WHEN LEFT( line, 4 ) == '*nb.' THEN NOP
701	WHEN LEFT( line, 4 ) == '*nl.' THEN NOP
702	WHEN LEFT( line, 4 ) == '*pt.' THEN NOP
703	WHEN LEFT( line, 4 ) == '*sv.' THEN NOP
704	WHEN LEFT( line, 7 ) == '*zh_CN.' THEN NOP
705	WHEN LEFT( line, 7 ) == '*zh_TW.' THEN NOP
706	WHEN LEFT( line, 9 ) == '*Foomatic' THEN DO
707	line = STRIP( line )
708	IF RIGHT( line, 2 ) == '&&' THEN skip_next = 1
709	END
710	OTHERWISE DO
711	CALL LINEOUT out_ppd, line
712	skip_next = 0
713	END
714	END
715	END
716	CALL STREAM in_ppd, 'C', 'CLOSE'
717	CALL STREAM out_ppd, 'C', 'CLOSE'
718
719	ok = VRCopyFile( out_ppd, in_ppd )
720	IF logfile <> '' THEN DO
721	IF ok == 1 THEN
722	CALL LINEOUT logfile, 'OK'
723	ELSE DO
724	CALL LINEOUT logfile, 'Failed!'
725	CALL LINEOUT logfile, ' ->' VRError()
726	END
727	CALL LINEOUT logfile, ''
728	END
729	CALL SysFileDelete out_ppd
730
731	RETURN
732
733	/*:VRX MatchPrinterModel
734	*/
735	/* Find a set of printers supported by the OS/2 driver which mostly closely
736	* match the given name.
737	*/
738	MatchPrinterModel: PROCEDURE EXPOSE globals. models.
739	PARSE UPPER ARG driver_name, printer_name
740	printer_name = TRANSLATE( printer_name, '_', '.')
741	printer_drv = globals.!os2dir'\DLL\'driver_name'\'driver_name'.DRV'
742	models.0 = 0
743
744	IF SysGetEA( printer_drv, '.EXPAND', 'exist_ea') <> 0 THEN RETURN 0
745	PARSE VAR exist_ea 1 _eatype 3 .
746	IF C2X( _eatype ) <> 'FDFF' THEN RETURN 0
747
748	PARSE VAR exist_ea 3 _ealen 5 exist_models
749	total_len = C2D( REVERSE( _ealen ))
750
751	/* The variable exist_models now contains a null-separated list of printer
752	* models supported by the driver (including those from previously-imported
753	* PPD files). Next we check each one against our requested printer name.
754	*/
755	start = 1
756	count = 0
757	best = 0
758	DO WHILE start < total_len
759	_strend = POS('0'x, exist_models, start )
760	IF _strend == 0 THEN LEAVE
761	_model = TRANSLATE( SUBSTR( exist_models, start, _strend - start ))
762	_model = TRANSLATE( _model, ' ', '-')
763	_comp = COMPARE( _model, printer_name )
764	IF WORD( _model, 1 ) == WORD( printer_name, 1 ) THEN DO
765	count = count + 1
766	IF _comp == 0 THEN DO
767	_comp = 9999
768	best = count
769	END
770	ELSE IF ( best == 0 ) & ( _comp > LENGTH( printer_name )) THEN
771	best = count
772	/*
773	models.count = RIGHT( _comp, 4, '0') SUBSTR( exist_models, start, _strend - start )
774	*/
775	models.count = SUBSTR( exist_models, start, _strend - start )
776	END
777	start = _strend + 1
778	END
779	models.0 = count
780
781	/*
782	CALL SysStemSort 'models.', 'D', 'I',,, 1, 4
783	DO i = 1 TO count
784	models.i = SUBWORD( models.i, 2 )
785	END
786	*/
787	RETURN best
788
789
790	/*:VRX CheckWritablePath
791	*/
792	CheckWritablePath: PROCEDURE EXPOSE globals.
793	ARG path
794
795	/* Make sure path exists & is a directory */
796	IF \VRIsDir( path ) THEN RETURN 1
797
798	/* Make sure the drive is accessible */
799	di = SysDriveInfo( VRParseFilePath( path, 'DP'))
800	IF di == '' THEN RETURN 2
801
802	/* Make sure the drive has a supported filesystem */
803	fs = SysFileSystemType( prdrv )
804	IF WORDPOS( fs, 'HPFS JFS FAT FAT32') == 0 THEN RETURN 3
805
806	RETURN 0
807
808
809	/*:VRX QueryAvailableDrivers
810	*/
811	/* Determine which of our supported PrinterPak drivers are currently available.
812	*/
813	QueryAvailableDrivers: PROCEDURE EXPOSE globals. drv_list.
814	drv_list.0 = 0
815
816	test_drivers = 'ECUPS ECUPS-HP PSPRINT'
817	DO i = 1 TO WORDS( test_drivers )
818	driver = WORD( test_drivers, i )
819	ok = GetDriverSource( driver )
820	IF ok == '' THEN
821	ok = VRGetIni('PM_DEVICE_DRIVERS', driver, 'USER')
822	IF ok <> '' THEN
823	CALL SysStemInsert 'drv_list.', drv_list.0+1, driver
824	END
825
826	RETURN drv_list.0
827
828
829	/*:VRX PinWrapper
830	*/
831	/* Wrapper for PIN, which performs the following tasks:
832	* - Create a temporary working directory & copy the PrinterPak files there.
833	* - Pre-process the PPD file to make it ready for import, and saves it in
834	* a driver-specific 'saved PPDs' directory for future use.
835	* - Uses PIN to import the PPD into our temporary working copy of the driver.
836	* - Copy the updated driver back to our installable copy.
837	* - If update_all is 1 then also do the following:
838	* - If the driver is actually installed, copy the updated driver back
839	* over the installed version as well.
840	* - If this is a 'shipped' driver (i.e. one listed in PRDRV.LST) then
841	* add the newly-defined printer to PRDESC.LST.
842	*/
843	PinWrapper: PROCEDURE EXPOSE globals. driver_path driver_repo
844	ARG update_all, driver, ppdfile
845
846	CALL LINEOUT globals.!log1, 'Driver source: ' driver_path
847
848	workdir = SysTempFileName( globals.!tmpdir'\PPD_????')
849	ok = VRMkDir( workdir )
850	IF ok == 1 THEN ok = VrMkDir( workdir'\OUT')
851	IF ok <> 1 THEN
852	RETURN 5 /** RC=5 failed to create directory */
853
854	CALL LINEOUT globals.!log1, 'Temporary directory: ' workdir
855
856	SELECT
857	WHEN driver == 'ECUPS' THEN ppddir = globals.!repository'\PPD_E'
858	WHEN driver == 'ECUPS-HP' THEN ppddir = globals.!repository'\PPD_EHP'
859	WHEN driver == 'PSPRINT' THEN ppddir = globals.!repository'\PPD_PS'
860	WHEN driver == 'PSPRINT2' THEN ppddir = globals.!repository'\PPD_PS2'
861	WHEN driver == 'PSCRIPT2' THEN ppddir = globals.!repository'\PPD2'
862	WHEN driver == 'GUTENPRT' THEN ppddir = globals.!repository'\PPD_GP'
863	OTHERWISE ppddir = globals.!repository'\PPD'
864	END
865
866	/* Make sure ppddir (for keeping PPD files) exists */
867	CALL SysFileTree ppddir, 'dirs.', 'DO'
868	IF dirs.0 == 0 THEN DO
869	IF ppdfile == '' THEN RETURN 0 /* No PPDs - nothing to do */
870	ok = VRMkDir( ppddir )
871	IF ok <> 1 THEN
872	RETURN 5 /** RC=5 failed to create directory */
873	END
874
875	CALL LINEOUT globals.!log1, 'Directory for PPD files:' ppddir
876
877	/***
878	*** Now do the actual work.
879	***/
880
881	/* Copy the needed driver files to our working directories.
882	*/
883	drvr_dir = VRParseFileName( driver_path, 'DP')
884	drv_out = workdir'\OUT\'driver'.DRV'
885	pin_exe = workdir'\PIN.EXE'
886	ppd_exe = workdir'\PPDENC.EXE'
887	ok = VRCopyFile( driver_path, drv_out )
888	IF ok == 1 THEN ok = VRCopyFile( drvr_dir'\PIN.EXE', pin_exe )
889	IF ok == 1 THEN ok = VRCopyFile( drvr_dir'\PPDENC.EXE', ppd_exe )
890	IF ok == 0 THEN DO
891	RETURN 4 /* RC=4 Failed to copy driver files */
892	END
893
894	/* Set up the output redirection.
895	*/
896	nq = RXQUEUE('CREATE')
897	oq = RXQUEUE('SET', nq )
898
899	/* If we are importing a new PPD file, prep it first.
900	* (If ppdfile is undefined, it means we are reimporting a directory of
901	* previously-imported PPDs, and we can assume they are already prepped.)
902	*/
903	IF ppdfile <> '' THEN DO
904
905	/* If the PPD file is compressed, uncompress it.
906	*/
907	IF VRParseFilePath( ppdfile, 'E') == 'GZ' THEN DO
908	decppd = workdir'\' \|\| VRParseFilePath( ppdfile, 'N')
909	CALL LINEOUT globals.!log1, 'Decompressing' ppdfile 'to' decppd
910	ADDRESS CMD '@'globals.!programs.!gzip '-c -d' ppdfile '\| RXQUEUE' nq
911	DO QUEUED()
912	PARSE PULL line
913	CALL LINEOUT decppd, line
914	END
915	CALL LINEOUT decppd
916	ppdfile = decppd
917	END
918
919	IF VRFileExists( ppdfile ) == 0 THEN DO
920	CALL LINEOUT globals.!log1, 'PPD file' ppdfile 'could not be found.'
921	RETURN 6 / RC=6 PPD import failed /
922	END
923
924	ppd_use = ppddir'\' \|\| VRParseFileName( ppdfile, 'NE')
925
926	/* Now we have to clean up and validate the PPD file so PIN can use it.
927	* First, PPDENC converts the codepage if necessary, and copies the results
928	* to our working directory.
929	*/
930	CALL LINEOUT globals.!log1, 'Converting PPD with:' ppd_exe ppdfile ppd_use
931	ADDRESS CMD '@'ppd_exe ppdfile ppd_use '2>NUL \| RXQUEUE' nq
932	DO QUEUED()
933	PULL output
934	CALL LINEOUT globals.!log2, output
935	END
936	CALL LINEOUT globals.!log2, ''
937	CALL LINEOUT globals.!log2
938
939	IF VRFileExists( ppd_use ) == 0 THEN DO
940	CALL LINEOUT globals.!log1, 'Hmm,' ppd_use 'was not created. Copying manually.'
941	CALL VRCopyFile ppdfile, ppd_use
942	END
943
944	/* Next we strip out some problematic PPD statements which are often
945	* encountered in (for example) CUPS-based PPD files.
946	*/
947	CALL CleanPPD ppd_use, globals.!log1
948
949	END
950
951	/* Preparation complete. Now do the import.
952	*/
953	count = 0
954	ADDRESS CMD '@'pin_exe 'ppd' ppddir drv_out '2>NUL \| RXQUEUE' nq
955	DO QUEUED()
956	PARSE PULL output
957	CALL LINEOUT globals.!log2, output
958	PARSE VAR output . 'OK (' nickname
959	IF nickname <> '' THEN DO
960	count = count + 1
961	newprinters.count = STRIP( nickname, 'T', ')')
962	END
963	END
964	newprinters.0 = count
965	CALL LINEOUT globals.!log2, ''
966	CALL LINEOUT globals.!log2
967
968	/* End the output redirection.
969	*/
970	CALL RXQUEUE 'SET', oq
971	CALL RXQUEUE 'DELETE', nq
972
973	IF newprinters.0 == 0 THEN DO
974	RETURN 6 / RC=6 PPD import failed /
975	END
976
977	/***
978	*** Post-import processing.
979	***/
980
981	IF ( driver_repo == 1 ) & ( update_all <> 0 ) THEN DO
982	/* If we're working out of the repository, we need to update the
983	* driver table in PRDESC.LST to add the new driver(s).
984	*/
985
986	CALL LINEOUT globals.!log1, 'Updating' globals.!prdesc 'with new entries from' drv_out
987
988	/* -- This causes a SYS3175 in the .DRV for some reason...
989	ok = UpdatePrDesc( driver'.DRV', drv_out )
990	IF ok <> 0 THEN
991	CALL LINEOUT globals.!log1, 'Failed to update' globals.!prdesc '(are EAs on' drv_out ' valid?)'
992	*/
993
994	count = 0
995
996	/* First, copy all lines that don't refer to the driver just updated */
997	CALL LINEIN globals.!prdesc, 1, 0
998	DO WHILE LINES( globals.!prdesc )
999	_next = LINEIN( globals.!prdesc )
1000	PARSE UPPER VAR _next . ':' _rest
1001	_tail = SUBSTR( _rest, LASTPOS('(', _rest ))
1002	PARSE VAR _tail '('_prdrv')' .
1003	IF _prdrv == driver'.DRV' THEN ITERATE
1004	count = count + 1
1005	defs.count = _next
1006	END
1007	CALL STREAM globals.!prdesc, 'C', 'CLOSE'
1008
1009	/* Next, create a new list for the updated driver and merge that in */
1010	newlist = workdir'\'driver'.LST'
1011	CALL CreateDriverList drv_out, newlist
1012	DO WHILE LINES( newlist )
1013	_line = LINEIN( newlist )
1014	count = count + 1
1015	defs.count = _line
1016	END
1017	CALL STREAM newlist, 'C', 'CLOSE'
1018	defs.0 = count
1019
1020	/* Now sort the list and recreate PRDESC.LST */
1021	CALL SysStemSort 'defs.',, 'I'
1022	prdesc_tmp = workdir'\PRDESC.LST'
1023	IF STREAM( prdesc_tmp, 'C', 'QUERY EXISTS') <> '' THEN
1024	CALL VRDeleteFile prdesc_tmp
1025	DO i = 1 TO defs.0
1026	CALL LINEOUT prdesc_tmp, defs.i
1027	END
1028	CALL LINEOUT prdesc_tmp
1029	ok = VRCopyFile( prdesc_tmp, globals.!prdesc )
1030	IF ok == 0 THEN DO
1031	RETURN 7 / RC=7 Error updating PRDESC.LST /
1032	END
1033	CALL VRDeleteFile prdesc_tmp
1034
1035	END
1036
1037	/* Finally, copy the updated driver files.
1038	*/
1039	target = VRParseFilePath( driver_path, 'DP')
1040	CALL LINEOUT globals.!log1, 'Copying files from' workdir'\OUT to' target
1041	CALL PRReplaceModule target'\'driver'.DRV', '', ''
1042	ok = VRCopyFile( workdir'\OUT\'driver'.DRV', target'\'driver'.DRV')
1043	IF ok == 1 THEN
1044	ok = VRCopyFile( workdir'\OUT\AUXPRINT.PAK', target'\AUXPRINT.PAK')
1045
1046	IF ( ok == 1 ) & ( update_all <> 0 ) THEN DO
1047	/* Copy the updated files to \OS2\DLL\<driver>, replacing any
1048	* existing copies. (This prevents problems if the OS/2 driver
1049	* installation fails to copy them, which can happen under some
1050	* circumstances.)
1051	*/
1052	IF VRFileExists( globals.!os2dir'\DLL\'driver'\'driver'.DRV') THEN DO
1053	CALL VRCopyFile workdir'\OUT\AUXPRINT.PAK',,
1054	globals.!os2dir'\DLL\'driver'\AUXPRINT.PAK'
1055	CALL PRReplaceModule globals.!os2dir'\DLL\'driver'\'driver'.DRV', '', ''
1056	CALL VRCopyFile workdir'\OUT\'driver'.DRV', globals.!os2dir'\DLL\'driver'\'driver'.DRV'
1057	END
1058	END
1059	IF ok == 0 THEN DO
1060	CALL LINEOUT globals.!log1, VRError()
1061	RETURN 4 /* RC=4 Failed to copy driver files */
1062	END
1063
1064	CALL LINEOUT globals.!log1, newprinters.0 'printers imported successfully.'
1065	DO i = 1 TO newprinters.0
1066	CALL LINEOUT globals.!log1, ' ->' newprinters.i
1067	END
1068	CALL LINEOUT globals.!log1, ''
1069	CALL LINEOUT globals.!log1
1070
1071	/* Clean up our work directories.
1072	*/
1073	CALL VRDeleteFile workdir'\OUT\*'
1074	CALL VRDeleteFile workdir'\*'
1075	CALL VRRmDir( workdir'\OUT')
1076	CALL VRRmDir( workdir )
1077
1078	RETURN 0
1079
1080
1081	/*:VRX UpdatePrDesc
1082	*/
1083	UpdatePrDesc: PROCEDURE EXPOSE globals.
1084	ARG driver, fqn
1085
1086	IF globals.!prdesc == '' THEN RETURN 1
1087
1088	ok = RPUEnumModels( fqn, 'newdevs.')
1089	IF ok == 0 THEN RETURN 2
1090
1091	_count = 0
1092	CALL LINEIN globals.!prdesc, 1, 0
1093	DO WHILE LINES( globals.!prdesc )
1094	_next = LINEIN( globals.!prdesc )
1095	PARSE UPPER VAR _next WITH . ':' . '('_prdrv')' .
1096	IF _prdrv == driver THEN ITERATE
1097	_count = _count + 1
1098	prdefs.count = _next
1099	END
1100	CALL STREAM globals.!prdesc, 'C', 'CLOSE'
1101
1102	DO i = 1 TO newdevs.0
1103	_count = _count + 1
1104	prdefs._count = newdevs.i':' newdevs.i '('driver')'
1105	END
1106	prdefs.0 = count
1107
1108	CALL VRSortStem 'prdefs.'
1109
1110	_prdir = VRParseFileName( globals.!prdesc, 'DP')
1111	CALL VRCopyFile globals.!prdesc, _prdir'\PRDESC.BAK'
1112	CALL VRDeleteFile globals.!prdesc
1113	DO i = 1 TO prdefs.0
1114	CALL LINEOUT globals.!prdesc, prdefs.i
1115	END
1116	CALL LINEOUT globals.!prdesc
1117
1118	RETURN 0
1119
1120
1121	/*:VRX NLSGetMessage
1122	*/
1123	/*
1124	* Gets the message text associated with the given message number from the
1125	* current language file.
1126	*/
1127	NLSGetMessage: PROCEDURE EXPOSE globals.
1128	PARSE ARG msgnum, .
1129	args = ARG()
1130
1131	msgfile = globals.!messages
1132	IF msgnum == '' THEN RETURN ''
1133
1134	sub_parms = ''
1135	DO i = 2 TO args
1136	sub_parms = sub_parms', "'ARG( i )'"'
1137	END
1138
1139	INTERPRET 'msgfromfile = SysGetMessage( msgnum, msgfile' sub_parms ')'
1140
1141	PARSE VAR msgfromfile message '0D'x .
1142	IF SUBSTR( message, 1, 4 ) == 'SYS0' THEN message = ''
1143
1144	RETURN message
1145
1146
1147	/*:VRX NLSSetText
1148	*/
1149	/*
1150	* Sets the specified property of the specified control to the specified
1151	* message text.
1152	*/
1153	NLSSetText: PROCEDURE EXPOSE globals.
1154	PARSE ARG control, property, message, substitution
1155	args = ARG()
1156
1157	success = 1
1158	IF args < 4 THEN
1159	text = NLSGetMessage( message )
1160	ELSE DO
1161	sub_parms = ''
1162	DO i = 4 TO args
1163	sub_parms = sub_parms '"'\|\| ARG( i ) \|\|'",'
1164	END
1165	sub_parms = STRIP( sub_parms, 'T', ',')
1166	INTERPRET 'text = NLSGetMessage( message, 'sub_parms')'
1167	END
1168
1169	IF text == '' THEN success = 0
1170	ELSE CALL VRSet control, property, text
1171
1172	RETURN success
1173
1174	/*:VRX StringTokenize
1175	*/
1176	StringTokenize:
1177	PARSE ARG string, separator, __stem
1178	CALL __StringTokenize string, separator, __stem
1179	DROP __stem
1180	RETURN
1181
1182	/*:VRX __StringTokenize
1183	*/
1184	__StringTokenize: PROCEDURE EXPOSE (__stem)
1185	PARSE ARG string, separator, tokens
1186
1187	/* Note: this differs slightly from my usual implementation in that
1188	* each token is STRIPped of leading and trailing spaces.
1189	*/
1190
1191	IF ( string = '') THEN RETURN string
1192	IF ( separator = '') THEN separator = ' '
1193
1194	i = 0
1195	CALL VALUE tokens \|\| '0', i
1196	DO WHILE LENGTH( string ) > 0
1197	x = 1
1198	y = POS( separator, string, x )
1199	IF y > 0 THEN DO
1200	current = SUBSTR( string, 1, y-1 )
1201	x = y + 1
1202	i = i + 1
1203	CALL VALUE tokens \|\| 'i', STRIP( current )
1204	END
1205	ELSE DO
1206	current = STRIP( string, 'B', separator )
1207	i = i + 1
1208	CALL VALUE tokens \|\| 'i', STRIP( current )
1209	x = LENGTH( string ) + 1
1210	END
1211	string = SUBSTR( string, x )
1212	END
1213	CALL VALUE tokens \|\| '0', i
1214
1215	RETURN
1216

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

Download in other formats:

Original Format