emil@rochester.UUCP (Emil Rainero) (07/24/84)
From: Emil Rainero <emil>
DOS TO PASCAL TRANSFER PROGRAM
With the advent of the Language
System I have many times wanted to
transfer data files created by Basic
programs to a Pascal disk. After much
study of a program Tom Cole gave CAC
last year which transfered files on a
Corvus drive, and by trial and error,
I was able to determine the
relationship between Pascal blocks and
DOS sectors. The result is the
following program which will transfer
files from DOS to Pascal.
This is mainly useful for text
files but can also be used to transfer
hi-res pictures. You must remember
that a hi-res picture file contains 4
bytes of data at the begining which
contain the length and address of the
file.
This program is still in the
developmental stage. There are no
known bugs but it has not been tested
against all cases.
(* Dos 3.3 --> Pascal Transfer program *)
(* Original program by Tom Cole to transfer files on Corvas drive *)
(* Modified to transfer 16 sector dos files to Pascal by Gene Jackson *)
PROGRAM TRANSFER;
TYPE
SECTORBUFFER =
PACKED ARRAY[0..255] OF CHAR;
BLOCKBUFFER =
PACKED ARRAY[0..511] OF CHAR;
VAR DISK : FILE;
TEMP : INTERACTIVE;
BLOCK : BLOCKBUFFER;
SECTOR : SECTORBUFFER;
TSLIST : SECTORBUFFER;
TSPTR : INTEGER;
DVOL : INTEGER;
BNUM : INTEGER;
TNUM : INTEGER;
SNUM : INTEGER;
TLINK : INTEGER;
SLINK : INTEGER;
I,J,K : INTEGER;
UNUMB : INTEGER;
NAME : STRING;
CH : CHAR;
PROCEDURE READSECTOR
(VAR SCTR:SECTORBUFFER;UNUM,TRACK,SECTOR: INTEGER);
VAR BLK : INTEGER;
BUFF : BLOCKBUFFER;
PTR : INTEGER;
LOOP : INTEGER;
REL : INTEGER;
BEGIN
IF SECTOR=15 THEN
ELSE IF SECTOR = 0 THEN
ELSE SECTOR:= 15 - SECTOR;
BLK:=(TRACK*16+SECTOR) DIV 2;
UNITREAD(UNUM,BUFF,512,BLK);
PTR:=256*((TRACK*16+SECTOR) MOD 2);
FOR LOOP:=0 TO 255
DO BEGIN
IF CH<>'Y'
THEN SCTR[LOOP]:=BUFF[LOOP+PTR]
ELSE SCTR[LOOP]:=CHR(ORD(BUFF[LOOP+PTR]) MOD 128)
END
END;
PROCEDURE INITVOL;
BEGIN
WRITE(CHR(12),'DOS 3.3 --> PASCAL TRANSFER');
WRITELN;
WRITELN('PUT DOS 3.3 DISK IN UNIT #5');
UNUMB:=5
END;
FUNCTION MATCH(ITEM:INTEGER):BOOLEAN;
VAR A,B: INTEGER;
C : STRING;
C1,C2 : CHAR;
S : STRING;
BEGIN
S:='';
B:=ITEM*35-22;
FOR A:=1 TO 28
DO BEGIN
C2:=SECTOR[B+A];
IF ORD(C2)<32
THEN C2:=' ';
IF ORD(C2)>127
THEN C2:=CHR(ORD(C2) MOD 128);
IF ORD(C2)>95
THEN C2:=CHR(ORD(C2)-48);
C:=' ';
C[1]:=C2;
S:=CONCAT(S,C)
END;
REPEAT
DELETE(S,LENGTH(S),1)
UNTIL COPY(S,LENGTH(S),1)<>' ';
GOTOXY(0,20);
WRITELN(' ');
GOTOXY(0,20);
WRITELN(S);
IF S=NAME
THEN MATCH:=TRUE
ELSE MATCH:=FALSE
END;
PROCEDURE INIT;
BEGIN
CH:=' ';
INITVOL;
REPEAT
TNUM:=17;
SNUM:=15;
GOTOXY(0,5);
WRITE('TRANSFER FILE? ');
READLN(NAME);
IF LENGTH(NAME)=0
THEN EXIT(TRANSFER);
REPEAT
READSECTOR(SECTOR,UNUMB,TNUM,SNUM);
FOR I:=1 TO 7
DO IF MATCH(I)
THEN EXIT(INIT);
SNUM:=SNUM-1
UNTIL SNUM=0;
WRITELN;
WRITELN('FILE NOT FOUND.',CHR(7))
UNTIL FALSE
END;
BEGIN (* MAIN *)
INIT;
REPEAT
GOTOXY(0,9);
WRITE('PASCAL FILE NAME ..................');
GOTOXY(0,9);
WRITE('PASCAL FILE NAME ');
READLN(NAME);
IF LENGTH(NAME)=0
THEN EXIT(TRANSFER);
(*$I-*)
RESET(TEMP,NAME);
IF IORESULT=0
THEN CLOSE(TEMP,PURGE);
REWRITE(TEMP,NAME);
(*$I+*)
UNTIL IORESULT=0;
GOTOXY(0,11);
WRITE('STRIP PARITY? ');
READ(KEYBOARD,CH);
GOTOXY(0,11);
IF CH='Y'
THEN WRITE('7 BIT DATA.')
ELSE WRITE('8 BIT DATA.');
WRITE(' ');
CLOSE(TEMP,LOCK);
RESET(DISK,NAME);
IF POS('.TEXT',NAME)<>0
THEN BNUM:=2
ELSE BNUM:=0;
TNUM:=ORD(SECTOR[I*35-24]);
SNUM:=ORD(SECTOR[I*35-23]);
READSECTOR(TSLIST,UNUMB,TNUM,SNUM);
REPEAT
TLINK:=ORD(TSLIST[1]);
SLINK:=ORD(TSLIST[2]);
TSPTR:=12;
REPEAT
TNUM:=ORD(TSLIST[TSPTR]);
SNUM:=ORD(TSLIST[TSPTR+1]);
IF (TNUM=0) AND (SNUM=0)
THEN BEGIN
IF J=0
THEN BEGIN
FOR I:=256 TO 511
DO BLOCK[I]:=CHR(0);
J:=BLOCKWRITE(DISK,BLOCK,1,BNUM);
GOTOXY(0,15);
WRITE('BLOCK: ',BNUM:3)
END;
CLOSE(DISK,LOCK);
EXIT(TRANSFER)
END;
GOTOXY(0,13);
WRITE('TRACK: ',TNUM:3,' SECTOR: ',SNUM:3,' ');
READSECTOR(SECTOR,UNUMB,TNUM,SNUM);
IF (TSPTR DIV 2) MOD 2 = 0
THEN J:=0
ELSE J:=256;
TSPTR:=TSPTR+2;
FOR I:=0 TO 255
DO BLOCK[I+J]:=SECTOR[I];
IF J=256
THEN BEGIN
K:=BLOCKWRITE(DISK,BLOCK,1,BNUM);
GOTOXY(0,15);
WRITE('BLOCK: ',BNUM:3);
BNUM:=BNUM+1
END
UNTIL TSPTR>255;
READSECTOR(TSLIST,UNUMB,TLINK,SLINK)
UNTIL FALSE;
WRITELN
END.