Context Navigation

PrManUtl.VRS@ 96

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

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

Download in other formats:

Original Format