Context Navigation

PrManUtl.VRS@ 85

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

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

Download in other formats:

Original Format