home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
windows
/
wincrd.zip
/
WINCRD.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1986-08-27
|
15KB
|
465 lines
program wincrd;
(*
This program converts a Microsoft Windows card file
file to or from an ASCII file format. The ASCII file
generated or read from consists of one card per line
with the fields delimited by a tab. The first field is
the card index line, with the remaining field being
lines on the card (a field in the ascii line will be
a series of characters ending in CR/LF on the card, it
may be more than one text line).
The variable fielddelimiter set in the procedure init
is used as the field delimiter, and may be changed to
anything desired. A tab was chosen because windows
cardfile does not use it.
This program only supports text cards, graphics is
not supported in any form.
No checking is done on the length of anything input, so
when converting from ASCII to cardfile, the user must
insure that the first field (card index line) is less
than 39 characters long.
*)
type
filebytetype = string[1];
var
Cardfile : file;
Asciifile : text;
cardfilename, asciifilename : string[64];
keyhit : string[1];
charactersin : array[1..1024] of char;
numberofcharacters : integer;
blockimage, blockimageblank : string[128];
currentblockindex : integer;
currentfilesize : integer;
i, j, k, l : integer;
numcards : integer;
xnumcards : real;
iop : integer;
indexchar, datachar : string[1];
indexblock, indexbyte : integer;
datablock, databyte : integer;
datalen : integer;
fielddelimiter : string [1];
indexout : boolean;
procedure openfilecardtoascii; forward;
function filebyte(blocknum,bytenum:integer):filebytetype;
var
block, byten : integer;
begin
block := blocknum * 2;
if bytenum > 127 then
begin
byten := bytenum-128;
block := block+1;
end
else
byten := bytenum;
if block = currentblockindex then
begin
filebyte:=blockimage[byten];
end
else
begin
seek(cardfile,block);
blockread(cardfile,blockimage,1);
currentblockindex := block;
filebyte:=blockimage[byten];
end;
end;
procedure waitforkey;
var
waitforkeybyte : string[1];
begin
read(kbd,waitforkeybyte);
end;
function getnumcards:integer;
begin
getnumcards := ord(filebyte(0,3)) + ord(filebyte(0,4)) * 256;
end;
procedure incrementindex(increment:integer);
begin
indexbyte := indexbyte + increment;
if indexbyte > 255 then
begin
indexbyte := indexbyte - 256;
indexblock := indexblock + 1;
end;
end;
procedure incrementdata(increment:integer);
begin
databyte := databyte + increment;
if databyte > 255 then
begin
databyte := databyte - 256;
datablock := datablock + 1;
end;
end;
procedure outputdata;
var
i : integer;
begin
incrementdata(2);
datalen := ord(filebyte(datablock,databyte));
incrementdata(1);
datalen := datalen + ord(filebyte(datablock,databyte)) * 256;
i := 1;
while i <= datalen do
begin
incrementdata(1);
datachar := filebyte(datablock,databyte);
if datachar = #13 then
begin
write(asciifile,fielddelimiter);
incrementdata(1);
i := i + 2;
end
else
begin
write(asciifile,datachar);
i := i + 1;
end;
end;
end;
procedure usermessage(icard:integer);
begin
gotoxy(29,3);
write(icard);
end;
procedure cardtoascii;
var
i, j : integer;
begin
openfilecardtoascii;
numcards := getnumcards;
clrscr;
writeln('Number of cards in file is ',numcards);
gotoxy(5,3);
write('Processing card number');
indexblock := 0;
indexbyte := 11;
for i := 1 to numcards do
begin
databyte := ord(filebyte(indexblock,indexbyte));
incrementindex(1);
j := ord(filebyte(indexblock,indexbyte));
incrementindex(1);
j := j + ord(filebyte(indexblock,indexbyte)) * 256;
datablock := j;
incrementindex(2);
indexout := true;
for j := 1 to 46 do
begin
incrementindex(1);
indexchar := filebyte(indexblock,indexbyte);
if indexout and (ord(indexchar) = 0) then
begin
indexout := false;
write(asciifile,fielddelimiter);
end;
if indexout then
begin
write(asciifile,indexchar);
end;
end;
incrementindex(2);
outputdata;
write(asciifile,#13,#10);
usermessage(i);
end;
close(asciifile);
close(cardfile);
end;
procedure openfilecardtoascii;
begin
clrscr;
writeln('Enter name of Cardfile file');
readln(cardfilename);
clrscr;
writeln('Enter name of Ascii file');
readln(asciifilename);
clrscr;
assign(cardfile,cardfilename);
assign(asciifile,asciifilename);
reset(cardfile);
rewrite(asciifile);
currentblockindex := -1;
end;
procedure openfileasciitocard;
begin
clrscr;
writeln('Enter name of Ascii file');
readln(asciifilename);
clrscr;
writeln('Enter name of Cardfile file');
readln(cardfilename);
clrscr;
assign(cardfile,cardfilename);
assign(asciifile,asciifilename);
rewrite(cardfile);
reset(asciifile);
currentblockindex := 0;
for I := 0 to 127 do
begin
blockimage[i] := chr(0);
end;
blockimage[0] := chr($4d);
blockimage[1] := chr($47);
blockimage[2] := chr($43);
seek(cardfile,currentblockindex);
blockwrite(cardfile,blockimage,1);
currentfilesize := filesize(cardfile);
end;
procedure closefileasciitocard;
begin
seek(cardfile,currentblockindex);
blockwrite(cardfile,blockimage,1);
close(cardfile);
close(asciifile);
end;
procedure checkfilesize(block:integer);
var
i : integer;
begin
if block >= currentfilesize then
begin
for i := currentfilesize to block do
begin
seek(cardfile,i);
blockwrite(cardfile,blockimageblank,1);
end;
currentfilesize := filesize(cardfile);
end;
end;
procedure outfilebyte(blocknum,bytenum:integer;outbyte:filebytetype);
var
block, byten : integer;
begin
block := blocknum * 2;
if bytenum > 127 then
begin
byten := bytenum - 128;
block := block + 1;
end
else
byten := bytenum;
if block = currentblockindex then
begin
blockimage[byten] := outbyte;
end
else
begin
seek(cardfile,currentblockindex);
blockwrite(cardfile,blockimage,1);
checkfilesize(block);
seek(cardfile,block);
blockread(cardfile,blockimage,1);
currentblockindex := block;
blockimage[byten] := outbyte;
end;
end;
function asciifilelength:integer;
var
i : integer;
begin
reset(asciifile);
i := 0;
while not eof(asciifile) do
begin
readln(asciifile,datachar);
i := i + 1;
end;
asciifilelength := i;
end;
procedure setstartofdata;
var
i : integer;
begin
xnumcards := numcards * 52.0 + 5.0;
xnumcards := xnumcards / 256.0 + 0.0001;
datablock := trunc(int(xnumcards));
databyte := trunc(frac(xnumcards) * 256.0);
indexblock := 0;
indexbyte := 3;
datachar := chr(numcards mod 256);
outfilebyte(indexblock,indexbyte,datachar);
indexbyte := 4;
datachar := chr(numcards div 256);
outfilebyte(indexblock,indexbyte,datachar);
indexbyte := 5;
end;
procedure outputindex;
var
i : integer;
begin
datachar := chr(0);
for i := 1 to 5 do
begin
outfilebyte(indexblock,indexbyte,datachar);
incrementindex(1);
end;
datachar := chr(256);
outfilebyte(indexblock,indexbyte,datachar);
incrementindex(1);
datachar := chr(databyte);
outfilebyte(indexblock,indexbyte,datachar);
incrementindex(1);
datachar := chr(datablock mod 256);
outfilebyte(indexblock,indexbyte,datachar);
incrementindex(1);
datachar := chr(datablock div 256);
outfilebyte(indexblock,indexbyte,datachar);
incrementindex(1);
datachar := chr(0);
for i := 1 to 2 do
begin
outfilebyte(indexblock,indexbyte,datachar);
incrementindex(1);
end;
indexout := true;
for i := 1 to 41 do
begin
if indexout then
begin
read(asciifile,datachar);
if datachar = chr(9) then
begin
indexout := false;
datachar := chr(0);
end;
end;
outfilebyte(indexblock,indexbyte,datachar);
incrementindex(1);
end;
end;
procedure outputasciidata;
var
i : integer;
begin
numberofcharacters := 0;
datachar := chr(0);
while not eoln(asciifile) do
begin
read(asciifile,datachar);
if datachar = chr(9) then
begin
numberofcharacters := numberofcharacters + 1;
charactersin[numberofcharacters] := chr(13);
numberofcharacters := numberofcharacters + 1;
charactersin[numberofcharacters] := chr(10);
end
else
begin
numberofcharacters := numberofcharacters + 1;
charactersin[numberofcharacters] := datachar;
end;
end;
readln(asciifile);
datachar := chr(0);
outfilebyte(datablock,databyte,datachar);
incrementdata(1);
outfilebyte(datablock,databyte,datachar);
incrementdata(1);
datachar := chr(numberofcharacters mod 256);
outfilebyte(datablock,databyte,datachar);
incrementdata(1);
datachar := chr(numberofcharacters div 256);
outfilebyte(datablock,databyte,datachar);
incrementdata(1);
for i := 1 to numberofcharacters do
begin
datachar := charactersin[i];
outfilebyte(datablock,databyte,datachar);
incrementdata(1);
end;
end;
procedure asciitocard;
begin
openfileasciitocard;
numcards := asciifilelength;
clrscr;
writeln('Number of cards in ASCII file ',numcards);
gotoxy(5,3);
write('Processing card number');
reset(asciifile);
setstartofdata;
for i := 1 to numcards do
begin
usermessage(i);
outputindex;
outputasciidata;
end;
closefileasciitocard;
end;
procedure initialize;
begin
fielddelimiter := #9;
for i := 0 to 128 do
begin
blockimageblank[i] := chr(0);
end;
end;
procedure finish;
begin
textcolor(14);
textbackground(0);
clrscr;
end;
procedure menu;
begin
iop := 1;
while iop <> 0 do
begin
clrscr;
writeln('Enter option');
writeln(' ');
writeln(' 0) Exit program');
writeln(' ');
writeln(' 1) Convert Cardfile to ASCII');
writeln(' 2) Convert ASCII to Cardfile');
read(kbd,keyhit);
iop := ord(keyhit) - 48;
case iop of
0: ;
1: cardtoascii;
2: asciitocard;
else
sound(600);
delay(180);
nosound;
end;
end;
clrscr;
end;
begin
initialize;
menu;
finish;
end.