Hello Jerry:
>
> By the way, are you certain that indeed the IMAGE file labels are being
> copied during your procedure? Have you attempted to re-open the database
> and its sets following a back-and-forth transfer using something like
> QUERY and doing an 'FO SETS' command? (I'd be very sensitive about this
> as without these labels, the base is essentially useless!)
>
Thank you for the new version. Indeed, there was a problem with the
labels. But I could not read the original ones from the HP. M ylabel
printing program fails with PRIV files, athough I translated it with
CAP=PM. I attach my label printing program. Where is the error around the
FOPEN and GETPRIVMODE procedures? I have the Pascal formatting in our
anonymous_ftp
in the directory
nagyf:
> ftp alpha0.iki.kfki.hu
Connected to alpha0.iki.kfki.hu.
220 alpha0.iki.kfki.hu FTP server (OSF/1 Version 5.60) ready.
Name: anonymous
331 Guest login ok, send ident as password.
Password:
230 Guest login ok, access restrictions apply.
Remote system type is UNIX.
Using binary mode to transfer files.
ftp>
I used an older Pascal formatting program than Stan's article about
readable Pascal programs.
MY PASCAL FORMATTING TOOLS
Transfer your files from the HP to the PC, then execute the ZE batch
file. On its edit menu selection you can open two windows, one for the
<source> and the other for the <source>.HIB error message file. (In
case of Turbo Pascal the <source> has PAS extension. The recoomended
editor is Personal Editor II, for which I added two macros to the
archive.
QUESTION: Is there any newer version the Personal Editor?
Frank
|\ /~ ~~|~~~ Family : NAGY; first name : FERENC; title : Ph. D.
| \ | -+- Institute of Isotopes of the Hungarian Academy of Sciences
| \| | 1121 BUDAPEST Konkoly-Thege M. ut 29, HUNGARY (1525 Bp. POB 77)
`-' ' `-' E-mail : [log in to unmask]
Fax: (36)-1-395-9002, work phone: (36)-1-395-9123, home phone: (36)-1-277-4229.
^NEW! ^NEW!
Home address: H-1214 BUDAPEST Raketa u. 29. I. 3.
There are 3 kinds of programming errors: syntactical, semantical and mystical.
The programmers have to suck up the users just as much as absolutely necessary.
PROGRAM labelp(Input,Output);
{
Label dump of privileged files.
(C) Ferenc Nagy, Institute of Isotopes, Budapest, Hungary, 1995-97.
}
TYPE
shortint=-32768..32767;
VAR
name:string[36];
num:shortint;
lid:shortint;
fid:TEXT;
buf:PACKED ARRAY [1..256] OF CHAR;
len:shortint;
j,k,l,m,n,p :shortint;
itemvalues, {Values of asked items}
itemnumbers, {Numbers of asked items}
itemerrors:ARRAY [1..3] OF shortint;
{Error codes of items}
error1, {Global error code}
mode:shortint; {Call mode}
CONST
ccg = 0;
ccl = 1;
cce = 2;
PROCEDURE getusermode;
INTRINSIC;
PROCEDURE getprivmode;
INTRINSIC;
PROCEDURE flabelinfo;
INTRINSIC;
PROCEDURE freadlabel;
INTRINSIC;
PROCEDURE terminate ;
INTRINSIC;
PROCEDURE fcheck;
INTRINSIC;
PROCEDURE fclose;
INTRINSIC;
FUNCTION fopen : shortint;
INTRINSIC;
PROCEDURE genmsgu (setno, msgno : shortint);
EXTERNAL spl;
BEGIN
Writeln('Label dump of privileged files.');
Writeln(
'(C) Ferenc Nagy, Institute of Isotopes, Budapest, Hungary, 1995.');
Writeln;
REPEAT
Prompt('File (Terminate with ":","" or "//") ===>');
IF Eof(Input) THEN terminate;
Readln(name);
Writeln('*** ',name,' ***');
itemnumbers[1]:=10;
itemnumbers[2]:=9;
itemnumbers[3]:=0;
mode:=0;
getprivmode;
flabelinfo(name,mode,error1,itemnumbers, itemvalues, itemerrors);
IF (name='') OR (name='//') THEN terminate;
IF error1=0 THEN BEGIN
CASE itemvalues[2] OF
-32768..-1: Writeln('This is a privileged file.');
1433: Writeln(
'This is a Business Report Writer Intermediate Report File.'
);
OTHERWISE;
END; {fopen call by Stan Sieler's 'fileopen'...}
num := fopen (name, Octal ('000003'),
{F, binary, old}
Octal ('002300'),{gmulti, shr, IN}
);
IF CCode <> cce THEN BEGIN
Writeln ('unable to open file: ', name);
fcheck (num, error1);
genmsgu (8, error1);
END
ELSE BEGIN
num:=Fnum(fid);
j:=0;
Writeln(itemvalues[1],' label(s) expected.');
REPEAT
buf:='';
len:=128;
freadlabel(num,buf,len,j);
IF CCode=2 THEN BEGIN
Writeln('Label#',j:1);
IF itemvalues[2]=1433 THEN BEGIN
{List BRW IRF labels in special formats}
IF j=0 THEN BEGIN
m:=Ord(buf[64]);
n:=Ord(buf[60]);
p:=((n-1) DIV 7)+1;
FOR k:=0 TO 15 DO BEGIN
FOR l:=1 TO 16 DO
IF buf[16*k+l] IN [' '..'Z'] THEN Write(buf[
16*k+ l])
ELSE Write('_');
FOR l:=1 TO 16 DO Write(Ord(buf[16*k+l]):4);
Writeln;
END;
END
ELSE IF j>p THEN BEGIN
FOR k:=0 TO 10 DO BEGIN
FOR l:=1 TO 20 DO
IF buf[22*k+l] IN [' '..'Z'] THEN Write(buf[
22*k+ l])
ELSE Write('_');
FOR l:=21 TO 22 DO Write(Ord(buf[22*k+l]):4);
IF k=11 THEN
FOR l:=243 TO 256 DO Write(Ord(buf[l]):4);
Writeln;
END;
END
ELSE BEGIN
FOR k:=0 TO 6 DO BEGIN
FOR l:=1 TO 20 DO
IF buf[36*k+l] IN [' '..'Z'] THEN Write(buf[
36*k+ l])
ELSE Write('_');
FOR l:=21 TO 36 DO Write(Ord(buf[36*k+l]):4);
IF k=6 THEN
FOR l:=253 TO 256 DO Write(Ord(buf[l]):4);
Writeln;
END;
END;
END
ELSE BEGIN {List other labels in general format}
FOR k:=0 TO 15 DO BEGIN
FOR l:=1 TO 16 DO
IF buf[16*k+l] IN [' '..'Z'] THEN Write(buf[16*k+
l])
ELSE Write('_');
FOR l:=1 TO 16 DO Write(Ord(buf[16*k+l]):4);
Writeln;
END;
END;
END;
j:=j+1;
UNTIL (CCode<>2) AND (j>itemvalues[1]);
fclose (num, 1, 0);{or, fid, 9 for CRUNCH}
IF CCode <> cce THEN BEGIN
fcheck (num, error1);
genmsgu (8, error1);
END;
END;
END
ELSE Writeln('File not accessible.');
getusermode;
Writeln;
UNTIL FALSE;
END.
|
