Browse Source

feat: ajout licence GPL V2.0 et informations sous forme de fichiers. Logiciel communication LPT. Gestion de l'heure.

feature/test
Nicolas Hordé 23 years ago
parent
commit
4fad0d98a3
  1. 67
      INFORMATIONS.md
  2. 1017
      LICENSE.md
  3. 0
      install/setup.asm
  4. 0
      programs/cos.bmp
  5. 0
      programs/cos.rip
  6. 471
      programs/lpt/com.asm
  7. 12
      programs/lpt/project1.dpr
  8. 34
      programs/lpt/project1.opt
  9. BIN
      programs/lpt/project1.res
  10. BIN
      programs/lpt/unit1.dcu
  11. BIN
      programs/lpt/unit1.dfm
  12. 517
      programs/lpt/unit1.pas

67
INFORMATIONS.md

@ -1,36 +1,53 @@
< COS2000 the new operating system >
< COS2000 the new operating system >
I. Présentation
COS2000, par définition est système d'exploitation, celui prend la direction des opérations à partir du moment où le PC est mis sous tension (Aprés le BIOS). Celui gére tous les périphériques rattaché au PC et offre aux programmeur les moyens de développer des applications compatibles : les APIs. COS2000 est basé sur un concept particulier qui est d'offrir au programmeur un maximum de fonctions intégrés pour faciliter le travail des programmeurs et réduire la taille des programmes.
COS2000, par définition, est système d'exploitation. Celui-ci prend la direction des opérations à partir
du moment où le PC est mis sous tension (Après le BIOS). Il gère tous les périphériques rattachés au PC et
offre aux programmeurs les moyens de développer des applications compatibles en fournissant des APIs
(Application Programming Interface). COS2000 est basé sur un concept particulier qui est d'offrir aux
programmeurs un maximum de fonctions intégrées pour faciliter le travail des programmeurs et réduire la
taille des programmes.
II. Comment l'installer ?
II. Mode d'emploi
Pour installer COS2000 :
Pour installer COS2000 :
- Insérez une disquette 1.44 Mo dans votre lecteur.
- Lancez le programme Setup.com.
- Si celui-ci ne détecte pas d'erreur, COS2000 est installé !
- Insérez une disquette 1.44 Mo vierge ou inutile dans votre lecteur.
- Lancez le programme SETUP.COM situé dans le dossier de COS2000.
- Si celui-ci ne détecte pas d'erreur, COS2000 est installé !
Pour lancer COS2000 :
- Insérez la disquette où COS2000 est installé.
- Veillez que dans le BIOS vous puissiez démarrer à partir de A:.
- Redémarrer votre ordinateur et vous serez sur COS2000.
Pour lancer COS2000 :
Pour utiliser COS2000 :
- Insérez la disquette où COS2000 est installé.
- Veillez que dans le BIOS vous puissiez démarrer à partir de A:.
- Redémarrer votre ordinateur et vous serez sur COS2000.
Le COS MENU LOADER est le premier logiciel qui est lancé au démarrage. A partir de celui-ci vous pouvez visionner tout les fichiers présents sur votre disquette et éventuellement s'il possèdent l'extension EXE, ils peuvent être exécutés.
Pour cela il suffit de sélectionner avec la ligne en surbrillance le programme à executer en utilisant les flêches de directions, pour éxecuter le programmer presser la touche "Entrée".
A partir du COS MENU LOADER on peut lancer un interpréteur de commandes . Celui s'appelle PROMPT.EXE.
Une fois dans l'interpréteur de commande vous pouvez tout aussi bien lancer des logiciels en saissisant leurs noms après "COS>".
Il est possible de télécharger une version plus récente de COS2000 à :
En plus des logiciels, l'interpréteur de commande peut exécuter 6 commandes :
EXIT Quitte l'interpréteur
VERSION Donne la version de COS2000
CLS Efface l'écran
REBOOT Redémarre le PC
COMMAND Donne la liste des commandes disponibles
MODE [mode] Permet de changer de mode vidéo, [mode] doit être un nombre entre 1 et 9.
les modes au delà de 4 sont des modes graphiques à texte émulé, il est
déconseillé de les utiliser car il est parfois impossible de revenir aux modes texte.
https://github.com/dahut87/cos2000v1
III. Mode d'emploi
Le COS MENU LOADER est le premier logiciel qui est lancé au démarrage. A partir de celui-ci, vous pouvez
visionner tout les fichiers présents sur votre disquette et éventuellement les exécuter s'ils possèdent
l'extension EXE . Pour cela, il suffit de sélectionner avec la ligne en surbrillance le programme à exécuter
en utilisant les flèches de direction. Pour exécuter le programmer, pressez la touche "Entrée".
A partir du COS MENU LOADER on peut lancer un interpréteur de commandes . Celui-ci s'appelle PROMPT.EXE.
Une fois dans l'interpréteur de commande, vous pouvez tout aussi bien lancer des logiciels en saisissant leurs
noms après "COS>".
En plus des logiciels, l'interpréteur de commandes peut exécuter 6 commandes :
EXIT Quitte l'interpréteur
VERSION Donne la version de COS2000
CLS Efface l'écran
REBOOT Redémarre le PC
COMMAND Donne la liste des commandes disponibles
MODE [mode] Permet de changer de mode vidéo. [mode] doit être un entier compris entre 1 et 9. les
modes au delà de 4 sont des modes graphiques à texte émulé. Il est déconseillé de les
utiliser car il est parfois impossible de revenir aux modes texte.
Les possibilités de COS2000 sont aujourd'hui très limitées car il est en cours de développement.

1017
LICENSE.md

File diff suppressed because it is too large Load Diff

0
commande/setup.asm → install/setup.asm

0
cos.bmp → programs/cos.bmp

Before

Width:  |  Height:  |  Size: 64 KiB

After

Width:  |  Height:  |  Size: 64 KiB

0
cos.rip → programs/cos.rip

Before

Width:  |  Height:  |  Size: 15 KiB

After

Width:  |  Height:  |  Size: 15 KiB

471
programs/lpt/com.asm

@ -0,0 +1,471 @@
.model tiny
.486
smart
.code
org 0100h
start:
;call setemettor
call getfirstlpt
call initlpt
call receivecommand
ret
gogo db 'Salut'
gotoz db 23 dup (0)
;Re‡ois une commande et l'execute
Receivecommand:
push ax bx cx di es
push cs
pop es
mov di,offset command
call receivelptblock
mov bl,al
xor bh,bh
shl bx,1
add bx,offset cmd
call [bx]
pop es di cx ax
ret
command db 25 dup (0)
cmd dw nothings
dw sendram
nothings:
ret
Sendram:
push ax cx si ds
mov ax,es:[di]
mov si,ax
mov ax,es:[di+2]
mov ds,ax
mov cx,es:[di+2]
call sendlptblock
pop ds si cx ax
ret
;---------Segment Adress-----------
Bios equ 040h
;---------Offset Adress------------
Lptadr equ 008h
Timer equ 06Ch
;---------Constant-----------------
onesec equ 18
tensec equ 182
Ack equ 00
Nack equ 0FFh
maxtry equ 10
tokenstart equ 0
tokennext equ 1
tokenstop equ 2
tokenbad equ 3
tokenresend equ 4
Initlpt:
push ax ecx
call StartTimer
cmp emettor,0
je receptinit
mov al,10000b
call SetLptOut
waitinit1:
call EndTimer
cmp cx,cs:timeout
ja errorinit
call getlptIn
cmp al,00000b
jnz waitinit1
jmp endinit
receptinit:
call EndTimer
cmp cx,cs:timeout
ja errorinit
call getlptIn
cmp al,00000b
jnz receptinit
mov al,10000b
call SetLptOut
endinit:
clc
pop ecx ax
ret
errorinit:
stc
pop ecx ax
ret
;-Envoie DL (dh) JNE si problŠme JNC error timeout
Sendlpt:
push ax bx ecx
call StartTimer
mov dh,dl
mov al,dl
and al,0Fh
call SetLptOut
waitSend:
call EndTimer
cmp cx,cs:timeout
ja errorsend
call getlptIn
bt ax,4
jnc waitsend
and al,0Fh
mov bl,al
call StartTimer ;/////
mov al,dh
shr al,4
or al,10000b
call SetLptOut
waitSend2:
call EndTimer
cmp cx,cs:timeout
ja errorsend
call getlptIn
bt ax,4
jc waitsend2
and al,0Fh
shl al,4
add bl,al
cmp dl,bl
pop ecx bx ax
clc
ret
errorsend:
pop ecx bx ax
stc
ret
;-Re‡ois DL (dh)
Receivelpt:
push ax bx ecx
call StartTimer
waitreceive:
call EndTimer
cmp cx,cs:timeout
ja errorreceive
call getlptIn
bt ax,4
jnc waitreceive
and al,0Fh
mov dl,al
call SetLptOut
call StartTimer ;/////
waitreceive2:
call EndTimer
cmp cx,cs:timeout
ja errorreceive
call getlptIn
bt ax,4
jc waitreceive2
and al,0Fh
mov dh,al
shl dh,4
add dl,dh
or al,10000b
call SetlptOut
clc
pop ecx bx ax
ret
errorreceive:
stc
pop ecx bx ax
ret
;-AX
SetTimeout:
mov cs:Timeout,ax
ret
timeout dw tensec
getTimeout:
mov ax,cs:Timeout
ret
SetEmettor:
mov cs:Emettor,1
ret
Emettor db 0
SetReceptor:
mov cs:Emettor,0
ret
;->bx Nøport->Adresse dx
GetLpt:
push ax bx ds
mov ax,bios
mov ds,ax
dec bx
shl bx,1
mov dx,ds:[Lptadr+bx]
mov cs:lpt,dx
pop ds bx ax
ret
lpt dw 0
;->bx Nøport->Adresse dx
GetFirstLpt:
push ax ds
mov ax,bios
mov ds,ax
xor bx,bx
findlpt:
mov dx,ds:[Lptadr+bx]
cmp dx,0
jne oklpt
add bx,2
cmp bx,4
jbe findlpt
oklpt:
mov cs:lpt,dx
pop ds ax
ret
;->
StartTimer:
push ax ecx ds
mov ax,Bios
mov ds,ax
mov ecx,ds:[timer]
mov times,ecx
pop ds ecx ax
ret
times dd 0
;->Ecx time elapsed
EndTimer:
push ax ds
mov ax,Bios
mov ds,ax
mov ecx,ds:[timer]
sub ecx,times
mov ecx,0
pop ds ax
ret
;->
GetLptOut:
push dx
mov dx,lpt
in al,dx
pop dx
ret
GetLptIn:
push dx
mov dx,lpt
inc dx
in al,dx
shr al,3
pop dx
ret
GetLptInOut:
push dx
mov dx,lpt
add dx,2
in al,dx
and al,11111b
pop dx
ret
SetLptOut:
push dx
mov dx,lpt
out dx,al
pop dx
ret
SetLptIn:
push dx
mov dx,lpt
inc dx
out dx,al
pop dx
ret
SetLptInOut:
push dx
mov dx,lpt
add dx,2
out dx,al
pop dx
ret
;R‚alise un checksum 8 bits sur donn‚es DS:SI, nb CX r‚sultat dans dl
Checksum8:
push cx si
check:
add dl,[si]
inc si
dec cx
jnz check
pop si cx
ret
;DS:SI pointeur sur donn‚es, CX nombres de donn‚es, AL token
SendLptBlock:
push ax bx cx edx si edi bp
mov dx,cx
shl edx,16
mov dh,al
call checksum8
mov edi,edx
xor dh,dh
mov bp,dx
mov ah,maxtry
retry:
mov bl,4
xor al,al
header:
mov dx,di
call sendlpt
setne al
jc outt
rol edi,8
dec bl
jnz header
cmp al,0
jne notgood
mov dl,ACK
jmp allsend
notgood:
mov dl,NACK
allsend:
call sendlpt
setne al
jc outt
cmp al,0
je okheader
dec ah
jnz retry
jmp outt
okheader:
cmp cx,0
je endoftrans
mov di,maxtry
retry2:
mov bx,cx
xor ax,ax
body:
mov dl,[si+bx-1]
add ah,dl
call sendlpt
setne al
jc outt
dec bx
jnz body
cmp al,0
jne notgood2
mov dl,ACK
jmp allisend
notgood2:
mov dl,NACK
allisend:
call sendlpt
setne al
jc outt
cmp al,0
je endoftrans
dec di
jnz retry2
outt:
stc
endoftrans:
mov al,ah
xor ah,ah
cmp bp,ax
pop bp edi si edx cx bx ax
ret
;Receptionne en es:di les donn‚es au nombres de CX token AL (AH) (ECX)
receiveLptBlock:
push ax bx dx si bp
mov ah,maxtry
retrye:
mov bl,4
headere:
call receivelpt
jc outte
mov cl,dl
rol ecx,8
dec bl
jnz headere
call receivelpt
jc outte
cmp dl,ACK
je okheadere
dec ah
jnz retrye
jmp outte
okheadere:
mov al,ch
xor ch,ch
mov bp,cx
rol ecx,16
cmp cx,0
je endoftranse
mov si,maxtry
retrye2:
mov bx,cx
xor ah,ah
bodye:
call receivelpt
jc outte
mov es:[di+bx-1],dl
add ah,dl
dec bx
jnz bodye
call receivelpt
jc outte
cmp dl,ACK
je endoftranse
dec si
jnz retrye2
outte:
stc
endoftranse:
mov bl,ah
xor bh,bh
cmp bp,bx
pop bp si dx bx ax
ret
end start;

12
programs/lpt/project1.dpr

@ -0,0 +1,12 @@
program Project1;
uses
Forms,
Unit1 in 'UNIT1.PAS' {Form1};
{$R *.RES}
begin
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

34
programs/lpt/project1.opt

@ -0,0 +1,34 @@
[Compiler]
A=1
B=0
D=1
F=0
I=1
K=1
L=1
P=1
Q=0
R=0
S=1
T=0
U=1
V=1
W=0
X=1
Y=1
[Linker]
MapFile=0
LinkBuffer=0
DebugInfo=0
OptimizeExe=0
StackSize=16384
HeapSize=8192
[Directories]
OutputDir=
SearchPath=
Conditionals=
[Parameters]
RunParams=

BIN
programs/lpt/project1.res

Binary file not shown.

BIN
programs/lpt/unit1.dcu

Binary file not shown.

BIN
programs/lpt/unit1.dfm

Binary file not shown.

517
programs/lpt/unit1.pas

@ -0,0 +1,517 @@
unit Unit1;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Grids, Outline, DirOutln, FileCtrl, Buttons,
Gauges, ExtCtrls, Spin, Mask;
type
TForm1 = class(TForm)
DriveComboBox1: TDriveComboBox;
FilterComboBox1: TFilterComboBox;
FileListBox1: TFileListBox;
DirectoryListBox1: TDirectoryListBox;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
Memo1: TMemo;
Memo2: TMemo;
Memo3: TMemo;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
Gauge1: TGauge;
SpeedButton5: TSpeedButton;
SpeedButton6: TSpeedButton;
SpinButton1: TSpinButton;
MaskEdit1: TMaskEdit;
SpeedButton8: TSpeedButton;
SpinButton2: TSpinButton;
okm: TCheckBox;
Label1: TLabel;
procedure FormActivate(Sender: TObject);
procedure SpinButton1DownClick(Sender: TObject);
procedure SpinButton1UpClick(Sender: TObject);
procedure showadress(Sender: TObject);
procedure SpeedButton6Click(Sender: TObject);
procedure SpeedButton8Click(Sender: TObject);
procedure MaskEdit1Change(Sender: TObject);
procedure SpinButton2DownClick(Sender: TObject);
procedure SpinButton2UpClick(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure Memo2Click(Sender: TObject);
private
{ Private-déclarations }
public
{ Public-déclarations }
end;
const UNESEC = 1000;
DIXSEC = 4000;
ACK = $00;
NAK = $FF;
MAXTRY = 5;
type DBloc = array[ 1..15534 ] of byte;
type BHEADER = record
case boolean of
true : ( Checksum:byte;
Lenb : byte;
Lenh : byte;
Token : byte;
);
false : ( Champ : array[ 0..3 ] of byte );
end;
var
Form1: TForm1;
Inlpt : word;
Outlpt : word;
times : longint;
Block : DBLOC;
adress :longint;
errors: boolean;
reste:integer;
pop:boolean;
implementation
{$R *.DFM}
function Getlpt( Number : integer ) : boolean;
begin
Outlpt := MemW[ $0040: 6 + Number * 2 ];
if ( Outlpt <> 0 ) then
begin
Inlpt := Outlpt + 1;
Getlpt := TRUE;
end
else
Getlpt := FALSE;
end;
function getfirstlpt:byte;
var i:integer;
begin
i:=1;
while (not(getlpt(i)) or (i>4)) do inc(i);
if (getlpt(i)=false) then i:=0;
getfirstlpt:= i;
end;
function getb:byte;
begin
getb:=port[inlpt] and $F8
end;
procedure putb(what:byte);
begin
port[outlpt]:=what;
end;
procedure starttimer;
begin
times:=GetTickCount;
end;
function endtimer:longint;
begin
endtimer:=getTickCount-times;
end;
function Initlpt( Emetteur : boolean ) : boolean;
begin
errors:=false;
putb($10);
putb($18);
putb($10);
starttimer;
if ( Emetteur ) then
begin
while ( ( GetB <> $00 ) and ( Endtimer <= DIXSEC ) ) do;
end
else
begin
while ( ( GetB <> $00 ) and ( Endtimer <= DIXSEC ) ) do;
PutB( $10 );
end;
Initlpt := ( Endtimer <= DIXSEC );
end;
function sendlpt( Wert : byte ) : boolean;
var Retour : byte;
label fin;
begin
if errors then goto fin;
Starttimer;
PutB( Wert and $0F );
while ( ( ( GetB and 128 ) = 0 ) and ( Endtimer <= DIXSEC )) do;
if ( Endtimer > DIXSEC ) then
begin
errors:=true;
goto fin;
end;
Retour := ( GetB shr 3 ) and $0F;
Starttimer;
PutB( ( Wert shr 4 ) or $10 );
while ( ( ( GetB and 128 ) <> 0 ) and ( Endtimer <= DIXSEC ) ) do
if ( Endtimer > DIXSEC ) then
begin
errors:=true;
goto fin;
end;
Retour := Retour or ( ( GetB shl 1 ) and $F0 );
fin:
sendlpt := ( Wert = Retour );
end;
function receivelpt : byte;
var LoNib,
HiNib : byte;
label fin;
begin
if errors then goto fin;
Starttimer;
while ( ( ( GetB and 128 ) = 0 ) and ( Endtimer <= DIXSEC )) do;
if ( Endtimer > DIXSEC ) then
begin
errors:=true;
goto fin;
end;
LoNib := ( GetB shr 3 ) and $0F;
PutB( LoNib );
Starttimer;
while ( ( ( GetB and 128 ) <> 0 ) and ( Endtimer <= DIXSEC ) ) do;
if ( Endtimer > DIXSEC ) then
begin
errors:=true;
goto fin;
end;
HiNib := ( GetB shl 1 ) and $F0;
PutB( ( HiNib shr 4 ) or $10 );
fin:
receivelpt := ( LoNib or HiNib );
end;
function checksum8(Nombre:word;Dptr : pointer):byte ;
var donnees : ^DBloc ;
i:word;
ch:byte;
begin
ch:=0;
donnees:=dptr;
for i:=1 to Nombre do ch:=ch + Donnees^[ i ];
checksum8:=ch;
end;
function SendlptBlock( Token : byte;
Nombre : word;
Dptr : pointer ):boolean;
var header : BHEADER;
ok : boolean;
i : word;
trys : word;
Donnees : ^DBloc;
label fin;
begin
form1.gauge1.visible:=true;
header.Token := Token;
header.Lenb := (Nombre and $FF00) shr 8;
header.Lenh := Nombre and $FF;
header.Checksum:=checksum8(nombre,Dptr);
trys := MAXTRY;
repeat
ok := TRUE;
for i := 0 to 3 do
ok := ok and sendlpt( Header.Champ[ i ] );
if ( ok ) then
ok := ok and sendlpt( ACK )
else
ok := ok and sendlpt( NAK );
if ( not ok ) then
dec( trys );
until ( ( ok ) or ( trys = 0 ) or (errors));
if ( (trys = 0) or (errors)) then
begin
goto fin;
SendlptBlock:=false;
end;
if ( Nombre > 0 ) then
begin
Donnees := DPTR;
trys := MAXTRY;
repeat
ok := TRUE;
for i := Nombre downto 1 do
begin
ok := ok and sendlpt( Donnees^[ i ] );
reste:=trunc(100-i/nombre*100);
form1.gauge1.progress:=reste
end;
if ( ok ) then
ok := ok and sendlpt( ACK )
else
ok := ok and sendlpt( NAK );
if ( not ok ) then
dec( trys );
until ( ( ok ) or ( trys = 0 ) or (errors));
if ( (trys = 0) or (errors)) then
begin
goto fin;
SendlptBlock:=false;
end;
end;
SendlptBlock:=true;
fin:
form1.gauge1.visible:=false;
end;
function ReceivelptBlock( var Token : byte;
var Len : word;
Dptr : pointer ):boolean;
var header : BHEADER;
ok : boolean;
i : word;
trys : word;
EscapeStatus : boolean;
ByteBuffer : byte;
Donnees : ^DBloc;
label fin,good;
begin
form1.gauge1.visible:=true;
trys := MAXTRY;
repeat
for i:= 0 to 3 do
Header.Champ[ i ] := receivelpt;
ByteBuffer := receivelpt;
if ( ByteBuffer <> ACK ) then
dec( trys );
until ( ( trys = 0 ) or ( ByteBuffer = ACK ) or (errors));
if ( (trys = 0) or (errors)) then
begin
goto fin;
receivelptblock:=false;
end;
Token := Header.Token;
Len := Header.Lenh+(Header.Lenb shl 8);
if ( Len > 0 ) then
begin
Donnees := Dptr;
trys := MAXTRY;
repeat
for i := len downto 1 do
begin
Donnees^[ i ] := receivelpt;
reste:=trunc(100-i/len*100);
form1.gauge1.progress:=reste
end;
ByteBuffer := receivelpt;
if ( ByteBuffer <> ACK ) then
dec( trys );
until ( ( trys = 0 ) or ( ByteBuffer = ACK ) );
if ( trys = 0 ) then
begin
goto fin;
receivelptblock:=false;
end;
end;
receivelptblock:=true;
fin:
form1.gauge1.visible:=false;
end;
function Sendfile(name:string):boolean;
var lus:word;
Fichier:file;
begin
assign( Fichier, Name );
reset( Fichier, 1 );
Blockread( Fichier, Block, 15000, Lus );
if lus>0 then
Sendfile:=SendlptBlock( 1, Lus, @Block )
else
Sendfile:=false;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
adress:=0;
showadress(sender);
Memo2Click(Sender);
SpeedButton8Click(Sender);
pop:=true;
end;
procedure TForm1.SpinButton1DownClick(Sender: TObject);
begin
if (adress>0) and okm.checked then
begin
dec(adress);
SpeedButton6Click(Sender);
end;
end;
procedure TForm1.SpinButton1UpClick(Sender: TObject);
begin
if (adress<65536*16) and okm.checked then
begin
inc(adress);
SpeedButton6Click(Sender);
end;
end;
function hextoint(hex:string;n:word):longint;
var
resu,exp:longint;
i:word;
begin
hex :=UpperCase(hex);
resu:=0;
exp:=1;
for i:=n downto 1 do
begin
resu:=resu+(Pos(hex[i],'0123456789ABCDEF')-1)*(exp);
exp:=exp*16
end;
hextoint:=resu;
end ;
function adresstoint(hex:string):longint;
begin
adresstoint:=hextoint(Copy(hex, 1, 4),4)shl 4 + hextoint(Copy(hex, length(hex)-3, 4),4)
end;
procedure TForm1.showadress(Sender: TObject);
var i,j,adh,adl:word;
adress2:longint;
old,old2:string;
begin
memo1.clear;
memo2.clear;
memo3.clear;
for i:=0 to 29 do
begin
adress2:=adress+i*16;
adl:=adress2 and $FFFF;
adh:=(adress2 and $F0000) shr 4;
memo1.lines.add(IntToHex(adh,4)+':'+IntToHex(adl,4)) ;
old:='';
old2:='';
for j:=1 to 16 do
begin
old:=old+inttohex(block[i*16+j],2);
if block[i*16+j]=0 then
old2:=old2+'.'
else
old2:=old2+char(block[i*16+j]) ;
if j mod 2=0 then old:=old+' ';
end;
memo2.lines.add(old) ;
memo3.lines.add(old2) ;
end
end;
procedure TForm1.SpeedButton8Click(Sender: TObject);
begin
if getfirstlpt=0 then showmessage('Pas de port parallèle détecté');
errors:=false;
end;
procedure TForm1.SpeedButton6Click(Sender: TObject);
var adl,adh,good:word;
tok:byte;
ok:boolean;
begin
if (inlpt=0) then SpeedButton8Click(sender);
if ((inlpt<>0) and (initlpt(true))) then
begin
adl:=adress and $FFFF;
adh:=(adress and $F0000) shr 4;
Block[1]:=lo(adl);
Block[2]:= hi(adl);
Block[3]:= lo(adh);
Block[4]:= hi(adh);
Block[5]:= lo(512);
Block[6]:= hi(512) ;
ok:=false;
if SendlptBlock( 1,6,@Block) then ok:=receivelptBlock(tok,good ,@Block); {demande de RAM}
if not(ok) or errors then Showmessage('Erreur de transmission !!!!!!!!!!');
showadress(sender);
end
else
Showmessage('Pas de PC distant');
putb($08);
errors:=false;
end;
procedure TForm1.MaskEdit1Change(Sender: TObject);
begin
if pop then
begin
adress:=adresstoint(maskedit1.text);
if okm.checked=true then SpeedButton6Click(sender);
showadress(sender);
end;
end;
procedure TForm1.SpinButton2DownClick(Sender: TObject);
begin
if (adress+16*30<=65536*16) and okm.checked then
begin
adress:=adress+16*30;
SpeedButton6Click(Sender);
end;
end;
procedure TForm1.SpinButton2UpClick(Sender: TObject);
begin
if (adress-16*30>=0) and okm.checked then
begin
adress:=adress-16*30;
SpeedButton6Click(Sender);
end;
end;
procedure TForm1.SpeedButton3Click(Sender: TObject);
var adl,adh,good:word;
adress2:longint;
tok:byte;
ok:boolean;
begin
if (inlpt=0) then SpeedButton8Click(sender);
if ((inlpt<>0) and (initlpt(true))) then
begin
adress2 :=adresstoint(maskedit1.text);
adl:=adress2 and $FFFF;
adh:=(adress2 and $F0000) shr 4;
Block[1]:=lo(adl);
Block[2]:= hi(adl);
Block[3]:= lo(adh);
Block[4]:= hi(adh);
ok:=SendlptBlock( 7,4,@Block);
if not(ok) or errors then Showmessage('Erreur de transmission !!!!!!!!!!');
end
else
Showmessage('Pas de PC distant');
putb($18);
errors:=false;
end;
procedure TForm1.Memo2Click(Sender: TObject);
var ligne,col,pos,adl,adh:word;
adress2:longint;
begin
ligne:=memo2.selstart div 42;
col:= (trunc((memo2.selstart mod 42+1) / 2.5));
pos:=16*ligne+col;
label1.caption:=inttostr(ligne)+':'+inttostr(col)+':'+inttostr(pos);
adress2:=pos+adress;
adl:=adress2 and $FFFF;
adh:=(adress2 and $F0000) shr 4;
pop:=false;
maskedit1.text:=inttohex(adh,4)+':'+inttohex(adl,4);
pop:=true;
end;
end.
Loading…
Cancel
Save