unit sys;
{ FUNCTIONS AND PROCEDURES NOW:
7 SYS
10 VIDEO
20 KEYBOARD
3 TIMER (delay,sound,..)
6 POMOCNE(word2hex,srovnej,..)
}
interface
{ SYSTEM}
{1}function GetCOM1:word; {RS_232}
{2}function GetLPT1:word;
{3}function GetConventionalMem:word;{640 jinak virus!}
{4}function GetPcCode:byte;
{5}function GetHDDs :byte;{vraci pocet fyzickych HDD}
{6}function ChecksumOk:boolean;{testuje platnost kontrolniho souctu CMOS}
{7}function GetHDD1id:byte;{cte typ instalovaneho HDD}
{7}function GetHDD2id:byte;{cte typ instalovaneho HDD}
{8}function GetFDD1id:byte;
{9}function GetFDD2id:byte;
{0 =no, 1 =360k(5.25"), 2 =1.2M, 3 =720k(3.5"), 4 =1.44M}
{10}function GetCRC :word;{Crc CMOS pameti}
{11}function InstalledDrive:boolean;{instalovana mechanika?}
{12}function InstalledFPU:boolean;{instalovana 80287 koprocesor?}
{13}function PrimarniDisplay:byte;
{0 zadny or EGA,1 40-sl.CGA,2 80-sl.CGA,3 TTL mono.}
{14}function PocetMechaniK:byte;{1 1,2 2,..}
{15}function GetXtendetMem:word;{v kilobytech}
{ VIDEO }
{1}function GetVideoMode:byte;
{2}function GetVideoSIze:word;
{3}function Get_Ofset_Active_Page:word;{od videosegmentu b800}
{4}function GetActivePage:byte;
{5}function Get6845Addr:word;{adresa portu videokontroleru 6845}
{6}function GetCrtModeValue:byte;{6845}
{7}function GetCrtPaletteValue:byte;{6845}
{8}function GetX:byte;
{9}function GetY:byte;
{10}function GetSloupcu:word;
{ KEYBOARD }
{1}function GetALT_Numkey:byte;
{2}function GetHeadBuffer:word;{prave na rade}
{3}function GetEndBuffer:word;{konec bufferu klavesnice}
{status klavesnice:}
{4}function JePlnyVystupniBuffer:boolean;
{na datovem portu jsou neprevzana Data}
{5}function JePlnyVstupniBuffer:boolean;
{mikropocitac 8042 jeste neprevzal data z pocitace}
{6}function sysFlag8042:boolean;{systemova vlajka(Flag 0 Procesoru 8042}
{7}function PrikazVdat_Buf:boolean;{prikaz/data (flag 1 procesoru 8042)
je-li 1,byte v datovem bufferu je prikaz(pres port 64h)
0=data or parametr (port 60h)}
{8}function EnabledKeyboard:boolean;{klavesnice povolena or zakazana}
{9}function BylTimeOut:boolean;{obecny time-out.1 znamena , ze pri prenosu
dat mezi klavesnici a 8042 doslo k time-outu(vycerpani casu)}
{10}function ErrParity:boolean;{chyba parity ,1 znamena ,ze posledni prijaty
byte z klavesnice mel spatnou paritu}
{11}procedure cmd_KEYB(cmd_code,data_value:byte);{prikazy keyb LED,speed,..}
{oba do prikazoveho reg}
{12}procedure cmd_kontrolerKeyb(cmd_code,data_value:byte);
{cmd_code do 64h,data_val do 60h}
{13}procedure wrt_8048_64h(cmd_code:byte);{jen prikazy bez }
{14}procedure wrt_8048_60h(cmd_code:byte);{jakehokoliv parametru}
{15}procedure FlushKeyb;{vyprazdni keyb forntu}
{16}procedure vypr;
{17}procedure pause;
(*s vyprazdnenim buf:*)
{18}function je_k_buf(scan,ascii:byte):boolean;{key v bufferu klavesnice?}
{19}function je_znak_buf(scan,ascii:byte):boolean;{v buf. upcase(ascii)znak?}
{ predchzi jsou neprakticke-testuje se jen 1x 1 klavesa a vyprazdni se buf}
(* bez vyprazdneni bufferu *)
{20}function Je_v_buf(scan,ascii:byte):boolean;{bez vyprazdneni bufferu}
{21}function keyPressed:boolean;
{JOYSTIC}
{1}function GetJoy:byte;{vraci bity 4-7 tlacitka}
{bity [ 7 ] [ 6 ] [ 5 ] [ 4 ] ş [ 3 ] [ 2 ] [ 1 ] [ 0 ]
B2 B1 A2 A1 ş By Bx Ay Ax
tlacitka/spinace(digitalni vstupy)ş souradnice odporove/casove}
{ TIMER }
{1}procedure Nosound;
{2}procedure sound( hertz : word);
{3}procedure delay(ms:word);
{POMOCNE}
{1}function GetValW(segmentX,offsetX:word):word;
{2}function GetValB(segmentX,offsetX:word):byte;
{3}procedure PutValW(segmentX,offsetX,co:word);
{4}procedure PutValB(segmentX,offsetX:word;co:byte);
{5}function word2Hex(w: Word):string;
{6}procedure SrovnejW(var vetsi,mensi:word);
(****************************************************************************)
implementation
procedure pause;assembler;asm mov ah,00h;int 16h;end;
function word2Hex(w: Word):string;
var sx:string;
const
hexChars: array [0..$F] of Char ='0123456789ABCDEF';
begin
sx:=(hexChars[Hi(w) shr 4]);
sx:=sx+(hexChars[Hi(w) and $F]);
sx:=sx+(hexChars[Lo(w) shr 4]);
sx:=sx+(hexChars[Lo(w) and $F]);
word2Hex:=sx;
end;
function GetCom1:word; {RS_232}assembler;asm
xor cx,cx
mov es,cx
mov bx,0400h
mov ax,word PTR es:[bx]
end;
function GetLPT1:word; assembler;asm
xor cx,cx
mov es,cx
mov bx,0408h
mov ax,word PTR es:[bx]
end;
function GetConventionalMem:word;assembler;asm
xor cx,cx
mov es,cx
mov bx,0413h
mov ax,word PTR es:[bx]
end;
function GetVideoMode:byte;assembler;asm
xor cx,cx
mov es,cx ;{es :=cx (=0)}
mov bx,0449h
mov al,byte PTR es:[bx] ;{ 0 : 0449h}
end;
function GetALT_Numkey:byte;{get Alt + Num Key }assembler;asm
xor cx,cx
mov es,cx ;{es :=cx (=0)}
mov bx,0419h
mov al,byte PTR es:[bx] ;
end;
function GetHeadBuffer:word;{prave na rade}assembler;asm
xor cx,cx
mov es,cx ;{es :=cx (=0)}
mov bx,041Ah
mov ax,word PTR es:[bx] ;
end;
function GetEndBuffer:word;assembler;asm
xor cx,cx
mov es,cx
mov bx,041ch
mov ax,word PTR es:[bx] ;
end;
(*
procedure GetBuffer(var vys:buffer);assembler;
asm
push ds
mov bx,020h ;{velikost stringu[20h]}
mov di,offset vys
mov si,seg vys
mov ds,si
mov ds:[di],bl
mov bx,0
@here:
xor cx,cx
mov es,cx
mov di,041Eh
mov si,offset vys
mov al,byte PTR es:[di+bx] ;
mov [si+bx+1],al
inc bx
cmp bx,21h ;{20h +1}
je @konec
jmp @here
@konec:
pop ds
{MOV SP,BP ;{P©ˇtomen, kdy‘ Lok lnˇ <> 0}
{POP BP ;{P©ˇtomen, kdy‘ Lok lnˇ <> 0 nebo Param <> 0}
{RET Param ;{V‘dy p©ˇtomen}
end;
*)
procedure FlushKeyb;{vyprazdni keyb forntu}assembler;
asm
Push ax
@dalsi_znak:
mov ah,1 ; int 16h{pritomnost znaku ve fronte?};
Jz @navrat
xor ah,ah
int 16h{odstranit znak z fronty prectenim}
JMP @dalsi_znak
@navrat:
pop ax
end;
function GetSloupcu:word;assembler;asm
xor cx,cx
mov es,cx
mov bx,044Ah
mov ax,word PTR es:[bx] ;
end;
function GetVideoSIze:word;assembler;asm
xor cx,cx
mov es,cx
mov bx,044Ch
mov ax,word PTR es:[bx] ;
end;
function Get_Ofset_Active_Page:word;{od videosegmentu b800}assembler;asm
xor cx,cx
mov es,cx
mov bx,044eh
mov ax,word PTR es:[bx] ;
end;
function GetX:byte;assembler;asm
xor cx,cx
mov es,cx
mov bx,0450h
mov al,byte PTR es:[bx] ;
{dolni byte : sloupec}
end;
function GetY:byte;assembler;asm
xor cx,cx
mov es,cx
mov bx,0450h
mov al,byte PTR es:[bx+1] ;
{horni byte : radek}
end;
function GetActivePage:byte;assembler;asm
xor cx,cx
mov es,cx
mov bx,0450h
mov al,byte PTR es:[bx] ;
end;
function Get6845Addr:word;{adresa portu videokontroleru 6845}assembler;asm
xor cx,cx
mov es,cx
mov bx,0463h
mov ax,word PTR es:[bx] ;
end;
function GetCrtModeValue:byte;assembler;asm
xor cx,cx
mov es,cx
mov bx,0465h
mov al,byte PTR es:[bx] ;
end;
function GetCrtPaletteValue:byte;assembler;asm
xor cx,cx
mov es,cx
mov bx,0466h
mov ax,word PTR es:[bx] ;
end;
function GetPcCode:byte;assembler;asm
mov cx,0f000h
mov es,cx
mov bx,0fffeh
mov al,byte PTR es:[bx] ;
end;
procedure Nosound;assembler;
asm
in al,61h ;{ port 61h, 8255 port B, read}
and al,0FCh
out 61h,al ; {port 61h, 8255 B - spkr, etc}
; {al = 0, disable parity}
end;
procedure sound( hertz : word); Assembler;
asm MOV BX,SP;MOV BX,&hertz;MOV AX,34DDh;MOV DX,0012h;CMP DX,BX;JNB @J1;DIV BX;MOV BX,AX;IN AL,61h;TEST AL,03h
JNZ @J2;OR AL,03h;OUT 61h,AL;MOV AL,-4Ah;OUT 43h,AL;@J2: MOV AL,BL;OUT 42h,AL;MOV AL,BH;OUT 42h,AL;@J1:
end;
procedure delay(ms:word);assembler;asm mov ax,1000;mul ms;mov cx,dx;mov dx,ax;mov ah,$86;int $15;end;
procedure vypr;assembler;asm mov ah,$0c; mov al,$06; mov dl,$ff;int 21h end;
function GetValW(segmentX,offsetX:word):word;assembler;asm
mov es,segmentX
mov bx,offsetX
mov ax,word PTR es:[bx] ;
end;
function GetValB(segmentX,offsetX:word):byte;assembler;asm
mov es,segmentX
mov bx,offsetX
mov al,byte PTR es:[bx] ;
end;
procedure SrovnejW(var vetsi,mensi:word);
var pom:word;
begin
if vetsi<mensi then begin pom:=vetsi;
vetsi:=mensi;
mensi:=pom;
end;
end;
procedure PutValW(segmentX,offsetX,co:word);assembler;asm
mov es,segmentX
mov bx,offsetX
mov ax,co
mov word PTR es:[bx],ax ;
end;
procedure PutValB(segmentX,offsetX:word;co:byte);
assembler;asm
mov es,segmentX
mov bx,offsetX
mov al,co
mov byte PTR es:[bx],al ;
end;
function JePlnyVystupniBuffer:boolean;assembler;asm
in al,64h
and al,00000001b {abych zjistil posledni bit}
end;
function JePlnyVstupniBuffer:boolean;assembler;asm
in al,64h
and al,00000010b {abych zjistil posledni bit}
{shr al,1{neni potreba}
end;
function sysFlag8042:boolean;assembler;asm
in al,64h
and al,00000100b {abych zjistil posledni bit}
{shr al,2{neni potreba}
end;
function PrikazVdat_Buf:boolean;assembler;asm
in al,64h
and al,0001000b {abych zjistil posledni bit}
{shr al,3{neni potreba}
end;
function EnabledKeyboard:boolean;assembler;asm
in al,64h
and al,00010000b {abych zjistil posledni bit}
{shr al,4{neni potreba}
end;
function BylTimeOut:boolean;assembler;asm
in al,64h
and al,01000000b {abych zjistil posledni bit}
{shr al,6{neni potreba}
end;
function ErrParity:boolean;assembler;asm
in al,64h
and al,10000000b {abych zjistil posledni bit}
{shr al,7} {neni potreba}
end;
procedure cmd_KEYB(cmd_code,data_value:byte);assembler;asm
{pockat na klavesnici}
xor cx,cx ;{max . 65536x cekat}
@waCycl:
in al,64h ;{cist status keyb}
and al,2 ;{=10 -"vymaskovat bit 1"-prevzal 8042 uz data?}
loopNz @waCycl ;{jeste ne}
{hotovo}
mov al,cmd_code
out 60h,al
{pockat na klavesnici}
xor cx,cx ;{max . 65536x cekat}
@waCykl:
in al,64h ;{cist status keyb}
and al,2 ;{=10 -"vymaskovat bit 1"-prevzal 8042 uz data?}
loopNz @waCykl ;{jeste ne}
{hotovo}
mov al,data_value
out 60h,al
end;
procedure cmd_kontrolerKeyb(cmd_code,data_value:byte);assembler;asm
{pockat na klavesnici}
xor cx,cx ;{max . 65536x cekat}
@waCycl:
in al,64h ;{cist status keyb}
and al,2 ;{=10 -"vymaskovat bit 1"-prevzal 8042 uz data?}
loopNz @waCycl ;{jeste ne}
{hotovo}
mov al,cmd_code
out 64h,al
{pockat na klavesnici}
xor cx,cx ;{max . 65536x cekat}
@waCykl:
in al,64h ;{cist status keyb}
and al,2 ;{=10 -"vymaskovat bit 1"-prevzal 8042 uz data?}
loopNz @waCykl ;{jeste ne}
{hotovo}
mov al,data_value
out 60h,al
end;
procedure wrt_8048_64h(cmd_code:byte);{jen prikazy bez }assembler;asm
{pockat na klavesnici}
xor cx,cx ;{max . 65536x cekat}
@waCycl:
in al,64h ;{cist status keyb}
and al,2 ;{=10 -"vymaskovat bit 1"-prevzal 8042 uz data?}
loopNz @waCycl ;{jeste ne}
{hotovo}
mov al,cmd_code
out 64h,al
end;
procedure wrt_8048_60h(cmd_code:byte);{jakehokoliv parametru}assembler;asm
{pockat na klavesnici}
xor cx,cx ;{max . 65536x cekat}
@waCycl:
in al,64h ;{cist status keyb}
and al,2 ;{=10 -"vymaskovat bit 1"-prevzal 8042 uz data?}
loopNz @waCycl ;{jeste ne}
{hotovo}
mov al,cmd_code
out 64h,al
end;
function je_k_buf(scan,ascii:byte):boolean;assembler;
asm
@znova:
mov ah,11h
int 16h
jz @bad ;{buffer je prazdny , tak vyskocit}
cmp al,ascii
jnz @znovaX ;{neni to spravna klavesa ,dalsi}
cmp ah,scan
jnz @znovaX ;{neni to spravna klavesa,dalsi}
jz @ok ;{ascii i scan byly ok ->exit}
@znovaX:
mov ah,10h
int 16h ;{a odstranit ji z bufferu,lepe to zatim neumim nez INT 16H}
jmp @znova ;{dokud neni spravna key or empty buffer}
@Ok:
mov ax,1
jmp @konec
@bad:
xor ax,ax
jmp @konec
@konec:
end;
function keyPressed:boolean;assembler;
asm
@znova:
mov ah,11h
int 16h
xor ax,ax
jz @bad ;{buffer je prazdny , tak vyskocit}
mov ax,1
@bad:
end;
function je_znak_buf(scan,ascii:byte):boolean;{je v buf. upcase(znak)ascii?}assembler;
asm
@znova:
mov ah,11h
int 16h
jz @bad ;{buffer je prazdny , tak vyskocit}
{ v AH , AL je PISMENO}
cmp ah,scan
jnz @znovuX ;{neni to spravna klavesa,dalsi}
{jz @ok ;{ascii i scan byly ok ->exit}
{nejprve zjistim zda 'a'..'Z' pismeno }
{kdyz je <65;90>.. velke pismeno}{<97;122> ..male je o 32 vetsi jak velke}
cmp ascii,90
jg @v2 ;{muze to byt take male pismeno}
cmp ascii,65
jl @nepismeno ;{ <0;65) neni znak}
add ascii,32 ;{udelam male}
jmp @male ;{ok a muzu cmparovat}
@v2:{jestli je to male}
cmp ascii,97
jl @nepismeno
cmp ascii,122
jg @nepismeno
@male:
{v ascii je male pismeno:}
cmp ascii,al
jz @ok
add al,32
cmp ascii,al
jz @ok
jnz @znovuX
@nepismeno:
cmp ascii,al
jz @ok
@znovuX:
mov ah,10h
int 16h ;{a odstranit ji z bufferu,lepe to zatim neumim nez INT 16H}
jmp @znova ;{dokud neni spravna key or empty buffer}
@Ok:
mov ax,1
jmp @konec
@bad:
xor ax,ax
jmp @konec
@konec:
end;
function Je_v_buf(scan,ascii:byte):boolean;assembler;var head,tail:word;asm
push di
xor di,di
mov es,di ;{es :=cx (=0)}
mov bx,041Ah
mov ax,word PTR es:[bx] ;
mov head,ax ;{mam Head}
mov ax,word PTR es:[bx+2] ;
mov tail,ax ;{a tail}
cmp head,ax ;{s tail}
je @prazdny ;{if head=tail then exit}
mov bx,041Eh ;{offset zacatku bufferu klavesnice}
mov di,head ;{DI := Head div 2}
sub di,01Eh ;{a udelam z toho relat.posunuti}
{shr di,1 ;{v DI je rel.offset 1. znaku od BX}
@tady:
mov ax,word PTR ES:[bx+di] ;{znak z 41eh+DI -> AX}
cmp ah,scan
jne @dalsi;{if ah<>scan then if bx<EndBuffer thne inc(bx,2)}
{a ascii}
cmp al,ascii
je @ok
@dalsi:
cmp di,20h
jne @dal ;{jestli bx+di je 41Eh+20H + ->41Eh}
xor di,di
@dal:
mov dx,di
add dx,1Eh
cmp dx,Tail
je @prazdny ;{if buffer cely prosel then exit(false)}
add di,1
jmp @tady ;{rep until najdes or neni_vubec v bufferu}
@ok:
mov ax,1
jmp @konec
@prazdny:
mov ax,0
@konec:
pop di
end;
function GetJoy:byte;assembler;asm
mov dx,201h
out dx,al ;{cokoliv ,inicializace prenosu}
in al,dx
end;
function GetHDDs :byte;{vraci pocet fyzickych HDD}assembler;asm
xor cx,cx
mov es,cx
mov bx,0475h
mov al,byte PTR es:[bx] ;
end;
function ChecksumOk:boolean;{testuje platnost kontrolniho souctu CMOS}assembler;asm
mov al,0eh
out 70H,al
mov cx,2
@dd:
nop
loop @dd ;{chvili pockat,aby to stihl}
in al,71H
and al,64
mov ax,1
je @ok
xor ax,ax
@ok:
end;
function GetHDD1id:byte;{cte typ instalovaneho HDD}assembler;asm
mov al,12h
out 70h,al ;{urci adresu Cmos 12h}
mov cx,2
@dd:
nop
loop @dd ;{chvili pockat,aby to stihl}
in al,71h ;{typ drive 1-14}
and al,00001111b
cmp al,14 ;{jinak na adrese Cmos 19h}
jg @jiny
cmp al,0
je @jiny
jmp @end ;{jmp if 14 greater}
@jiny:
mov al,19h
out 70h,al ;{urci adresu Cmos 12h}
mov cx,2
@dd2:
nop
loop @dd2 ;{chvili pockat,aby to stihl}
in al,71h ;{typ drive}
@end:
end;
function GetHDD2id:byte;{cte typ instalovaneho HDD}assembler;asm
mov al,12h
out 70h,al ;{urci adresu Cmos 12h}
mov cx,2
@dd:
nop
loop @dd ;{chvili pockat,aby to stihl}
in al,71h ;{typ drive 1-14}
shr al,4
cmp al,14 ;{jinak na adrese Cmos 19h}
jg @jiny
cmp al,0
je @jiny
jmp @end ;{jmp if 14 greater}
@jiny:{ neg<1;14>}
mov al,1ah
out 70h,al ;{urci adresu Cmos 12h}
mov cx,2
@dd2:
nop
loop @dd2 ;{chvili pockat,aby to stihl}
in al,71h ;{typ drive}
@end:
end;
function GetFDD1id:byte;{cte typ instalovaneho FDD}assembler;asm
mov al,10h
out 70h,al ;
mov cx,2
@dd:
nop
loop @dd ;{chvili pockat,aby to stihl}
in al,71h ;{typ drive}
shr al,4
end;
function GetFDD2id:byte;{cte typ instalovaneho FDD2}assembler;asm
mov al,10h
out 70h,al ;
mov cx,2
@dd:
nop
loop @dd ;{chvili pockat,aby to stihl}
in al,71h ;{typ Fdrive}
and al,00001111b
end;
function GetCRC :word;{Crc CMOS pameti}assembler;asm
mov al,2eh
out 70h,al ;
mov cx,2
@dd:
nop
loop @dd ;{chvili pockat,aby to stihl}
in al,71h
mov dh,al ;{vyssi byte zatim ulozim do dh ,mov rychlejsi jak push a pop}
mov al,2fh
out 70h,al ;
mov cx,2
@dd2:
nop
loop @dd2 ;{chvili pockat,aby to stihl}
in al,71h ;{a nizsi byte AX}
mov ah,dl
end;
function InstalledDrive:boolean;{instalovana mechanika?}assembler;asm
mov al,14h ;{byte vybaveni}
out 70h,al ;
mov cx,2
@dd:
nop
loop @dd ;{chvili pockat,aby to stihl}
in al,71h
and al,00000001b
end;
function InstalledFPU:boolean;{instalovana 80287 koprocesor?}assembler;asm
mov al,14h ;{byte vybaveni}
out 70h,al ;
mov cx,2
@dd:
nop
loop @dd ;{chvili pockat,aby to stihl}
in al,71h
{and al,00000010b} ;{neni potreba al>0 true}
shr al,1
end;
function PrimarniDisplay:byte;assembler;asm
mov al,14h ;{byte vybaveni}
out 70h,al ;
mov cx,2
@dd:
nop
loop @dd ;{chvili pockat,aby to stihl}
in al,71h
and al,00110000b ;
shr al,4
end;
function PocetMechaniK:byte;{0 0,1 1,..}assembler;asm
mov al,14h ;{byte vybaveni}
out 70h,al ;
mov cx,2
@dd:
nop
loop @dd ;{chvili pockat,aby to stihl}
in al,71h
and al,11000000b ;
shr al,6
inc al
end;
function GetXtendetMem:word;assembler;asm
mov al,18h
out 70h,al
mov cx,2
@dd:
nop
loop @dd ;{chvili pockat,aby to stihl}
in al,71h
mov dh,al ;{nizsi byte}
mov al,18h
out 70h,al
mov cx,2
@dd2:
nop
loop @dd2 ;{chvili pockat,aby to stihl}
in al,71h
mov ah,dh
end;
end.