DIPLOM1 (664325), страница 5

Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 5)

lh,lm,ls,lc : longint;

abstime1,abstime2: longint;

Begin

GetTime(h,m,s,c);

lh:=h; lm:=m; ls:=s; lc:=c;

abstime1:=lc+(ls*100)+(lm*60*100)+(lh*60*60*100);

Repeat

GetTime(h,m,s,c);

lh:=h; lm:=m; ls:=s; lc:=c;

abstime2:=lc+(ls*100)+(lm*60*100)+(lh*60*60*100);

Until (abstime2<>abstime1);

End;

Procedure MoveMan;

Var

addr : word;

a : byte;

x : word;

Begin

addr:=0;

For x:=0 To 80*25-1 Do

Begin

a:=screen[addr];

If (a>207)And(a<217) Then

inc(a);

If a=217 Then a:=208;

If a=205 Then a:=204 Else If a=204 Then a:=205;

screen[addr]:=a;

inc(addr,2);

End;

End;

Procedure MakeMans;

Var x: word;

Begin

For x:=0 To 80*25-1 Do

Begin

screen[x+x] :=177;

screen[x+x+1]:=16+7;

End;

End;

Procedure LoadFont;

Var

f: file;

Begin

Assign(f,curd+'axefont.fnt');

Reset(f,1);

Blockread(f,screen,50*80);

Close(f);

Asm

push bp

mov ax,segscr

mov es,ax

mov bp,ofsscr

mov bx,1000h

xor dx,dx

mov cx,256

mov ax,1100h

int 10h

pop bp

mov ah,1

mov cx,1000h

int 10h

End;

Cls;

End;

Procedure WaitKey;

Begin

WaitRt;

Map;

Repeat

Key:=ScanKey;

If Key=char(255) Then

Begin

Map;

MoveMan;

SkipTime;

End;

Until Key<>char(255);

End;

Procedure Window(xul,yul,xdr,ydr : byte; name : string);

Var

x,y : word;

Begin

Loc(xul,yul);

Wrt(up);

For x:=xul+2 To xdr Do Wrt('-');

For y:=yul+1 To ydr-1 Do

Begin

Loc(xul,y); Wrt(u0);

For x:=xul+1 To xdr-1 Do Wrt(' ');

Wrt(u1);

Shade(2);

End;

Loc(xul,y);

Wrt(u4);

For x:=xul+1 To xdr-1 Do Wrt(u7);

Wrt(u5);

Loc(xul+2,ydr);

Shade(xdr-xul+1);

x:=length(name) shr 1;

y:=(xdr-xul)shr 1+xul;

y:=y-x;

Loc(y+1,yul);

y:=clr;

x:=(clr and $F0)shr 4;

color(x,clr and $0F);

Wrt(name);

clr:=y;

lxul:=xul;

lyul:=yul;

lxdr:=xdr;

lydr:=ydr;

End;

Procedure Morph(xf1,yf1,xf2,yf2,xt1,yt1,xt2,yt2 : byte);

Var

x : word;

Begin

Window(xf1,yf1,xf2,yf2,'');

Repeat

MakeMans;

If xf1>xt1 Then dec(xf1,((xf1-xt1)Shr speed)+1);

If xf1

If yf1>yt1 Then dec(yf1,((yf1-yt1)Shr speed)+1);

If yf1

If xf2>xt2 Then dec(xf2,((xf2-xt2)Shr speed)+1);

If xf2

If yf2>yt2 Then dec(yf2,((yf2-yt2)Shr speed)+1);

If yf2

Window(xf1,yf1,xf2,yf2,'');

Map;

WaitRt;

Until (xf1=xt1)And(xf2=xt2)And(yf1=yt1)And(yf2=yt2);

End;

Procedure MorphL(xt1,yt1,xt2,yt2 : byte);

Var

x : word;

xf1,xf2,yf1,yf2 : byte;

Begin

xf1:=lxul; xf2:=lxdr;

yf1:=lyul; yf2:=lydr;

MorPh(xf1,yf1,xf2,yf2,xt1,yt1,xt2,yt2);

End;

Procedure WindowL(name : string);

Var

xf1,xf2,yf1,yf2 : byte;

Begin

xf1:=lxul; xf2:=lxdr;

yf1:=lyul; yf2:=lydr;

Window(xf1,yf1,xf2,yf2,name);

End;

Procedure Menu(x1,y1,stepy,all,col : byte; s1,s2,s3,s4,s5 : string;lenx : byte);

Var

x : byte;

yt : byte;

yp : byte;

Begin

yt:=y1;

For x:=1 To all Do

Begin

Loc(x1,yt);

Case x oF

1: Wrt(s1);

2: Wrt(s2);

3: Wrt(s3);

4: Wrt(s4);

5: Wrt(s5);

End;

yt:=yt+stepy;

End;

yp:=0;

yt:=clr;

clr:=col;

Repeat

Repeat {??}

Loc(x1-2,y1+(stepy*yp));

Wrt(char(204));

WaitKey;

Until (Key=chr(13))or(ScanCode=byte('H'))or(ScanCode=byte('P'))or(Key=chr(27));

Loc(x1-2,y1+(stepy*yp));

Wrt(' ');

If Key=chr(27) Then yp:=all-1;

If ScanCode=byte('P') Then If yp<(all-1) Then inc(yp);

If ScanCode=byte('H') Then If yp>0 Then dec(yp);

Until (Key=chr(13))or(Key=chr(27));

x:=x1-2;

Repeat

Loc(x,y1+(stepy*yp));

Wrt(' '+chr(205));

WaitRt;

Map;

inc(x,1);

Until x>=x1+lenx;

clr:=yt;

MenuP:=yp;

End;

Procedure HexL2Str(l : longint; var s : string);

Begin

s:=hex[(l shr (4*7))and 15];

s:=s+hex[(l shr (4*6))and 15];

s:=s+hex[(l shr (4*5))and 15];

s:=s+hex[(l shr (4*4))and 15];

s:=s+hex[(l shr (4*3))and 15];

s:=s+hex[(l shr (4*2))and 15];

s:=s+hex[(l shr (4*1))and 15];

s:=s+hex[(l)and 15];

End;

Procedure HexB2Str(l : byte; var s : string);

Begin

s:=hex[(l shr 4)and 15];

s:=s+hex[(l)and 15];

End;

Procedure MemEd(name: string);

Var

x,y : word;

l,l1,p,lpos : longint;

s,st : string;

stc : byte;

size : longint;

readsize : longint;

bank : word;

b1,b2 : byte;

flag : boolean;

i : searchrec;

Label Repaint, TryAgain;

Begin

TryAgain:

FindFirst(name,AnyFile,i);

If i.Attr And ReadOnly = ReadOnly Then

Begin

stc:=clr;

color(7,4);

MorPhL(20,7,56,15);

WindowL('File has ReadOnly Attribute!');

Menu(30,9,2,3,$4b,'Remove it','Reselect file','Exit','xxx4','xxx5',6);

If MenuP=1 Then

Begin

MenuP:=8;

exit;

End;

If MenuP=2 Then

Begin

MenuP:=0;

exit;

End;

clr:=stc;

assign(f,name);

SetFattr(f,(i.Attr xor ReadOnly));

MorPhL(0,0,77,24);

Color(7,6);

WindowL('Memory Editor');

goto TryAgain;

End;

Assign(f,name);

reset(f,1);

size:=FilesiZe(f);

l1:=0;

p:=0;

lpos:=0;

bank:=0;

flag:=false;

If size>35000 Then readsize:=35000 Else readsize:=size;

blockread(f,buffer^,readsize);

RePaint:

If l1 Div 32767 <> bank Then

Begin

If flag Then

Begin

color(7,4);

MorPhL(24,7,50,14);

WindowL('Save Changed Data?');

Menu(36,9,3,2,$4b,'YES','NO','xxx3','xxx4','xxx5',6);

If MenuP=0 Then

Begin

Seek(f,lpos);

blockwrite(f,buffer^,readsize);

End;

MorPhL(0,0,77,24);

Color(7,6);

WindowL('Memory Editor');

End;

lpos:=(l1 div 32767)*32767+(l1 div 32767);

Seek(f,lpos);

If size-l1>35000 Then readsize:=35000 Else readsize:=size-l1;

blockread(f,buffer^,readsize);

bank:=l1 div 32767;

flag:=false;

end;

l:=l1 and 32767;

Loc(2,1);

Wrt('address 0 1 2 3 4 5 6 7 8 9 A B C D E F ASCII');

For x:=2 To 22 Do

Begin

Loc(2,x);

HexL2Str(l+(l1 and (32767 xor $FFFFFFFF)),s);

Wrt(s+': ');

For y:=1 to 16 do

Begin

HexB2Str(buffer^[l],s);

Wrt(s+' ');

inc(l);

End;

For y:=16 Downto 1 Do

Begin

Wrt(char(buffer^[l-y]));

End;

End;

l:=l1 and 32767;

Repeat

Repeat

stc:=clr;

color(6,7);

HexB2Str(buffer^[l+p],s);

Loc((((p) and 15)*3)+13,(p) shr 4+2);

Wrt(s);

Loc((((p) and 15))+61,(p) shr 4+2);

Wrt(char(buffer^[l+p]));

clr:=stc;

WaitKey;

Until (Key=chr(13))or(ScanCode=$49)or(ScanCode=$51)or(ScanCode=$48)

or(ScanCode=$4D)or(ScanCode=$4B)or(ScanCode=$50)or(Key=chr(27))

or((Key>='0')and(Key='A')and(Upcase(Key)<='F'));

If (ScanCode=$48)or(ScanCode=$4d)or(ScanCode=$4b)or(ScanCode=$50) Then

Begin

HexB2Str(buffer^[l+p],s);

Loc((((p) and 15)*3)+13,(p) shr 4+2);

Wrt(s);

Loc((((p) and 15))+61,(p) shr 4+2);

Wrt(char(buffer^[l+p]));

End;

If ((Key>='0')And(Key='A')And(Upcase(Key)<='F')) Then

Begin

stc:=clr;

Key:=upcase(Key);

If (Key>='0')And(Key<='9') Then b1:=byte(Key)-byte('0') Else b1:=byte(Key)-byte('A')+10;

color(6,7);

Loc((((p) and 15)*3)+13,(p) shr 4+2);

Wrt(Key+'?');

Loc((((p) and 15))+61,(p) shr 4+2);

Wrt('?');

Repeat

WaitKey;

Until ((Key>='0')and(Key='A')and(Upcase(Key)<='F'))or(ScanCode=$0E);

Key:=upcase(Key);

If (Key>='0')And(Key<='9') Then b2:=byte(Key)-byte('0') Else b2:=byte(Key)-byte('A')+10;

If ((Key>='0')And(Key='A')And(Upcase(Key)<='F')) Then

Begin

buffer^[l+p]:=b1*16+b2;

flag:=true;

end;

clr:=stc;

end;

Case ScanCode of

$50: if l1+p+16320+15 then begin inc(l1,16); p:=320+(p and 15); goto RePaINt; end; end;

$48: begin if (p>15)or(l1<>0)then dec(p,16); if p<0 then begin dec(l1,16); p:=p and 15; goto RePaINt; end; end;

$4D: if l1+p+1320+15 then begin inc(l1,16); p:=320; goto RePaINt; end; end;

$4B: begin if (p>0)or(l1<>0)then dec(p); if p<0 then begin dec(l1,16); p:=15; goto RePaINt; end; end;

$49: begin if (l1>319) then begin dec(l1,320) end else l1:=0; goto RePaint; end;

$51: begin inc(l1,320); if l1>size-336 then l1:=size-336; goto RePaint; end;

end;

Until (key=chr(13))or(Key=chr(27));

If flag Then

Begin

color(7,4);

MorPhL(24,7,50,14);

WindowL('Save Changed Data?');

Menu(36,9,3,2,$4b,'YES','NO','','','',6);

If MenuP=0 Then

Begin

Seek(f,lpos);

blockwrite(f,buffer^,readsize);

End;

End;

close(f);

End;

Function LowCase(s : string) : string;

Var

x : integer;

Begin

LowCase:=s;

For x:=1 To length(s) Do

Begin

If (s[x]>='A')And(s[x]<='Z') Then LowCase[x]:=char((byte(s[x])-byte('A'))+byte('a'));

End;

End;

Procedure FFile(var s : string);

Var

i : searchrec;

name : string;

x,y,z: integer;

curp : integer;

curps: integer;

maxp : integer;

mask : string;

zs : string;

fz,dz: integer;

f : file of byte;

pos : longint;

Label Repaint;

Begin

s:='';

RePaint:

For y:=1 To 17 Do

Begin

Loc(23,3+y);

Wrt(' ');

End;

z :=0;

fz :=0;

dz :=1;

curp :=1;

curps:=1;

mask :='*.*';

FindFirst(mask,Directory,i);

Repeat

If (i.attr)And(Directory)=Directory Then

Begin

filx^[dz]:=i.name;

If i.name<>'.' Then inc(dz);

End

Else

Begin

dirx^[fz+1]:=LowCase(i.name);

inc(fz);

End;

FindNext(i);

Until DOSERROR<>0;

z:=dz+fz;

x:=1;

For y:=dz To z Do

Begin

filx^[y]:=dirx^[x];

inc(x);

End;

Repeat

maxp:=curp+17;

If maxp>(z-1) Then maxp:=(z-1);

For y:=curp To maxp Do

Begin

Loc(23,3+y-curp);

name:=filx^[curp+(y-curp)];

For x:=17 DownTo length(filx^[curp+(y-curp)]) Do name:=name+' ';

If curps=(y-curp+1) Then color(1,2) Else color(7,1);

Wrt(' '+name);

End;

Repeat

WaitKey;

Until (Key=chr(13))or(ScanCode=$48)or(ScanCode=$50)or(Key=chr(27))or(ScanCode=82);

Case ScanCode Of

$50: inc(curps);

$48: dec(curps);

82:

Begin

MOrPhL(10,10,40,15);

WindowL('Input File Name .ROM');

y :=1;

zs:=' ';

Loc(22,12);

Wrt('-');

Repeat

WaitKey;

Loc(21+y,12);

If (Key<>chr(13))And(Key<>chr(27)) Then

If (Key<>chr(08)) Then

Begin

If y<>9 Then

Begin

zs[y]:=Key;

Wrt(key+'-');

inc(y);

End;

End

Else

If y<>1 Then

Begin

dec(y);

Loc(21+y,12);

zs[y]:=' ';

Wrt('- ');

End;

Until (Key=Chr(13))or(Key=chr(27));

MorPhL(20,8,50,12);

Color(7,4);

WindowL('!!!!!!!!!!!!');

Loc(30,10);

Wrt('Жди давай!'+chr(208));

Map;

Assign(f,zs+'.ROM');

Rewrite(f);

y:=$FF;

For pos:=1 To romsize Do Write(f,byte(y));

close(f);

Key:=chr(255);

ScanCode:=0;

color(7,1);

MorPhL(20,2,50,22);

WindowL('Выберите файл');

s:='';

Goto RePaint;

End;

End;

If curps>(z-1) Then curps:=(z-1);

If (curps>18) Then

Begin

curps:=18;

If curp

End;

If (curps<1) Then

Begin

curps:=1;

If curp>1 Then dec(curp);

End;

Until (Key=chr(13))or(Key=chr(27));

Color(7,1);

If Key=chr(13) Then

Begin

FindFirst(filx^[curp+curps-1],00,i);

If DOSERROR<>0 Then

Begin chdir(filx^[curp+curps-1]);

Goto RePaint;

End;

s:=filx^[curp+curps-1];

End;

End;

Procedure ReadROM(addr : longint);

Var

x : word;

y : byte;

Begin

x:=addr;

port[$378]:=x and 65535;

port[$379]:=x shr 16;

y:=port[$380];

fake^[x and 65535]:=y;

End;

Var

x : byte;

s : string;

l : LONGINT;

y : longint;

zs : string;

rsz : longint;

fi,fo : file;

Label OpenF;

Begin

New(buffer);

New(filx);

New(dirx);

New(fake);

ofsscr:=ofs(screen);

segscr:=seg(screen);

LoadFont;

MakeMans;

GetDir(0,curd);

romsize:=0;

color(7,5);

Window(1,1,26,12,'Главное меню');

Repeat

MorPhL(1,1,26,12);

Color(7,5);

WindowL('Main Menu');

Menu(4,3,2,4,$5b,'Выбор ПЗУ','Работа с ПЗУ','О программе','Вы'+char(208)+'ход','',20);

case MenuP of

0:

Begin

Repeat

MorPhL(20,10,50,18);

color(7,1);

WindowL('Выбор типа ПЗУ');

Menu(23,12,2,3,$1b,'УФ ПЗУ','ПЗУ с плавкими перемычками','Назад','','',26);

case MenuP of

0:

Begin

MorPhL(10,10,29,18);

color(7,5);

WindowL('УФ ПЗУ');

Menu(13,12,2,3,$5b,'2176','573РФ','Назад','','',16);

If MenuP<>2 Then

Begin

romsize:=8*1024;

romname:=curd+'\amibio';

End;

If MenuP<>2 Then MenuP:=2 Else MenuP:=0;

End;

1:

Begin

MorPhL(40,8,70,16);

Color(7,5);

WindowL('ПЗУ с плавкими перемычками');

Menu(43,10,2,3,$5b,'155РЕ3','556РТ6','Назад','','',16);

If MenuP<>2 Then

Begin

romsize:=16*1024;

romname:=curd+'\amibio1';

end;

If MenuP<>2 Then MenuP:=2 Else MenuP:=0;

end;

end;

Until MenuP=2;

MenuP:=5;

end;

1:

Begin

If romsize=0 Then

Begin

MorPhL(21,6,49,10);

Color(7,4);

WindowL('Варнинг!!!');

Loc (25,8);

Wrt ('Пипл!!! Выбери ПЗУ!!!!');

WaitKey;

End

Else

Repeat

MorPhL(40,5,60,15);

Color(7,1);

WindowL('Работа с ПЗУ');

Menu(44,7,2,4,$1b,'Чтение','Запись','Тестирование','Назад','Num5',12);

Case MenuP Of

0:

Begin

MorPhl(22,7,50,11);

color(7,1);

WindowL('Чтение ПЗУ');

Loc(24,9);

Wrt('-------------------------');

For l:=0 To romsize Do

Begin

Loc(24+(l*24 div romsize),9);

Wrt ('-'+chr(208));

Color (3,1);

Map;

ReadROM(l);

End;

Color(7,1);

MorPhL(0,0,77,24);

Color(7,6);

WindowL('Просмотр прошивки');

MemEd(romname);

Color(7,4);

MorPhL(24,7,60,14);

WindowL('Сохранить прочитанные данные?');

Menu(40,9,3,2,$4b,'YES','NO','','','',6);

Case MenuP of

0:

Begin

MOrPhL(10,10,50,15);

WindowL('Имя сохраняемого образа .ROM');

y:=1;

zs:=' ';

Loc(26,12);

Wrt('-');

Repeat

WaitKey;

Loc(25+y,12);

If (Key<>chr(13))And(Key<>chr(27)) Then

If (Key<>chr(08)) Then

Begin

If y<>9 Then

Begin

zs[y]:=Key;

Wrt(key+'-');

inc(y);

End;

End

Else

If y<>1 Then

Begin

dec(y);

Loc(25+y,12);

zs[y]:=' ';

Wrt('- ');

End;

Until (Key=Chr(13))or(Key=chr(27));

If key=chr(13) Then

Begin

MorPhL(20,8,50,12);

Color(7,4);

WindowL('!!!!!!!!!!!!');

Loc(30,10);

Wrt('Жди давай!'+chr(208));

Map;

Assign(fo,zs+'.ROM');

Rewrite(fo,1);

Assign(fi,romname);

Reset(fi,1);

rsz:=FileSize(fi);

Repeat

y:=rsz;

If y>65535 Then y:=65535;

BlockRead(fi,buffer^,y);

BlockWrite(fo,buffer^,y);

rsz:=rsz-y;

Until rsz=0;

Close(fi);

Close(fo);

End;

End;

End;

MenuP:=5;

End;

1:

Begin

Repeat

MenuP:=1;

MorPhL(20,2,50,22);

color(7,1);

WindowL('Выберите файл');

FFile(s);

If s<>'' Then

Begin

MorPhL(0,0,77,24);

Color(7,6);

WindowL('Редактировение прошивки');

MemEd(s);

Color(7,4);

MorPhL(24,7,60,14);

WindowL('Прошить ПЗУ?');

Menu(40,9,3,2,$4b,'YES','NO','xxx3','xxx4','xxx5',6);

If MenuP=0 Then

Begin

MorPhl(22,7,50,11);

Color(7,1);

WindowL('Прошиваем ПЗУ');

Loc(24,9);

Wrt('-------------------------');

For l:=0 To romsize Do

Begin

Loc(24+(l*24 div romsize),9);

Wrt ('-'+chr(208));

Color (3,1);

Map;

ReadROM(l);

End;

End;

End;

Until MenuP<>8;

end;

2:

Begin

MorPhl(22,7,50,11);

color(7,1);

WindowL('Тестируем программатор');

Loc(24,9);

Wrt('-------------------------');

For l:=0 To 1000 Do

Begin

Loc(24+(l*24 div 1000),9);

Wrt ('-'+chr(208));

Color (3,1);

Map;

End;

Loc(23,9);

Wrt(chr(209)+' Все в порядке, аднака ');

waitkey;

End;

end;

Until MenuP=3;

MenuP:=5;

end;

2:

Begin

MorPhL(9,2,70,23);

color(7,0);

WindowL('О программе');

Loc(10,10);

For x:=1 To 60 Do Wrt(chr(210));

Loc(12,4);

Wrt('Дипломный проект "Лабораторный макет программатора ПЗУ"');

Loc(11,6);

Wrt('Это программка была написана в среде Borland Pascal v7.0');

Loc(13,8);

Wrt('Программа расчита на роботу с 2 типами микросхем ПЗУ');

Loc(36,12);

Wrt('Авторы:');

Loc(11,14);

Wrt('Идея и текст программы:');

Loc(25,15);

Wrt('Дмитрий В. Румянцев');

Loc(11,17);

Wrt('Помощь в написание программы:');

Loc(25,18);

Wrt('Dead Emotion //HellraiseR Group');

Loc(11,20);

Wrt('Тестирование программы:');

Loc(25,21);

Wrt('Алексек А. Иванов');

WaitKey;

MenuP:=5;

end;

end

until MenuP=3;

MorPhL(13,7,13,7);

asm

mov ax,3

int 10h

end;

end.

-69-

Характеристики

Список файлов реферата