Eigener Quellcode

Das sind Beispiele von Programmen, die ich in meiner Freizeit geschrieben habe. Sie waren für IBM AT und kompatiblen Computer gedacht, da das Angebot an diesen Programmen damals nicht ausreichend war. Aufgrund dieses Sourcecodes können Sie meinen Programmierungsstil begutachten.

 

Disk Kopierschutzroutinen

Das sind Assembler Library Routinen, die ich zur Benutzung in Quick Basic und Fortran als Aufrufe programmiert habe. Die Library Routinen sind für den direkten Zugriff über den BIOS auf den Disk eines IBM AT und kompatiblen Computer gedacht, zur Erstellung eines eigenen Kopierschutzes.

Russischer Editor

Noch bevor es Länderunterstützung für die PCs durch Microsoft gab, habe ich den Editor mit russischen Buchstaben in Quick Basic entwickelt. Der Editor diente zur Arbeit an einem Programm in russischer Sprache. Der russische Zeichensatz in Assemblerroutinen wurde auch von mir erstellt.

Eingabefenster für den Pfad der zu ladenen Date

Dieses C Programm war der Vorgänger der Windowswelt und ist unter DOS gelaufen. Das Programm hat auf dem Bildschirm in einem Fenster die Verzeichnisse des Disks dargestellt, die durch Mouseclick ausgewählt wurden.

Netzwerk- und Diskzugriff- Testprogramm

Dieses Quick Basic Testprogramm habe ich geschrieben um die Häufigkeitsverteilung der Transferzeit über das Novelle Netz oder auf den Festplatten zu Testen. Die Daten wurden in den 16 KB Blöcken direkt über das Netz oder auf der Festplatte gespeichert und wieder gelesen. Die Häufigkeit der anfallenden Zeiten wird grafisch mit den Balken auf dem Bildschirm dargestellt.

Das VIRDOCtor Programm für den ersten Computervirus der Welt

Das Antivirusprogramm habe ich geschrieben um die von dem Virus infizierten Dateien auf meinem Computer zu finden. Der Virus wurde von dem infizierten Programm in den residenten Speicher des Rechners geladen und an alle nachher gestarteten DOS Programme angehängt. Mit jedem neuen Start wuchsen die Programme weiter und machten den Rechner voll und damit unbrauchbar. Das von mir schnell geschriebene Programm hat alle Dateien auf dem Rechner auf das Muster des Kodes des Virus durchsucht und und die Namen der infizierten Dateien in eine Textdatei geschrieben.

Master Mind

Das ist ein Spiel das von mir unter DOS geschrieben wurde. Mann muss 3 bis 6 richtige Steine auf richtigen Positionen erraten. Das Spiel startet man mit Eingabe des Benutzernamen und der gewünschten Zahl von Steinen. Zur Eingabe der Zahlen sollte man nur die numerische Tastatur benutzen. Das Spiel beinhaltet einen "Boss Key", der zum Verstecken des Spiels vor dem Chef dienen soll. Zurück ins Spiel kommt man aus der DOS Ebene mit dem Wort "exit". Dieses Spiel läuft auch unter Windows mit den Administratorrechten im Virtualbox von Oracle mit instaliertem MSDOS oder DosBox.

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 


Disk Kopierschutzroutinen

Das sind Assembler Library Routinen, die ich zur Benutzung in Quick Basic und Fortran als Aufrufe programmiert habe. Die Library Routinen sind für den direkten Zugriff über den BIOS auf den Disk eines IBM AT und kompatiblen Computer gedacht, zur Erstellung eines eigenen Kopierschutzes.

Zurück zum Menu

PAGE ,132

TITLE DISK.ASM VERSION 1.00

COMMENT#
*************************************************************************
*
* Author: Jaroslaw Dabkowski
*
*************************************************************************
* *
* Assembler subroutines for MS QUICK BASIC COMPILER 4.50 and
* MS FORTRAN COMPILER 4.00
*
* Last correction: 22.10.89 , 21.30
*
*************************************************************************
*
* Listing of subroutines:
*
* Name Parameter
* ---- ---------
* RDBOOT (BPB,ERROR)
* RDABSS (BUFFER,SECNR,ERROR)
* WRABSS (BUFFER,SECNR,ERROR)
* RDPART (BUFFER,DRVNR,ERROR)
* ALCMEM (PAGE,ERROR)
* RELMEM (ERROR)
* GETDRV (DRIVE)
* SETDRV (DRIVE)
* GETDIR (DIR,ERROR)
* SETDIR (DIR,ERROR)
* OPFILE (FILENAME,HEADERLENGTH,ERROR)
* RDCDIR (ERROR)
* WRCDIR (ERROR)
* RDBIOS (DISKNR,HEADNR,CYLNR,SECTOR,NRSECS,DMABUF,ERROR)
* WRBIOS (DISKNR,HEADNR,CYLNR,SECTOR,NRSECS,DMABUF,ERROR)
* WRDMA (DMASEG,DMAADR,PYSDRV,SECTORS,HEAD,CYL,SEC,ERROR)
* RDTIME (DMAPage,DMAAdr)
* STTIME (DMAPage,DMAAdr)
*
*************************************************************************
*
* CHARACTER = DIR,FILENAME
* CHARACTER =
* INTEGER*2 = ERROR
* INTEGER*4 =
* INTEGER*2 = DRIVE,ERROR
* INTEGER*4 = HEADERLENGTH
*
* CHARACTER ARRAY = BPB,BUFFER
* INTEGER*2 = DRVNR,PAGE,ERROR
* INTEGER*4 = SECNR
* *
* ERROR = 8000 READ BOOT SECTOR FAILED
* ERROR = 8001 READ ABSOLUTE SECTOR FAILED
* ERROR = 8010 ALLOCATE MEMORY FAILED *
* ERROR = 8011 FREE ALLOCATED MEMORY FAILED
*
************************************************************************#


DATA SEGMENT PARA PUBLIC 'DATA'

Author DB ' DISK.ASM '
DB ' (c) Jaroslaw Dabkowski,'
DB ' West Germany. '
DiskBuffer DW 2048D DUP()
Aloc_Seg DW 0
DMA_Seg DW 0
Byte_Header DW 0
Old_Drv DW 0
Old_Dir DW 0

DATA ENDS

DGROUP GROUP DATA



CODE SEGMENT PUBLIC 'CODE'
ASSUME CS:CODE,DS:DGROUP,SS:DGROUP;

PUBLIC RDBOOT,RDABSS,WRABSS,RDPART,ALCMEM,RELMEM
PUBLIC GETDRV,SETDRV,GETDIR,SETDIR,OPFILE,RDCDIR,WRCDIR
PUBLIC RDBIOS,WRBIOS,WRDMA,RDTIME,STTIME


PAGE+
COMMENT#
*************************************************************************
* Function : Read Partition Table using BIOS
*************************************************************************
* Use : CALL RDPART(BUFFER,DRVNR,ERROR)
*
* Input : Phys. disk number (Integer *2)
* 0H,1H,2H for Floppy, 80H,81H for Harddisk
*
* Output : Partition Table (Character *64)
* : MS-DOS Error code (Integer *2)
************************************************************************#

RDPART PROC FAR

PUSH BP
MOV BP,SP

PUSH ES
PUSH DS

LES BX,DWORD PTR [BP+10] ; Drive Number
MOV DX,ES:[BX]

MOV BX,DATA ; Buffer Adr at ES:BX
MOV ES,BX
MOV DS,BX
MOV BX,OFFSET DiskBuffer

MOV DH,00 ; Head Number
MOV CH,00 ; Cylinder Number
MOV CL,01 ; Sector Number
MOV AL,01 ; No. of sectors

MOV AH,02 ; BIOS Disk Read
INT 13H
JC RDPARTERR

MOV CX,32 ; Store last 64 bytes
MOV SI,OFFSET DiskBuffer+512-66
LES BX,DWORD PTR [BP+14]
MOV DI,BX
REP MOVSW

SUB AX,AX
RDPARTEND:
LES BX,DWORD PTR [BP+6]
MOV ES:[BX],AX
POP DS
POP ES
MOV SP,BP
POP BP
RET 12

RDPARTERR:
MOV AX,8002D ; ERROR = 8002
JMP RDPARTEND

RDPART ENDP

PAGE+
COMMENT#
*************************************************************************
* Function : Read BOOT-Sector
*************************************************************************
* Use : CALL RDBOOT(BPB,ERROR)
*
* Input : none
*
* Output : Bios parameter block (Character *32)
* : MS-DOS Error code (Integer *2)
************************************************************************#

RDBOOT PROC FAR

PUSH BP
MOV BP,SP

MOV AH,19H ; get default drive
INT 21H

PUSH DS
MOV BX,DATA
MOV DS,BX

SUB AH,AH
MOV CX,01 ; No. of sectors
MOV DX,00 ; Startsector
MOV BX,OFFSET DiskBuffer

PUSH BP ; Save BP-REG
INT 25H ; Absolute Disk Read
JC RDBOOTERR
POPF ; Stack error !!!!
POP BP

MOV CX,16 ; Store first 32 bytes
MOV SI,OFFSET DiskBuffer
LES BX,DWORD PTR [BP+10]
MOV DI,BX
REP MOVSW

SUB AX,AX
RDBOOTEND:
LES BX,DWORD PTR [BP+6]
MOV ES:[BX],AX
POP DS
MOV SP,BP
POP BP
RET 08

RDBOOTERR:
POPF
POP BP
MOV AX,8000 ; ERROR = 8000
JMP RDBOOTEND

RDBOOT ENDP

PAGE+
COMMENT#
*************************************************************************
* Function : Read Sector Absolute (until DOS 3.30)
*************************************************************************
* Use : CALL RDABSS(BUFFER,SECNR,ERROR)
*
* Input : Sector Number (Integer *4)
*
* Output : Sector Buffer (Character *2048)
* : MS-DOS Error code (Integer *2)
************************************************************************#

RDABSS PROC FAR

PUSH BP
MOV BP,SP
; PUSH DS

; MOV AH,19H ; get default drive
; INT 21H
MOV AL,01H

SUB AH,AH
MOV CX,01 ; No. of sectors

; LES BX,DWORD PTR [BP+10] ; *F77
LES BX,DWORD PTR [BP+8] ; *QB
; MOV DX,ES:[BX] ; Startsector
MOV DX,[BX] ; Startsector

; LES BX,DWORD PTR [BP+14] ; *F77 Diskbuffer
LES BX,DWORD PTR [BP+10] ; *QB Diskbuffer
; push es
; pop ds

; PUSH BP ; Save BP-REG
INT 25H ; Absolute Disk Read
JC RDABSERR
POPF ; Stack error !!!!
; POP BP

SUB AX,AX
RDABSEND:
; LES BX,DWORD PTR [BP+6] ; ERROR
LES BX,DWORD PTR [BP+6] ; ERROR
MOV AX,8001 ; ERROR = 8001 !!
; MOV ES:[BX],AX
MOV [BX],AX

; POP DS
; MOV SP,BP
POP BP
; RET 12 ; *F77
RET 6 ; *QB

RDABSERR:
POPF
; POP BP
MOV AX,8001 ; ERROR = 8001
JMP RDABSEND

RDABSS ENDP

PAGE+
COMMENT#
*************************************************************************
* Function : Write Sector Absolute (until DOS 3.30)
*************************************************************************
* Use : CALL WRABSS(BUFFER,SECNR,ERROR)
*
* Input : Sector Number (Integer *4)
* Sector Buffer (Character *2048)
*
* Output : MS-DOS Error code (Integer *2)
************************************************************************#

WRABSS PROC FAR

PUSH BP
MOV BP,SP
PUSH DS

MOV AH,19H ; get default drive
INT 21H

SUB AH,AH
MOV CX,01 ; No. of sectors

LES BX,DWORD PTR [BP+10]
MOV DX,ES:[BX] ; Startsector

LES BX,DWORD PTR [BP+14] ; Diskbuffer
push es
pop ds

PUSH BP ; Save BP-REG
INT 26H ; Absolute Disk Write
JC WRABSERR
POPF ; Stack error !!!!
POP BP

SUB AX,AX
WRABSEND:
LES BX,DWORD PTR [BP+6] ; ERROR
MOV ES:[BX],AX

POP DS
MOV SP,BP
POP BP
RET 12

WRABSERR:
POPF
POP BP
MOV AX,8001 ; ERROR = 8001
JMP WRABSEND

WRABSS ENDP

PAGE+
COMMENT#
*************************************************************************
* Function : Allocate Memory
*************************************************************************
* Use : INTERNAL
************************************************************************#

ALCMEM PROC FAR

PUSH BP
MOV BP,SP
PUSH DS
PUSH ES

MOV BX,DATA
MOV DS,BX

MOV BX,2000H ; allocate 2 pages
MOV AH,48H
INT 21H
JC ALLERR

MOV BX,Offset Aloc_Seg
MOV [BX],AX
MOV DX,AX
AND DX,0F000H
ADD DX,1000H ; next page
MOV BX,Offset DMA_Seg
MOV [BX],DX
MOV CL,4
ROL DX,CL
LES BX,DWORD PTR [BP+10] ; DAM PAGE
MOV ES:[BX],DX

SUB AX,AX
ALLEND: LES BX,DWORD PTR [BP+6] ; ERROR
MOV ES:[BX],AX

POP ES
POP DS
MOV SP,BP
POP BP
RET 8

ALLERR: MOV AX,8010 ; allocate error
JMP ALLEND

ALCMEM ENDP

PAGE+
COMMENT#
*************************************************************************
* Function : Release Allocated Memory
*************************************************************************
* Use : INTERNAL
************************************************************************#

RELMEM PROC FAR

PUSH BP
MOV BP,SP
PUSH DS
PUSH ES
MOV BX,DATA
MOV DS,BX

MOV BX,Offset Aloc_Seg
MOV ES,[BX]

MOV AH,49H
INT 21H
JC RELERR

SUB AX,AX
RELEND: LES BX,DWORD PTR [BP+6] ; ERROR
MOV ES:[BX],AX

POP ES
POP DS
MOV SP,BP
POP BP
RET 4

RELERR: MOV AX,8011 ; release error
JMP RELEND

RELMEM ENDP


PAGE+
COMMENT#
*************************************************************************
* Function : Get Default Drive
*************************************************************************
* Use : CALL GETDRV (DRIVE)
*
* Input : none
* *
* Output : Default Drive Number (Integer)
************************************************************************#

GETDRV PROC FAR

PUSH BP
MOV BP,SP

MOV AH,19H ; get default drive
INT 21H

SUB AH,AH
LES BX,DWORD PTR [BP+6]
MOV [BX],AX

MOV SP,BP
POP BP
RET 02H

GETDRV ENDP

PAGE+
COMMENT#
*************************************************************************
* Function : Set Default Drive
*************************************************************************
* Use : CALL SETDRV (DRIVE)
*
* Input : Drive Number (Integer)
*
* Output : none
************************************************************************#

SETDRV PROC FAR

PUSH BP
MOV BP,SP

LES BX,DWORD PTR [BP+6]
MOV DL,ES:[BX]

MOV AH,0EH ; set default drive
INT 21H

MOV SP,BP
POP BP
RET 04H

SETDRV ENDP

PAGE+
COMMENT#
*************************************************************************
* Function : Get Current Directory
*************************************************************************
* Use : CALL GETDIR (DIR,ERROR)
*
* Input : none
*
* Output : Directory (String(*64))
* MS-DOS Error Code (Integer)
************************************************************************#

GETDIR PROC FAR

PUSH BP
MOV BP,SP
PUSH DS
PUSH ES

LES BX,DWORD PTR [BP+10]
MOV SI,BX
push es
pop ds

MOV DI,SI ; fill memory with spaces
MOV CX,32D
MOV AX,2020H
REP STOSW

MOV DI,SI
MOV DL,0 ; 0=default drive

MOV AH,47H ; get current directory
INT 21H
JC GCDEND

SUB AX,AX
GCDEND: LES BX,DWORD PTR [BP+6] ; store error
MOV ES:[BX],AX

POP ES
POP DS
MOV SP,BP
POP BP
RET 08H

GETDIR ENDP

PAGE+
COMMENT#
*************************************************************************
* Function : Set Current Directory
*************************************************************************
* Use : CALL SETDIR (DIR,ERROR)
*
* Input : New Directory (String(*64))
*
* Output : MS-DOS Error Code (Integer)
************************************************************************#

SETDIR PROC FAR

PUSH BP
MOV BP,SP
PUSH DS
PUSH ES

LES SI,DWORD PTR [BP+10]
PUSH ES
POP DS
MOV DX,SI

MOV AH,3BH ; set current directory
INT 21H
JC SCDEND

SUB AX,AX
SCDEND: LES BX,DWORD PTR [BP+6]
MOV ES:[BX],AX

POP ES
POP DS
MOV SP,BP
POP BP
RET 08H

SETDIR ENDP

Page+
COMMENT#
*************************************************************************
* Function : Open Datafile
*************************************************************************
* Use : CALL OPFILE (FILENAME,HEADERLENGTH,ERROR)
*
* Input : FILENAME ( character string )
* HEADERLENGTH ( 2 byte integer )
*
* Output : ERROR ( 2 byte integer )
************************************************************************#

OPFILE PROC FAR

PUSH BP
MOV BP,SP
PUSH DS
PUSH ES

LES DX,DWORD PTR [BP+14] ; get pointer of FILENAME into DS:DX
PUSH ES
POP DS
MOV CX,0000H ; set file attribute
MOV AL,01H ; set file access to write only
MOV AH,3CH ; open file
INT 21H ; DOS SYSTEM CALL
JC FILE_OP_ERR ; if error, put it on stack

MOV CX,0000H ; put distance into CX:DX
LES BX,DWORD PTR [BP+10]
PUSH ES
POP DS
MOV DX,DS:[BX]

MOV SI,DATA
MOV DS,SI
MOV SI,OFFSET Byte_Header
MOV [SI],DX

MOV BX,AX ; put file handle into BX-REG
MOV AL,00H ; method : beginning of file + offset
MOV AH,42H ; move pointer
INT 21H ; DOS SYSTEM CALL
JC FILE_OP_ERR ; if error, put it on stack

MOV CX,00 ; no of bytes to write
MOV AH,40H ; write to file
INT 21H ; DOS SYSTEM CALL
JC FILE_OP_ERR ; if error, put it on stack

MOV AH,3EH ; close file
INT 21H ; DOS SYSTEM CALL
JC FILE_OP_ERR ; if error, put it on stack

MOV AH,0DH ; Flush to disk
INT 21H

SUB AX,AX ; no error
FILE_OP_ERR:
LES BX,DWORD PTR [BP+6] ; put error code on stack
MOV ES:[BX],AX

POP ES
POP DS
MOV SP,BP
POP BP
RET 12

OPFILE ENDP

PAGE+
COMMENT#
*************************************************************************
* Function : Read Current Directory
*************************************************************************
* Use : CALL RDCDIR (ERROR)
*
* Input : none
*
* Output : MS-DOS Error Code (Integer)
************************************************************************#

RDCDIR PROC FAR

PUSH BP
MOV BP,SP
PUSH DS
PUSH ES
MOV AX,DATA
MOV DS,AX

MOV AH,19H ; get default drive
INT 21H

MOV SI,Offset Old_Drv
MOV [SI],AL
INC SI
MOV AH,'\'
MOV [SI],AH
INC SI

MOV DL,0 ; 0=default drive
MOV AH,47H ; get current directory
INT 21H
JC RDCEND

SUB AX,AX
RDCEND: LES BX,DWORD PTR [BP+6] ; store error
MOV ES:[BX],AX

POP ES
POP DS
MOV SP,BP
POP BP
RET 04H

RDCDIR ENDP

PAGE+
COMMENT#
*************************************************************************
* Function : Write Saved Directory
*************************************************************************
* Use : CALL WRCDIR (ERROR)
*
* Input : none
*
* Output : MS-DOS Error Code (Integer)
************************************************************************#

WRCDIR PROC FAR

PUSH BP
MOV BP,SP
PUSH DS
PUSH ES
MOV AX,DATA
MOV DS,AX


MOV SI,Offset Old_Drv
MOV DL,[SI]
MOV AH,0EH ; set default drive
INT 21H
JC WRCEND

MOV DX,Offset Old_DIR-1
MOV AH,3BH ; set current directory
INT 21H
JC WRCEND

SUB AX,AX
WRCEND: LES BX,DWORD PTR [BP+6]
MOV ES:[BX],AX

POP ES
POP DS
MOV SP,BP
POP BP
RET 04

WRCDIR ENDP


PAGE+
COMMENT#
*************************************************************************
* Function : Read Disk using BIOS
*************************************************************************
* Use : CALL RDBIOS (DISKNR,HEADNR,CYLNR,SECTOR,NRSECS,
* DMABUF,ERROR)
*
* Input : DISKNR
* HEADNR
* CYLNR
* SECTOR
* NRSECS
* *
* Output : DMABUF (Integer array)
* Error (Integer)
************************************************************************#

RDBIOS PROC FAR

PUSH BP
MOV BP,SP
PUSH DS

LES BX,DWORD PTR [BP+26] ; Head number
MOV DX,ES:[BX]
XCHG DH,DL
LES BX,DWORD PTR [BP+30] ; Drive number
OR DX,ES:[BX]

LES BX,DWORD PTR [BP+22] ; Cylinder number
MOV AX,ES:[BX]
XCHG AH,AL
; SAL AL,6
MOV CL,6
SAL AL,CL

LES BX,DWORD PTR [BP+18] ; First sector
MOV CX,ES:[BX]
OR CX,AX

LES BX,DWORD PTR [BP+14] ; Number of sectors
MOV AX,ES:[BX]

LES BX,DWORD PTR [BP+10] ; DMABUF

MOV AH,02
INT 13H ; BIOS Read

JC RDBIOSERR

SUB AX,AX
RDBIOSEND:
LES BX,DWORD PTR [BP+6] ; Error
MOV ES:[BX],AX

POP DS
MOV SP,BP
POP BP
RET 28

RDBIOSERR:
MOV AX,8010
JMP RDBIOSEND

RDBIOS ENDP

PAGE+
COMMENT#
*************************************************************************
* Function : Write Disk using BIOS
*************************************************************************
* Use : CALL WRBIOS (DISKNR,HEADNR,CYLNR,SECTOR,NRSECS,
* DMABUF,ERROR)
* *
* Input : DISKNR
* HEADNR
* CYLNR
* SECTOR
* NRSECS
* *
* Output : DMABUF (Integer array)
* Error (Integer)
************************************************************************#

WRBIOS PROC FAR

PUSH BP
MOV BP,SP
PUSH DS

LES BX,DWORD PTR [BP+26] ; Head number
MOV DX,ES:[BX]
XCHG DH,DL
LES BX,DWORD PTR [BP+30] ; Drive number
OR DX,ES:[BX]

LES BX,DWORD PTR [BP+22] ; Cylinder number
MOV AX,ES:[BX]
XCHG AH,AL
; SAL AL,6
MOV CL,6
SAL AL,CL

LES BX,DWORD PTR [BP+18] ; First sector
MOV CX,ES:[BX]
OR CX,AX

LES BX,DWORD PTR [BP+14] ; Number of sectors
MOV AX,ES:[BX]

LES BX,DWORD PTR [BP+10] ; DMABUF

MOV AH,03
INT 13H ; BIOS Write !!!!

JC WRBIOSERR

SUB AX,AX
WRBIOSEND:
LES BX,DWORD PTR [BP+6] ; Error
MOV ES:[BX],AX

POP DS
MOV SP,BP
POP BP
RET 28

WRBIOSERR:
MOV AX,8010
JMP WRBIOSEND

WRBIOS ENDP

PAGE+
COMMENT#
*************************************************************************
* Function : Set Time (Only for testing)
*************************************************************************
* Use : CALL STTIME (DMAPage,DMAAdr)
************************************************************************#

STTIME PROC FAR

PUSH BP
MOV BP,SP
PUSH DS

LES BX,DWORD PTR [BP+10] ; Get DMAPage
MOV BX,ES:[BX]
PUSH BX

MOV AH,2CH
INT 21H ; Get system time

LES BX,DWORD PTR [BP+6] ; Get DMAAdr
MOV BX,ES:[BX]

POP DS
SUB AL,AL
MOV DS:[BX+0],CH ; Hour
MOV DS:[BX+1],AL
MOV DS:[BX+2],CL ; Minutes
MOV DS:[BX+3],AL
MOV DS:[BX+4],DH ; Seconds
MOV DS:[BX+5],AL
MOV DS:[BX+6],DL
MOV DS:[BX+7],AL

; in al,40h
; MOV DS:[BX+6],al
; in al,40h
; MOV DS:[BX+7],AL

POP DS
MOV SP,BP
POP BP
RET 8

STTIME ENDP

PAGE+
COMMENT#
*************************************************************************
* Function : Write DMA using BIOS
*************************************************************************
* Use : CALL WRDMA (DMASEG,DMAADR,PYSDRV,
* SECTORS,HEAD,CYL,SEC,ERROR)
*
* Input :
*
* Output : (Integer array)
* Error (Integer)
************************************************************************#

WRDMA PROC FAR

NOP
NOP
PUSH BP
MOV BP,SP

LES BX,DWORD PTR [BP+18] ; Head number
MOV DX,ES:[BX]
XCHG DH,DL
LES BX,DWORD PTR [BP+26] ; Drive number
OR DX,ES:[BX]

LES BX,DWORD PTR [BP+14] ; Cylinder number
MOV AX,ES:[BX]
XCHG AH,AL
; SAL AL,6
MOV CL,6
SAL AL,CL

LES BX,DWORD PTR [BP+10] ; First sector
MOV CX,ES:[BX]
OR CX,AX

LES BX,DWORD PTR [BP+22] ; Number of sectors
MOV AX,ES:[BX]

LES BX,DWORD PTR [BP+34] ; DMASeg
MOV BX,ES:[BX]
PUSH BX

LES BX,DWORD PTR [BP+30] ; DMAAdr
MOV BX,ES:[BX]
POP ES

MOV AH,03
INT 13H ; BIOS Write !!!!

JC WRDMAERR

SUB AX,AX
WRDMAEND:
LES BX,DWORD PTR [BP+6] ; Error
MOV ES:[BX],AX

MOV SP,BP
POP BP
RET 32

WRDMAERR:
MOV AX,8999
JMP WRDMAEND

WRDMA ENDP

PAGE+
COMMENT#
*************************************************************************
* Function : Read Time
*************************************************************************
* Use : CALL RDTIME (HOUR,MIN,SEC,HSEC)
*
* Input : none
*
* Output : all (Integer)
************************************************************************#

RDTIME PROC FAR

PUSH BP
MOV BP,SP

in al,40h
MOV ah,al
in al,40h
neg ax
LES BX,DWORD PTR [BP+6] ; Hundredths of seconds
MOV ES:[BX],ax

MOV AH,2CH
INT 21H ; Get system time

LES BX,DWORD PTR [BP+10] ; Seconds
MOV ES:[BX],DL

LES BX,DWORD PTR [BP+14] ; Seconds
MOV ES:[BX],DH

LES BX,DWORD PTR [BP+18] ; Minutes
MOV ES:[BX],CL

LES BX,DWORD PTR [BP+22] ; Hour
MOV ES:[BX],CH

MOV SP,BP
POP BP
RET 20

RDTIME ENDP

CODE ENDS
END

 

Russischer Editor

Noch bevor es Länderunterstützung für die PCs durch Microsoft gab, habe ich den Editor mit russischen Buchstaben in Quick Basic entwickelt. Der Editor diente zur Arbeit an einem Programm in russischer Sprache. Der russische Zeichensatz in Assemblerroutinen wurde auch von mir erstellt.

Zurück zum Menu

 

 

 


'***************************************************************************
option base 0
dim dab$(7)
dab$(2)=" S T O E T O M E N U E D I T O R"
dab$(3)=" Jaroslaw Dabkowski"
dab$(7)=" West Germany"
ver$="03" ' Last correction: 24.09.92
'***************************************************************************
'dab$(1)=" Das Programm ist illegal kopiert worden !"
call fontsto
ON ERROR GOTO mist1 'if error goto mist1

' DEF SEG=&HF000
' t1=peek(&H4b4d)
' t2=peek(&H4b4e)
' if t1=&h31 and t2=&h32 then goto start
' DEF SEG=&HF800
' t1=peek(&H4b4d)
' t2=peek(&H4b4e)
' if t1=&h31 and t2=&h32 then goto start
goto start

mist1: def seg
call fontoff
color 7,0:cls
for i=1 to 7
print dab$(i)
next i
' for nn=1 to 3
' for n=500 to 1000 step 20: sound n,1: next n
' for n=1000 to 500 step -20: sound n,1: next n
' next nn
' for n=500 to 100 step -20: sound n,1: next n
system

start:
DEF SEG=&HB800 'define screen memory segment
WIDTH 80 'change screen width to 80
' BLOAD "SME.HLP",&H2140 'EGA Binary load screen into page 2
BLOAD "SME.HLP",&H2000 'VGA Binary load screen into page 2
' BLOAD "SME.SME",&H10a0 'EGA Binary load screen into page 1
BLOAD "SME.SME",&H1000 'VGA Binary load screen into page 1
' BLOAD "SME.SME",&H00 'Binary load screen into page 0
' BLOAD "SME.HLP",&H00 'Binary load screen into page 0

DEF SEG 'define basic memory segment
a=7:b=0:rus=0:rep=0:di=0:syr=0
file$="stoeto.men"
x=1:y=1
dim kol$(32)
dim sto%(256)
for i=0 to 256: sto%(i)=i:next i

kol$(00)=" Schwarz "
kol$(01)=" Blau "
kol$(02)=" Grn "
kol$(03)=" Kobaltblau "
kol$(04)=" Rot "
kol$(05)=" Violett "
kol$(06)=" Braun "
kol$(07)=" Weiá "
kol$(08)=" Grau "
kol$(09)=" Hellblau "
kol$(10)=" Hellgrn "
kol$(11)=" Hellkobaltblau "
kol$(12)=" Hellrot "
kol$(13)=" Hellviolet "
kol$(14)=" Gelb "
kol$(15)=" Hellweiá "
for i=0 to 15
kol$(i+16)=kol$(i)
next i

' STOETO character font: (german code)=russian code
' Character at the end is a german key

sto%( 70)=65 :sto%(102)=97 'Ff
sto%( 59)=128 :sto%( 44)=137 ';,
sto%( 68)=66 :sto%(100)=138 'Dd
sto%( 85)=242 :sto%(117)=139 'Uu
sto%( 76)=130 :sto%(108)=140 'Ll
sto%( 84)=69 :sto%(116)=101 'Tt
sto%( 95)=237 :sto%( 45)=141 '_-
' sto%(153)=131 :sto%(148)=142 '
sto%(153)=131 :sto%(148)=243 ' stoeto
sto%( 80)=240 :sto%(112)=143 'Pp
' sto%( 66)=133 :sto%( 98)=153 'Bb
sto%( 66)=133 :sto%( 98)=244 'Bb stoeto
sto%( 81)=134 :sto%(113)=245 'Qq
sto%( 82)=75 :sto%(114)=160 'Rr
sto%( 75)=135 :sto%(107)=161 'Kk
sto%( 86)=77 :sto%(118)=162 'Vv
sto%( 90)=72 :sto%(122)=163 'Zz
sto%( 74)=79 :sto%(106)=111 'Jj
sto%( 71)=136 :sto%(103)=164 'Gg
sto%( 72)=80 :sto%(104)=112 'Hh
sto%( 67)=67 :sto%( 99)=99 'Cc
sto%( 78)=84 :sto%(110)=165 'Nn
sto%( 69)=144 :sto%(101)=121 'Ee
sto%( 65)=145 :sto%( 97)=224 'Aa
sto%(154)=88 :sto%(129)=120 '
' sto%( 87)=146 :sto%(119)=225 'Ww
sto%( 87)=146 :sto%(119)=248 'Ww stoeto
sto%( 88)=147 :sto%(120)=226 'Xx
sto%( 73)=241 :sto%(105)=227 'Ii
sto%( 79)=149 :sto%(111)=228 'Oo
sto%( 42)=167 :sto%( 43)=229 '*+
sto%( 83)=235 :sto%(115)=230 'Ss
sto%( 77)=166 :sto%(109)=231 'Mm
sto%(142)=150 :sto%(132)=232 '??
sto%( 58)=151 :sto%( 46)=233 ':.
sto%( 89)=152 :sto%(121)=234 'Yy
' sto%()= :sto%()=

taste: ON ERROR GOTO nic 'if error goto nic
OPEN "sme.key" FOR input AS #1
while not EOF(1)
INPUT#1,t1,t2
sto%(t1)=t2
wend
CLOSE#1

nic: resume nic2
nic2: ON ERROR GOTO mist 'if error goto mist
goto lab5


'EDITOR **************************************************

lab1: SCREEN ,,0,0 'set active and visual page to 0
color a,b
lab2: locate y,x:call curxor
lab3: K$=INKEY$: IF K$="" THEN GOTO lab3
IF K$=CHR$(13) THEN x=1:y=y+1:GOTO enter :'cr+lf
IF K$=CHR$(0)+CHR$(72) THEN y=y-1:goto updo :'up
IF K$=CHR$(0)+CHR$(75) THEN x=x-1:goto leri :'left
IF K$=CHR$(0)+CHR$(77) THEN x=x+1:goto leri :'right
IF K$=CHR$(0)+CHR$(80) THEN y=y+1:goto updo :'down
IF K$=CHR$(0)+CHR$(59) THEN call curxor:GOTO lab5 :'f1
IF K$=CHR$(0)+CHR$(60) THEN call curxor:GOTO lab5 :'f2
IF K$=CHR$(0)+CHR$(61) THEN rus=0: goto lab3 :'f3
IF K$=CHR$(0)+CHR$(62) THEN rus=1: goto lab3 :'f4
IF K$=CHR$(0)+CHR$(63) THEN goto lab5 :'f5
IF K$=CHR$(0)+CHR$(64) THEN goto lab3 :'f6
IF K$=CHR$(0)+CHR$(65) THEN rep=1:GOTO lab4 :'f7
IF K$=CHR$(0)+CHR$(66) THEN call curxor:goto help :'f8 help
IF K$=CHR$(0)+CHR$(67) THEN goto lab5 :'f9
IF K$=CHR$(0)+CHR$(68) THEN GOTO lab5 :'f10
IF K$=CHR$(0)+CHR$(3) THEN call curxor:x=x-1:k$=" ":GOTO lab41:'clear
IF K$=CHR$(8) THEN x=x-1:goto leri :'left
IF K$=CHR$(27) THEN call curxor:GOTO lab5 :'esc
IF K$=CHR$(0) THEN GOTO lab3 :' other keys
lab4: call curxor:locate y,x
if rep=1 then k$=l$
if rus=1 then k$=chr$(sto%(asc(k$)))
lab41: print k$;
rep=0
l$=k$
x=x+1
if x>80 then x=1:y=y+1
if y>25 then y=1
GOTO lab2

updo: if y<1 then y=25
if y>25 then y=1
call curxor
GOTO lab2
leri: if x<1 then x=80
if x>80 then x=1
call curxor
GOTO lab2
enter: if y<1 then y=25
if y>25 then y=1
if x<1 then x=80
if x>80 then x=1
call curxor
GOTO lab2



'HELP MENU *********************************************

lab5:
SCREEN ,,1,1 'set active and visual page to 1
color 15,4: locate 2,74:print ver$;
locate 19,40:color 31,4:print" ";
if mel<>1 then goto lab55
locate 19,40:color 31,4:print" ALARM ! Ein Fehler wurde gemeldet !";:mel=0
lab55: if mel=2 then locate 19,40:color 31,4:print"Das Bild ist abgespeichert worden ! ";:mel=0
color 10,6
locate 6,43:print " Datei Name : ";file$;
lab11:
color 10,6
if rus=0 then locate 8,53:print" Deutsch ";
if rus=1 then locate 8,53:print" Russisch ";
color a,b
locate 11,40:print " Vordergrund: ";kol$(a);
locate 12,40:print " Hintergrund: ";kol$(b);
color 15,4
locate 11,72:print"Y=";y;
locate 12,72:print"X=";x;
if syr<>1 then goto lab12
for nn=1 to 2
for n=500 to 1000 step 20: sound n,1: next n
for n=1000 to 500 step -20: sound n,1: next n
next nn
for n=500 to 200 step -20: sound n,1: next n
syr=0

lab12: K$=INKEY$: IF K$="" THEN GOTO lab12
IF K$=CHR$(0)+CHR$(72) THEN a=a-1:goto ud :'up
IF K$=CHR$(0)+CHR$(75) THEN b=b-1:goto lr :'left
IF K$=CHR$(0)+CHR$(77) THEN b=b+1:goto lr :'right
IF K$=CHR$(0)+CHR$(80) THEN a=a+1:goto ud :'down
IF K$=CHR$(0)+CHR$(59) THEN GOTO lab22 :'f1 load file
IF K$=CHR$(0)+CHR$(60) THEN GOTO lab23 :'f2 save file
IF K$=CHR$(0)+CHR$(61) THEN rus=0 :'f3 rus off
IF K$=CHR$(0)+CHR$(62) THEN rus=1 :'f4 rus on
IF K$=CHR$(0)+CHR$(63) THEN SCREEN ,,0,0:color a,b:cls:goto lab2 :'f5 clear screen
IF K$=CHR$(0)+CHR$(64) THEN goto dir :'f6 directory
IF K$=CHR$(0)+CHR$(65) THEN goto lab11 :'f7
IF K$=CHR$(0)+CHR$(66) THEN goto help :'f8 help
IF K$=CHR$(0)+CHR$(67) THEN goto lab21 :'f9 new file name
IF K$=CHR$(0)+CHR$(68) THEN GOTO lab100 :'f10 end of program
IF K$=CHR$(27) THEN GOTO lab1 :'esc
GOTO lab11

ud: if a<0 then a=31
if a>31 then a=0
GOTO lab11
lr: if b<0 then b=7
if b>7 then b=0
GOTO lab11

lab21: color 10,6
locate 6,43:print " ";
locate 6,43:input " Bitte eingeben: ",file$
if file$="" then file$="stoeto"
le=len(file$)
if le>8 then file$=mid$(file$,1,8)
for le=1 to 8
if mid$(file$,le,1)="." then goto lab211
next le
lab211: le=le-1
file$=mid$(file$,1,le)+".men"
locate 6,43:print " Datei Name: ";file$;
goto lab11
lab22:
DEF SEG=&HB800 'define screen memory segment
WIDTH 80 'change screen width to 80
BLOAD file$,&H0 'Binary load screen into page 0
DEF SEG 'define basic memory segment
goto lab1

lab23:
DEF SEG=&HB800 'define screen memory segment
' BSAVE file$,&H10a0,&H1000 'Binary save screen from page 1
BSAVE file$,&H0,&H1000 'Binary save screen from page 0
DEF SEG 'define basic memory segment
mel=2:di=0
goto lab5

dir:
SCREEN ,,3,3 'set active and visual page to 3
if di=1 then goto dir2
color 0,0
for i=1 to 22 step 3:locate i,1:print string$(240,32);:next i
color 15,0
locate 2,1:print dab$(2)
locate 3,23:print string$(35,196)
print:print
files"*.men"
locate 23,29:print"Bitte eine Taste drcken.";
di=1
dir2: k$=inkey$:if k$="" then goto dir2
goto lab5

help:
SCREEN ,,2,2 'set active and visual page to 2
lab90: K$=INKEY$: IF K$="" THEN GOTO lab90
IF K$=CHR$(0)+CHR$(66) THEN goto lab1
goto lab5


lab100: call curxor
DEF SEG=&HB800 'define screen memory segment
' BSAVE "stoeto.men",&H10a0,&H1000 'Binary save screen from page 1
BSAVE "stoeto.men",&H00,&H1000 'Binary save screen from page 0
DEF SEG 'define basic memory segment

SCREEN ,,0,0 'set active and visual page to 0

color 0,0
for i=1 to 1000
y=int(rnd(1)*25)+1
x=int(rnd(1)*40)*2+1
locate y,x:print " ";
next i

for ss=1 to 10
SOUND 12500,.35
FOR s=1 TO 600
NEXT s
next ss


' SCREEN ,,0,0 'set active and visual page to 0
color a,0 :cls
' call fontoff
' print"STOETO MENU EDITOR - beendet."
' system
goto mist1


mist: mel=1
syr=1
resume lab5

 

 

 

 

Eingabefenster für den Pfad zu ladenen Datei

Dieses C Programm war der Vorgänger der Windowswelt und ist unter DOS gelaufen. Das Programm hat auf dem Bildschirm in einem Fenster die Verzeichnisse des Disks dargestellt, die durch Mouseclick ausgewählt wurden.

Zurück zum Menu


/**************************************************************************/
/* fiv_sed1.c written by J.Dabkowski 24.07.90 */
/* This is window to select path and file name for i/o operation */
/* Input is a search path with wildcards, output path with file name */
/**************************************************************************/

#include
#include
#include
#include
#include
#include

static struct find_t fileinfo;
static char buff [81];
static char answer [81];
char far *input_fname;
char far *output_fname;
sed_type sed, sed0, sed1, sed2, sed3;
static int which = 0;

void main()
{

boolean spc_Jump0();
boolean spc_Jump1();
boolean spc_Jump2();
boolean spc_Jump3();

int yes;

printf ("Enter path name: ");
gets (buff);
input_fname = &buff[0];
output_fname = &answer[0];

strcpy (output_fname,input_fname);

disp_Init(def_ModeText, NULL);
hard_InitMouse();
sedwin_ClassInit();

yes= sel_fname(output_fname);
disp_Close();

if (yes !=0 )
printf ("Answer: %s \n",output_fname);
else
printf ("File not found. \n");

}

int sel_fname(file_name)
char *file_name;
{
menu_type menu,menu0, menu1, menu2, menu3;
/* sed_type sed, sed0, sed1, sed2; */
char c;
char *p;
char *first_dire();
char *first_file();
char *next_file();
int i, j, spo, dif, len, rows,ret;
char work[81], work_save[81], work_dir[81], answ[81];
unsigned drive;
char cur_drive[4];

strcpy (work,file_name);

menu = menu_Open();
menu_Flush(menu);

sed = sed_Open(menu);
sed_SetColors(sed, 0x17, 0x17, 0x70);
sed_SetBorder(sed, bd_prompt);
sed_SetBorderTitle(sed, " Select file ");
sed_SetPosition(sed, 4, 8);
sed_SetHeight(sed, 14);
sed_SetWidth(sed, 57);
sed_SetExplode(sed, exp_std);
sed_SetShadow(sed, 1);
sed_Repaint(sed);


menu3 = menu_Open();
menu_Printf(menu3, "@p[0,0]@f[ ABORT ]",NULL, &menu_funcs);
menu_Flush(menu3);

sed3 = sed_Open(menu3);
sed_SetColors(sed3, 0x17, 0x17, 0x70);
sed_SetBorder(sed3, bd_prompt);
sed_SetPosition(sed3, 16, 33);
sed_SetHeight(sed3, 1);
sed_SetWidth(sed3, 7);
sed_SetMouse(sed3, sedmou_Track);
sed_SetSpecial(sed3, spc_Jump3);
sed_Repaint(sed3);

lab_again:
/* Path can not start with :\ */
if (work[0]==':') { for (i=0; i<(strlen(work)); i++) { work[i] = work[i+1]; }; goto lab_again; };
if (work[0]=='\\') { for (i=0; i<(strlen(work)); i++) { work[i] = work[i+1]; }; goto lab_again; };

/* Remove all not nessacery : and \ from the string */
j = strcspn (work,":");
if ((j>0) && (j
for (i=j; i<(strlen(work)); i++) { work[i] = work[i+1]; };
goto lab_again; };

j = strcspn (work,"\\");
if ((j>0) && (j
for (i=j; i<(strlen(work)); i++) { work[i] = work[i+1]; };
goto lab_again; };

strupr (work);

/* find out if the search path include drive number (C:\)
if no, add current one */
if (work[1]==':') { if (work[2]=='\\') goto lab_path;} ;
strcpy (cur_drive, "C:\\");
_dos_getdrive(&drive);
cur_drive[0] = 'A'+ drive - 1;
strcat (cur_drive, work);
strcpy (work,cur_drive);

lab_path:
strcpy (work_save,work);
strcpy (work_dir,work);

menu0 = menu_Open();
menu1 = menu_Open();
menu2 = menu_Open();

menu_Printf(menu0, "@[7, ]Ú@[47,Ä]¿\n Path: ³@[47, ]³\n@[7, ]À@[47,Ä]Ù@[27, ]");
menu_Printf(menu0, "@p[1,9]@f[#############################################]",
work, &string_funcs);

/* First find index of (\), (:), or first character */
i = strlen(work_dir);
do {i=i-1;} while ((i>0) && (work_dir[i] != '\\') && (work_dir[i] != ':'));
work_dir[i+1]='\0';
strcat (work_dir,"*.*");

if((p=first_dire(work_dir)) == NULL)
{
goto lab_file;
}
if (fileinfo.attrib == 0x10)
{
if (strncmp(p, ".", 1) != 0) {
menu_Printf(menu1, "@f[ %-12s ]\n", NULL, &menu_funcs, p);
rows = 1; }
}

while((p=next_file()) != NULL)
{
if (fileinfo.attrib == 0x10)
{
if (strncmp(p, ". ",2) != 0) {
menu_Printf(menu1, "@f[ %-12s ]\n", NULL, &menu_funcs, p);
rows = rows + 1; }
}
}

lab_file:
if((p=first_file(work)) == NULL)
{
goto lab_menu;
}
menu_Printf(menu2, "@f[ %-12s ]\n", NULL, &menu_funcs, p);
rows = 1;

while((p=next_file()) != NULL)
{
menu_Printf(menu2, "@f[ %-12s ]\n", NULL, &menu_funcs, p);
rows = rows + 1;
}

lab_menu:
menu_Flush(menu0);
menu_Flush(menu1);
menu_Flush(menu2);


sed0 = sed_Open(menu0);
sed_SetColors(sed0, 0x17, 0x17, 0x70);
sed_SetBorder(sed0, NULL);
sed_SetPosition(sed0, 5, 9);
sed_SetHeight(sed0, 3);
sed_SetWidth(sed0, 57);
sed_SetSpecial(sed0, spc_Abort);
sed_SetMouse(sed0, sedmou_Track);


sed1 = sed_Open(menu1);
sed_SetColors(sed1, 0x17, 0x17, 0x70);
sed_MarkField(sed1, 0x17, 0x17, 0x70);
sed_SetBorder(sed1, bd_mouse);
sed_SetBorderTitle(sed1, " Dir ");
sed_SetPosition(sed1,8, 14);
sed_SetHeight(sed1, 9);
sed_SetWidth(sed1, 15);
sed_SetMouse(sed1, sedmou_Track);

sed2 = sed_Open(menu2);
sed_SetColors(sed2, 0x17, 0x17, 0x70);
sed_MarkField(sed2, 0x17, 0x017, 0x70);
sed_SetBorder(sed2, bd_mouse);
sed_SetBorderTitle(sed2, " File ");
sed_SetPosition(sed2, 8, 44);
sed_SetHeight(sed2, 9);
sed_SetWidth(sed2, 15);
sed_SetMouse(sed2, sedmou_Track);

sed_SetSpecial(sed0, spc_Jump0);
sed_SetSpecial(sed1, spc_Jump1);
sed_SetSpecial(sed2, spc_Jump2);

sed_Repaint(sed0);
sed_Repaint(sed1);
sed_Repaint(sed2);


lab0:
/* Enter path and file name , quit */
/* If wildcards found, redisplay window with new search path */
ret = sed_Go(sed0);

if (ret == 0) goto lab3;
if (which == 1) goto lab1;
if (which == 2) goto lab2;

if (strpbrk(work,"?*") != NULL) {
sed_Close(sed0);
sed_Close(sed1);
sed_Close(sed2);
goto lab_again; }

goto lab3;

lab1:
/* Add or remove directory in path name, redisplay window */

strcpy (answ, sed_GetMerge(sed1,sed_GetFieldNo(sed1)));
for (i=1; i<80; i++) { if (answ[i]==' ') answ[i]=='\0';};
if (strlen(answ)<2) goto lab2;

i = strlen(work);
len = i;
/* Check if input is (..), then remove last path name.
Otherwise add it new path name */
if (strncmp(answ, " ..",3)==0)
{
/* If input is .. remove last path name */
/* First find index of the backslash (\) */
do {i=i-1;} while (i>0 && work[i] != '\\');
spo = i;
/* Then find index of the second backslash (\) */
do {i=i-1;} while (i>0 && work[i] != '\\');
dif = spo - i;
j = i;
while (j<=len) {
work[j] = work[j+dif];
j = j + 1;
work[j]='\0';
work[j+1]='\0'; }
}
else
{
/* Look for wildcards *.*, *.XXX, XXX.* */
/* First find index of the point (.) */
do {i=i-1;} while (i>0 && work[i] != '.');
/* Check for *.*, *.XXX */
if (work[i-1] == '*')
{
/* If XX*.* check backwords for \ or first character */
while (i>0 && work[i] != '\\') {i=i-1;} ;
i = i + 1;
spo = i;
dif = len - spo;
j = 1;
while ((j
work[i+j-1] = answ[j];
j = j + 1; };
i = i + j - 1;
work[i] = '\\';
i = i + 1;
j = spo;
while (dif>0) { work[i] = work_save[j]; i = i + 1; j = j + 1; dif = dif - 1; };
work[i]='\0';
work[i+1]='\0';
}
else
{
/* If XXX.* check backwords for \ or first character */
/* do {i=i-1;} while (i>0 && work[i] != '\\'); */
while (i>0 && work[i] != '\\') {i=i-1;} ;
/* Copy in new path name and wildcards */
i = i + 1;
spo = i;
dif = len - spo;
j = 1;
while ((j
work[i+j-1] = answ[j];
j = j + 1; };
i = i + j - 1;
work[i] = '\\';
i = i + 1;
j = spo;
while (dif>0) { work[i] = work_save[j]; i = i + 1; j = j + 1; dif = dif - 1; };
work[i]='\0';
work[i+1]='\0';

/* Copy in new path name and wildcards
spo = i;
dif = len - spo;
j = 0;
while ((j
work[i+j-1] = answ[j];
j = j + 1; };
i = i + j - 1;
work[i] = '\\';
j = spo;
while (dif>0) { work[i] = work_save[j]; i = i + 1; j = j + 1; dif = dif - 1; };
*/
}
}

sed_Close(sed0);
sed_Close(sed1);
sed_Close(sed2);
goto lab_again;
lab2:
/* Add selected file name to the path (replace wildcards) , quit */

strcpy (answ, sed_GetMerge(sed2,sed_GetFieldNo(sed2)));
for (i=1; i<80; i++) { if (answ[i]==' ') answ[i]=='\0';};
if (strlen(answ)<2) goto lab0;

i = strlen(work);
dif = strlen(answ);
len = i;

/* First find index of (\), (:), or first character */
do {i=i-1;} while ((i>0) && (work[i] != '\\') && (work[i] != ':'));

/* Copy new file name in this place */
/*
for (j=1; ((j
*/
j = 1;
while ((j
work[i+1]='\0';

lab3:

/* Return File name */
strcpy (file_name, work);

sed_Close(sed);
sed_Close(sed0);
sed_Close(sed1);
sed_Close(sed2);
sed_Close(sed3);


printf ("\n which = %d \n ",which);
printf("ret = %d \n",ret);
/*
printf("answ = %s len=%d \n",answ,strlen(answ));
printf("work = %s len=%d \n",work,strlen(work));
*/
return(ret);
}

boolean spc_Jump0(sed,scancode)
sed_type sed;
int scancode;
{
which = 0;
switch (scancode) {
case TAB:
sed_SetNextWin(sed,sed1);
sed_ToggleExit(sed);
return (TRUE);
case ESC:
sed_SetBaton(sed,SED_PRESENTER);
sed_ToggleExit(sed);
return (TRUE);
/* break; */
case FN10:
tone();
return (TRUE);
}
return (FALSE);
}
boolean spc_Jump1(sed,scancode)
sed_type sed;
int scancode;
{
which = 1;
switch (scancode) {
case TAB:
sed_SetNextWin(sed,sed2);
sed_ToggleExit(sed);
return (TRUE);
case ESC:
sed_SetBaton(sed,SED_PRESENTER);
sed_ToggleExit(sed);
return (TRUE);
case FN10:
tone();
return (TRUE);
}
return (FALSE);
}

boolean spc_Jump2(sed,scancode)
sed_type sed;
int scancode;
{
which = 2;
switch (scancode) {
case TAB:
sed_SetNextWin(sed,sed0);
sed_ToggleExit(sed);
return (TRUE);
case ESC:
sed_SetBaton(sed,SED_PRESENTER);
sed_ToggleExit(sed);
return (TRUE);
case FN10:
tone();
return (TRUE);
}
return (FALSE);
}

boolean spc_Jump3(sed,scancode)
sed_type sed;
int scancode;
{
which = 3;
switch (scancode) {
case TAB:
sed_SetNextWin(sed,sed0);
sed_ToggleExit(sed);
return (TRUE);
case ESC:
case ENTER:
case MOU_CLICK:
sed_SetBaton(sed,SED_PRESENTER);
sed_ToggleExit(sed);
return (TRUE);
case FN10:
tone();
return (TRUE);
}
return (FALSE);
}

char *first_dire(pathfile)
char far *pathfile;
{
if (_dos_findfirst(pathfile,_A_SUBDIR, &fileinfo) != 0)
{
return (0);
}
return (fileinfo.name);
}

char *first_file(pathfile)
char far *pathfile;
{
if (_dos_findfirst(pathfile,_A_NORMAL, &fileinfo) != 0)
{
return (0);
}
return (fileinfo.name);
}

char *next_file()
{
if (_dos_findnext(&fileinfo) != 0)
{
return (0);
}

return (fileinfo.name);
}

/* struct find_t - rewritten to remember only !!!
struct find_t:
char reserved[21]; Reserved for use by MS_DOS
char attrib; Attribute byte of file
unsigned wr_time; Time of last file update
unsigned wr_date; Date of last file update
long size; File length in bytes
char name[13]; Null-terminated file name */

Netzwerk- und Diskzugriff- Testprogramm

Dieses Quick Basic Testprogramm habe ich geschrieben um die Häufigkeitsverteilung der Transferzeit über das Novelle Netz oder auf den Festplatten zu Testen. Die Daten wurden in den 16 KB Blöcken direkt über das Netz oder auf der Festplatte gespeichert und wieder gelesen. Die Häufigkeit der anfallenden Zeiten wird grafisch mit den Balken auf dem Bildschirm dargestellt.

Zurück zum Menu

 

 

DECLARE SUB ClrScreen ()
DECLARE SUB WriteFile (Rec&)
DECLARE SUB OpenFile (file$, BufLng&)
DECLARE SUB CloseFile ()
DECLARE SUB Grafik (Z%, S%, Buf%, Buf64%, DatLng!)
DECLARE SUB ReadMax (Rec&, Ts&, Te&)
DECLARE SUB Result (Records&, BufLng&, Buf64%, TMax%, Tmin%, Tstart&, TEnde&)
DECLARE SUB Showit (Zeile%, Spalte%, K%)
DECLARE SUB BinOpenFile (file$)
DECLARE SUB BinReadFile (Rec&, Dist!, t%)
DEFINT A-Z

TYPE ZeitRec
Std AS INTEGER
Min AS INTEGER
Sec AS INTEGER
Hun AS INTEGER
END TYPE

DIM SHARED BinZeit AS ZeitRec

'****************************************************************************
disk$ = COMMAND$
Program$ = "HDTSTBAS" 'Programm Name
K1000 = 1024 'Konstante 1K
Buf = 16 'Bufferl?nge in KByte
DatLng! = 1 'Dateil?nge in MByte
Buf64 = 64 / Buf 'Anzahl Buffer fr Auswertung

'****************************************************************************

IF disk$ = "" THEN GOTO nocom
n = 1
WHILE MID$(disk$, n, 1) <> "/" AND n < 128
n = n + 1
WEND
DatLng! = VAL(MID$(disk$, n + 1, 2))
disk$ = MID$(disk$, 1, 1)
IF disk$ > "A" AND disk$ < "z" THEN disk$ = disk$ + ":"

nocom:

t$ = TIME$
t1$ = MID$(t$, 7, 2)
n = VAL(t1$)
RANDOMIZE (n)
m! = INT(RND * 100000)
file$ = disk$ + "NH" + MID$(STR$(m!), 2, 6) + ".TMP"

'****************************************************************************

BufLng& = K1000 * Buf
Records& = INT(DatLng! * K1000 * K1000 / BufLng&)

'****************************************************************************


CALL ClrScreen

LOCATE 4, 25: PRINT " NHTSTBAS"

LOCATE 6, 25: PRINT "Author: Jaroslaw Dabkowski"

LOCATE 14, 10
PRINT "Please wait, ";
PRINT file$;
PRINT " mit"; BufLng& * Records& / K1000 / K1000; "MByte will be created"

LOCATE 20, 10: PRINT "To change disk and data amount start with:";
LOCATE 22, 10: PRINT "C:>NHTSTBAS d: /5 "

REM GOTO ReadIt

CALL OpenFile(file$, BufLng&)
CALL WriteFile(Records&)
CALL CloseFile

'****************************************************************************

ReadIt:
CALL ClrScreen
CALL BinOpenFile(file$)
PRINT LOF(1)
Records& = LOF(1) / (16! * K1000)

Zeile = 3
Spalte = 5
CALL Grafik(Zeile, Spalte, Buf, Buf64, DatLng!)

DIM TT(1000)
Rec& = 1
TMax = 0

WHILE NOT EOF(1)
CALL BinReadFile(Rec&, BufLng& * Buf64, t)
TT(t) = TT(t) + 1
IF t > TMax THEN TMax = t
IF t < TMax THEN Tmin = t
Rec& = Rec& + (Buf * K1000)
LOCATE 24, 10: PRINT Rec&;
WEND
CALL Showit(Zeile, Spalte, K)

CALL ReadMax((Records& - 1) * Buf * K1000 + 1, Tstart&, TEnde&)
CALL CloseFile

CALL Result(Records&, BufLng&, Buf64, TMax, Tmin, Tstart&, TEnde&)

'****************************************************************************
KILL file$
Warte:
t$ = INKEY$: IF t$ = "" THEN GOTO Warte

END

'****************************************************************************

SUB BinOpenFile (file$)

OPEN file$ FOR BINARY AS #1
END SUB

SUB BinReadFile (Rec&, Dist!, t)

GET #1, Rec&, BinZeit
t1! = 3600! * BinZeit.Std + 60! * BinZeit.Min + BinZeit.Sec + BinZeit.Hun / 100
GET #1, Rec& + Dist!, BinZeit
T2! = 3600! * BinZeit.Std + 60! * BinZeit.Min + BinZeit.Sec + BinZeit.Hun / 100
IF NOT EOF(1) THEN t = INT((T2! - t1!) * 1000)
END SUB

DEFSNG A-Z
SUB CloseFile
CLOSE #1
END SUB

SUB ClrScreen

CLS
COLOR 15, 4
PRINT " QB 4.5 ";
PRINT " Network & Hard Disk Access Time Test Program ";
PRINT " by dabsoftware "
COLOR 7, 0
END SUB

DEFINT A-Z
SUB Grafik (Z, S, Buf, Buf64, DatLng!)

FOR n = Z TO 21
LOCATE n, S: PRINT "³";
FOR nn = 1 TO 10
PRINT " ³";
NEXT
NEXT

LOCATE 21, S
PRINT "À";
FOR n = 1 TO 10
PRINT "ÄÄÄÄÅ";
NEXT
LOCATE 22, S + 2
FOR n = 1 TO 10
PRINT USING "#####"; n * 100;
NEXT
PRINT " msec";

LOCATE Z, S + 53: PRINT "Data length :";
PRINT USING " ## "; DatLng!;
PRINT "MByte"
LOCATE , S + 53: PRINT "Buffer length:";
PRINT USING " ## "; Buf;
PRINT "KByte"
LOCATE , S + 53: PRINT "Transfer :";
PRINT USING " ## "; Buf * Buf64;
PRINT "KByte"

LOCATE Z + 4, S + 59
PRINT " msec amount "
LOCATE , S + 59
PRINT "ÄÄÄÄÄÄÄÄÄÄÄÄÄ"
FOR n = 0 TO 9
LOCATE , S + 59
PRINT USING "#####"; (n + 1) * -100
NEXT

END SUB

DEFSNG A-M, O-Z
SUB OpenFile (file$, BufLng&)
SHARED Zeit$

OPEN file$ FOR RANDOM AS #1 LEN = BufLng&
FIELD #1, 8 AS Zeit$

END SUB

DEFSNG N
SUB ReadFile (Rec, Dist, t)
SHARED Zeit$

GET #1, Rec
t1 = CVD(Zeit$)
GET #1, Rec + Dist
T2 = CVD(Zeit$)
IF NOT EOF(1) THEN t = (T2 - t1) * 1000
END SUB

DEFINT A-Z
SUB ReadMax (Rec&, Ts&, Te&)

GET #1, 1, BinZeit
Ts& = (3600! * BinZeit.Std + 60! * BinZeit.Min + BinZeit.Sec + BinZeit.Hun / 100)
GET #1, Rec&, BinZeit
Te& = (3600! * BinZeit.Std + 60! * BinZeit.Min + BinZeit.Sec + BinZeit.Hun / 100)
END SUB

SUB Result (Records&, BufLng&, Buf64, TMax, Tmin, Tstart&, TEnde&)

COLOR 0, 7
LOCATE 24, 1

PRINT " Transfere Rate, Midle: ";
PRINT USING "###.##"; Records& * BufLng& / (TEnde& - Tstart&) / 1000;
PRINT " KB/s, Min: ";
PRINT USING "###.##"; BufLng& * Buf64 / TMax;
PRINT " KB/s, Max: ";
PRINT USING "###.##"; BufLng& * Buf64 / Tmin;
PRINT " KB/s ";
COLOR 7, 0

END SUB

SUB Showit (Zeile, Spalte, K)
SHARED TT()
STATIC d

FOR n = 0 TO 1000
IF TT(n) > 0 THEN
x = n / 20 + 5
Y = 20 - (TT(n) / 20)
IF Y < 3 THEN Y = 3
FOR YY = 20 TO Y STEP -1
LOCATE YY, x
PRINT "°";
NEXT
END IF
NEXT

LOCATE Zeile + 6
FOR n2 = 0 TO 9
TTn = 0
FOR n1 = 0 TO 99
n = (n2 * 100) + n1
TTn = TTn + TT(n)
NEXT
LOCATE , Spalte + 66
PRINT USING "#####"; TTn
NEXT
K = 1
d = d + 5
LOCATE 24, 5
PRINT "Transfered:"; d; "%";
END SUB

SUB WriteFile (Rec&)
SHARED Zeit$

FOR NrRec = 1 TO Rec&
t! = TIMER
iStd = INT(t! / 3600): n! = iStd: t! = t! - (n! * 3600)
iMin = INT(t! / 60): t! = t! - (iMin * 60)
iSec = INT(t!): t! = t! - iSec
iHun = INT(t! * 100)
LSET Zeit$ = MKI$(iStd) + MKI$(iMin) + MKI$(iSec) + MKI$(iHun)
PUT #1, NrRec
NEXT
END SUB

Das VIRDOCtor Programm für den ersten Computervirus der Welt

Das Antivirusprogramm habe ich geschrieben um die von dem Virus infizierten Dateien auf meinem Computer zu finden. Der Virus wurde von dem infizierten Programm in den residenten Speicher des Rechners geladen und an alle nachher gestarteten DOS Programme angehängt. Mit jedem neuen Start wuchsen die Programme weiter und machten den Rechner voll und damit unbrauchbar. Das von mir schnell geschriebene Programm hat alle Dateien auf dem Rechner auf das Muster des Kodes des Virus durchsucht und und die Namen der infizierten Dateien in eine Textdatei geschrieben.

Zurück zum Menu

PRINT "VIRDOCtor by Dabkowski, 1989"
DIM name$(20), vir$(20), dev$(20)
de = 0
ON ERROR GOTO start
dev$(1) = COMMAND$
IF dev$(1) <> "" THEN de = 1: GOTO start
OPEN "virdoc.inp" FOR INPUT AS #5
WHILE NOT EOF(5)
de = de + 1
INPUT #5, dev$(de)
WEND
CLOSE #5
start:
ON ERROR GOTO beenden
IF dev$(1) = "" THEN PRINT "Start with device and extention (VIRDOC C:*.exe)": SYSTEM
OPEN "virdoc.vir" FOR INPUT AS #1
nam = 0
WHILE NOT EOF(1)
nam = nam + 1
INPUT #1, name$(nam), vir$(nam)
WEND
CLOSE #1
lst$ = "virdoc.lst"
REM kill lst$
FOR sta = 1 TO de
info$ = dev$(sta)
OPEN lst$ FOR APPEND AS #2
PRINT #2, "Virus Test on "; DATE$; " at "; TIME$; " Files: "; info$
PRINT "Looking for files: " + info$
SHELL "where " + info$ + " > virdoc.dat"
OPEN "virdoc.dat" FOR INPUT AS #3
nf = 0: nvir = 0: ft = 0
WHILE NOT EOF(3)
INPUT #3, k$: nf = nf + 1
WEND
CLOSE #3
OPEN "virdoc.dat" FOR INPUT AS #3
DEF SEG = &HB800
BLOAD "virdoc.men", 0
DEF SEG
WHILE NOT EOF(3)
LOCATE 13, 29: PRINT nf
LOCATE 13, 44: PRINT ft
LOCATE 13, 62: PRINT nvir
INPUT #3, f$
f$ = f$ + STRING$(40, " ")
LOCATE 15, 28: PRINT MID$(f$, 1, 40)
OPEN f$ FOR RANDOM AS #4 LEN = 64
FIELD #4, 64 AS new$
Virus = 0: n = 1: ft = ft + 1
WHILE NOT EOF(4)
old$ = new$
GET #4, n
dub$ = old$ + new$
n = n + 1
FOR kk = 1 TO nam
IF INSTR(dub$, vir$(nam)) > 0 THEN Virus = 1
NEXT kk
WEND
CLOSE #4
IF Virus = 1 THEN
nvir = nvir + 1
LOCATE 17, 31
PRINT MID$(f$, 1, 40)
PRINT #2, f$
LOCATE 19, 13
name$(nam) = name$(nam) + STRING$(40, " ")
PRINT MID$(name$(nam), 1, 40)
END IF
WEND
CLOSE #3
CLOSE #2
KILL "virdoc.dat"
LOCATE 19, 13
NEXT sta
LOCATE 21, 13
PRINT "You may find names of all files with virus in VIRDOC.LST"
warte: k$ = INKEY$: IF k$ = "" THEN GOTO warte
CLS
SYSTEM
problem: LOCATE 19, 13
beenden:
PRINT "PROBLEM. Ask Mr. Dabkowski to help you. "
SYSTEM



 

Master Mind

Das ist ein Spiel das von mir unter DOS geschrieben wurde. Mann muss 3 bis 6 richtige Steine auf richtigen Positionen erraten. Das Spiel startet man mit Eingabe des Benutzernamen und der gewünschten Zahl von Steinen. Zur Eingabe der Zahlen sollte man nur die numerische Tastatur benutzen. Das Spiel beinhaltet einen "Boss Key", der zum Verstecken des Spiels vor dem Chef dienen soll. Zurück ins Spiel kommt man aus der DOS Ebene mit dem Wort "exit". Dieses Spiel läuft auch unter Windows mit den Administratorrechten, im Virtualbox von Oracle mit instaliertem MSDOS oder DosBox.

Spiel MIND.EXE laden

 

 

Zurück zum Menu

 

 

 

 

 


'**************************************************************************
'MASTER MIND by Jaroslaw Dabkowski, West Germany. Last correction 22.09.89
'**************************************************************************
ON ERROR GOTO 4
SCREEN , , 1, 1: CLS
GOTO 5
LOCATE 1, 80: PRINT " "
DEF SEG = &HB000
bit = PEEK(4096 + 160)
DEF SEG
IF CHR$(bit) <> " " THEN GOTO 5 ELSE GOTO 4
4 PRINT "I am sorry. You need new hardware to run this game."
PRINT "MIND by Jaroslaw Dabkowski, West Germany.; "; ""
SYSTEM
5 il = 0: name$ = ""
FOR en = 1 TO 30
d$ = ENVIRON$(en): le = LEN(d$)
IF MID$(d$, 1, 4) = "MIND" THEN dd$ = MID$(d$, 6, le): GOTO 8
NEXT en
dd$ = ""
8 file$ = dd$ + "\mind.sco"
ON ERROR GOTO 10
OPEN file$ FOR INPUT AS #1
CLOSE #1
GOTO 20
10 RESUME 12
12 OPEN file$ FOR OUTPUT AS #1
PRINT #1, , "DABkowski's MASTER MIND Score List"
PRINT #1, "Date", "Time", "Level", "Score", "Name"
CLOSE #1
20 ON ERROR GOTO 25
GOTO 30
25 RESUME 370
30 OPEN file$ FOR APPEND AS #1
IF COMMAND$ <> "" AND COMMAND$ <> "?" THEN name$ = COMMAND$: il = 2: GOTO 370
SCREEN , , 1, 1
CLS
COLOR 4, 0
LOCATE 1, 1, 0
PRINT STRING$(80, 219)
FOR A = 2 TO 22
LOCATE A, 1: PRINT "Û"
LOCATE A, 80: PRINT "Û"
NEXT
LOCATE 23, 1: PRINT STRING$(80, 219);
IF COMMAND$ = "?" THEN GOTO 900
LOCATE 4, 30: COLOR 15, 0: PRINT " d a b k o w s k i 's "
LOCATE 5, 30: COLOR 15, 0: PRINT "M A S T E R M I N D"
COLOR 14, 0
LOCATE 8, 15: PRINT "Welcome to Master Mind. The object of this game is"
LOCATE 9, 15: PRINT "to correctly guess a series of from 3 to 6 numbers."
LOCATE 10, 15: PRINT "Each number is randomly generated and the possibility"
LOCATE 11, 15: PRINT "exists that you may have TWO of the same number in an"
LOCATE 12, 15: PRINT "answer. An example of this would be `3 3 9' or `6 3 6'"
LOCATE 13, 15: PRINT "You will have between 9 and 15 guesses to accomplish"
LOCATE 14, 15: PRINT "this task, depending upon the length of the series."
LOCATE 15, 15: PRINT "After each guess, you will be told the number of cor-"
LOCATE 16, 15: PRINT "rect digits, along with how many are in the right po-"
LOCATE 17, 15: PRINT "sition. Use these clues to guess the correct series."
LOCATE 18, 15: PRINT "Touch ENTER as a Boss Key. Typing EXIT you return to"
LOCATE 19, 15: PRINT "the game again. Good luck. "
LOCATE 20, 45: PRINT "Jaroslaw DABkowski"
LOCATE 25, 20: COLOR 15, 0: PRINT " Strike SPACE To Continue ";
GOSUB 440
90 DIM GUESS(6)
DIM ANSWER(6)
100 COLOR 15, 4: CLS
LOCATE 2, 30: PRINT "WELCOME TO MASTER MIND v. 1.00"
LOCATE 4, 30: PRINT "ÛÛ ÛÛ Û Û Û ÛÛÛÛ "
LOCATE 5, 30: PRINT "Û Û Û Û Û ÛÛ Û Û Û "
LOCATE 6, 30: PRINT "Û Û Û Û Û Û Û Û Û "
LOCATE 7, 30: PRINT "Û Û Û Û ÛÛ Û Û "
LOCATE 8, 30: PRINT "Û Û Û Û Û ÛÛÛÛ dab "
COLOR 5, 0
LOCATE 12, 17: PRINT "É"; STRING$(49, "Í"); "»"
FOR B = 13 TO 20
LOCATE B, 17: PRINT "º"
LOCATE B, 67: PRINT "º"
NEXT
LOCATE 21, 17: PRINT "È"; STRING$(49, "Í"); "¼"
IF name$ <> "" THEN GOTO 110
COLOR 15, 0
LOCATE 13, 18: PRINT " "
LOCATE 14, 18: PRINT " To agree with your software licence "
LOCATE 15, 18: PRINT " please type in your full name. "
LOCATE 16, 18: PRINT " "
LOCATE 17, 18: PRINT " "
LOCATE 18, 18: PRINT " "
LOCATE 19, 18: PRINT " "
LOCATE 20, 18: PRINT " "
LOCATE 18, 25: INPUT "User: ", name$
IF name$ = "" THEN il = 1: GOTO 360
110 COLOR 15, 0
LOCATE 13, 18: PRINT " "
LOCATE 14, 18: PRINT " "
LOCATE 14, 18: PRINT " Hallo "; name$; ","
LOCATE 15, 18: PRINT " to choose a difficulty level enter "
LOCATE 16, 18: PRINT " the number of stones to be guess. "
LOCATE 17, 18: PRINT " Use numeric keyboard for input. "
LOCATE 18, 18: PRINT " "
LOCATE 19, 18: PRINT " You can play with 3,4,5,6 stones. "
LOCATE 20, 18: PRINT " "
COLOR 15, 4
LOCATE 23, 15: PRINT " Strike ESC To Leave This Game, ENTER as the Boss Key. ";
COLOR 15, 0
120 GOSUB 440
IF RP$ < "3" OR RP$ > "6" THEN 120 ELSE ON ASC(RP$) - 48 - 2 GOTO 130, 140, 150, 160
130 digits = 3: STARTANS = 36: STARTGES = 8: BOTROW = 15: SCORE = 54: GOTO 170
140 digits = 4: STARTANS = 34: STARTGES = 6: BOTROW = 15: SCORE = 72: GOTO 170
150 digits = 5: STARTANS = 32: STARTGES = 4: BOTROW = 18: SCORE = 120: GOTO 170
160 digits = 6: STARTANS = 30: STARTGES = 2: BOTROW = 21: SCORE = 180
170 FOR su = 1 TO digits
RANDOMIZE (VAL(RIGHT$(TIME$, 2)))
ANSWER(su) = FIX(RND(su) * 10)
NEXT su
CLS
XX = 1: YY = 1
GOSUB 420
COLOR 15, 0
LOCATE 1, 34: PRINT "SECRET NUMBERS"
LOCATE 2, 30: PRINT STRING$(23, "-")
COLOR 4, 0
BEGINANS = STARTANS
FOR M = 1 TO digits
LOCATE 3, BEGINANS: PRINT "ÛÛ"
BEGINANS = BEGINANS + 4
NEXT
COLOR 15, 0
LOCATE 5, 4: PRINT "ENTER YOUR GUESSES"
LOCATE 6, 2: PRINT STRING$(22, "-")
LOCATE 5, 28: PRINT "CORRECT NUMBERS"
LOCATE 6, 28: PRINT STRING$(15, "-")
LOCATE 5, 48: PRINT "IN RIGHT POSITION"
LOCATE 6, 48: PRINT STRING$(17, "-")
LOCATE 5, 68: PRINT "POINTS"
LOCATE 6, 68: PRINT STRING$(6, "-")
COLOR 4, 0
FOR ROW = 7 TO BOTROW
BEGINGES = STARTGES
FOR Q = 1 TO digits
LOCATE ROW, BEGINGES: PRINT "ÜÜ"
BEGINGES = BEGINGES + 4
NEXT Q
LOCATE ROW, 35: PRINT "ÜÜ"
LOCATE ROW, 58: PRINT "ÜÜ"
NEXT ROW
FOR ROW = 7 TO BOTROW
BEGINGES = STARTGES
hits = 0: guesses = 0
DIM hits$(10, 6): DIM MISSES$(10, 6)
FOR su = 1 TO digits
LOCATE ROW, BEGINGES
GOSUB 460
GUESS(su) = VAL(RP$)
LOCATE ROW, BEGINGES - 1: COLOR 14, 0: PRINT " "; GUESS(su)
BEGINGES = BEGINGES + 4
NEXT su
FOR X = 1 TO digits
FOR Y = 1 TO digits
IF GUESS(X) = ANSWER(Y) AND X = Y AND hits$(GUESS(X), X) <> "*" THEN
guesses = guesses + 1
hits = hits + 1
hits$(GUESS(X), X) = "*"
MISSES$(GUESS(X), X) = "*"
GOTO 250
END IF
NEXT Y
250 NEXT X
FOR X = 1 TO digits
FOR Y = 1 TO digits
IF GUESS(X) = ANSWER(Y) AND hits$(GUESS(X), X) = "" AND MISSES$(GUESS(X), X) = "" AND X <> Y AND MISSES$(GUESS(X), Y) = "" AND hits$(GUESS(X), Y) = "" THEN
guesses = guesses + 1
MISSES$(GUESS(X), X) = "*"
MISSES$(GUESS(X), Y) = "*"
GOTO 280
END IF
NEXT Y
280 NEXT X
LOCATE ROW, 34: PRINT " "; guesses; " "
LOCATE ROW, 57: PRINT " "; hits; " "
SCORE = SCORE - digits * 2 + (guesses + hits)
LOCATE ROW, 67: PRINT " "; SCORE; " "
ERASE MISSES$: ERASE hits$
IF hits = digits THEN
GOSUB 430
COLOR 15, 4
LOCATE 22, 22: PRINT " !!! C O N G R A T U L A T I O N S !!! "
GOTO 340
END IF
NEXT ROW
GOSUB 430
COLOR 15, 4
LOCATE 22, 22: PRINT " !!! S O R R Y , Y O U L O S T !!! "
SCORE = -SCORE
340 LOCATE 23, 22, O: PRINT " Would You Like To Play Again? "
PRINT #1, DATE$, TIME$, digits, SCORE, name$
350 GOSUB 440: IF RP$ = "Y" THEN CLS : GOTO 100 ELSE IF RP$ <> "N" THEN 350
360 SCREEN , , 0, 0
DEF SEG = &H40: POKE &H17, (PEEK(&H17) AND 159): DEF SEG
CLOSE #1
IF il = 1 THEN
PRINT "MIND. Illegal software use. "
FOR nn = 1 TO 2
FOR n = 500 TO 1000 STEP 20: SOUND n, 1: NEXT n
FOR n = 1000 TO 500 STEP -20: SOUND n, 1: NEXT n
NEXT nn
FOR n = 500 TO 200 STEP -20: SOUND n, 1: NEXT n
END IF
IF dd$ = "" THEN PRINT "Type MIND ? for more information."
SYSTEM
370 SCREEN , , 0, 0
DEF SEG = &H40: POKE &H17, (PEEK(&H17) AND 159): DEF SEG
IF il = 2 THEN
PRINT "MIND install resident. Type EXIT to start."
END IF
SHELL
DEF SEG = &H40: POKE &H17, (PEEK(&H17) OR 96): DEF SEG
SCREEN , , 1, 1: COLOR 4, 0
IF il = 2 THEN il = 0: GOTO 100
GOTO 440
390 XX = CSRLIN: YY = POS(0)
COLOR 4, 0
410 GOSUB 440: IF RP$ = CHR$(27) THEN 360 ELSE 410
420 LOCATE 25, 1: PRINT SPC(79);
LOCATE 25, 15: COLOR 0, 7: PRINT " Strike ESC To Leave This Game, ENTER as the Boss Key. ";
COLOR 4, 0: LOCATE XX, YY
RETURN
430 FOR su = 1 TO digits: LOCATE 3, STARTANS - 1: PRINT " "; ANSWER(su): STARTANS = STARTANS + 4: NEXT su: RETURN
440 IF INKEY$ <> "" THEN 440
450 DEF SEG = &H40: POKE &H17, (PEEK(&H17) OR 96)
RP$ = INKEY$
IF RP$ = CHR$(13) THEN 370
IF RP$ = CHR$(27) THEN 360
IF RP$ = "" THEN 450 ELSE RETURN
460 GOSUB 440
IF RP$ < "0" OR RP$ > "9" THEN 460 ELSE RETURN

900 REM
LOCATE 4, 28: COLOR 15, 0: PRINT " d a b k o w s k i 's "
LOCATE 5, 28: COLOR 15, 0: PRINT " M A S T E R M I N D "
LOCATE 6, 28: COLOR 15, 0: PRINT "ADVANCED INSTALLATION GUIDE"
COLOR 14, 0
LOCATE 8, 15: PRINT "To install your Master Mind resident you should add "
LOCATE 9, 15: PRINT "to your AUTOEXEC.BAT file following lines: "
LOCATE 10, 15: PRINT "SET MIND=d:\mind_path "
LOCATE 11, 15: PRINT "PATH=c:\;c:\dos; ;d:\mind_path "
LOCATE 11, 15: PRINT "which shows to your MIND.EXE file. There will be "
LOCATE 12, 15: PRINT "created MIND.SCO (score) file there. "
LOCATE 13, 15: PRINT "Typing "
LOCATE 14, 15: PRINT "MIND Your Name "
LOCATE 15, 15: PRINT "will install Master Mind resident in the memory of "
LOCATE 16, 15: PRINT "your computer. Use EXIT command to start the game. "
LOCATE 17, 15: PRINT "Now you can use ENTER when your boss waches you. "
LOCATE 18, 15: PRINT " "
LOCATE 19, 15: PRINT "(c) Jaroslaw DABkowski, West Germany "
LOCATE 25, 20: COLOR 15, 0: PRINT " Strike ESCAPE To Quit ";
GOSUB 440
RUN