Полезные исходники для DOS

Всё, что касается программирования на старых языках или для старых систем

Полезные исходники для DOS

Сообщение longhorn_gnu » 25 сен 2023, 08:20

Тема сделана для того, чтобы товарищ rvg и другие, могли выкладывать исходники мелких программ и утилит для DOS.
its end?
Аватара пользователя
longhorn_gnu
Мастер Даунгрейда
 
Сообщения: 774
Зарегистрирован: 05 июн 2023, 08:32
Откуда: telegram: @sdl_sdl_sdl_ps_dpl
Железо: deleted

Re: Полезные исходники для DOS

Сообщение longhorn_gnu » 15 окт 2023, 11:06

Реализация Press Any Key на QBasic:
Код: Выделить всё
CLS
PRINT "Press any key to continue"
A$=""
WHILE A$ = ""
A$ = INKEY$
WEND
its end?
Аватара пользователя
longhorn_gnu
Мастер Даунгрейда
 
Сообщения: 774
Зарегистрирован: 05 июн 2023, 08:32
Откуда: telegram: @sdl_sdl_sdl_ps_dpl
Железо: deleted

Re: Полезные исходники для DOS

Сообщение krotan » 15 окт 2023, 16:28

Можно проще:
CLS
PRINT "Press any key to continue"
INPUT$(1)
Аватара пользователя
krotan
Мастер Даунгрейда
 
Сообщения: 325
Зарегистрирован: 03 фев 2022, 20:16
Железо: EeePC

Re: Полезные исходники для DOS

Сообщение ctv » 30 дек 2023, 23:46

Если писать на c++, то так:

Код: Выделить всё

#include <iostream>
int main()
{
 
    System(«pause»);

    system(cmd.c_str());
    return 0;
}
Последний раз редактировалось ctv 30 дек 2023, 23:47, всего редактировалось 2 раз(а).
Аватара пользователя
ctv
Мастер Даунгрейда
 
Сообщения: 385
Зарегистрирован: 20 июл 2018, 14:31
Откуда: Россия, Москва
Железо: Pentium3

Re: Полезные исходники для DOS

Сообщение .::. Typucm .::. » 30 июн 2024, 00:32

Может быть кому-то пригодится.
Некие товарищи давно пилят DosEmu2. Это такой ms-dos эмулятор для linux (с начала 1990-ых был основной программой для запуска MS-DOS + Windows 3.x игр и программ под всем зоопарком *nix-ов). Первая версия не обновлялась много лет и выброшена из основных дистрибутивов. Как и dosbox использует для работы собственную DOS - FreeDos++ (64-х битный форк).
Кому интересно поковырять исходники фридос плюс-плюса - https://github.com/dosemu2/fdpp.
«Не стесняйтесь думать. Неэффективно пытаться помочь людям, которые не желают помогать себе сами. Нормально чего-то не знать, прикидываться идиотом — нет.» (Слава С.ПО.)
Аватара пользователя
.::. Typucm .::.
 
Сообщения: 924
Зарегистрирован: 28 янв 2022, 22:43

Greka - Demo

Сообщение rvg » 11 сен 2024, 13:24

Демонстрашка. Скороговорка.
Работает в чистом ДОС. В ОС Windows 9x, Windows XP. В DosBOX работает плохо, хотя (возможно), нужно настроить распределения памяти или, что-то в этом роде.
Набор точек (пикселей) - координаты, находятся в текстовых файлах "Dw_01.txt", "Dw_02.txt", "Dw_03.txt", "Dw_04.txt". Соответствующие файлы-ASM т.е. "Dw_01.asm", "Dw_02.asm", "Dw_03.asm", "Dw_04.asm", служат контейнерами данных - сегментом данных, если быть точным. Размещены по-отдельности, не только для удобства, но и из-за того, что если делать в одном (файле), Tasm - откажется работать, сославшись на нехватку памяти (Out of memory).
Сборка программы производится с помощью "Tasm", приложены два пакетных файла "M.bat" и "Deb.bat" - служит для отладки программы. Запустив его, вы окажетесь в отладчике Turbo Debugger.
Чтобы делать собственные демонстрации, приложена программа "GetCoord" - эта программа для Windows. Я усовершенствовал прошлую версию. Теперь, работать с "GetCoord" проще. Создайте рисунок-BMP, цветовая палитра не ниже 24 (16 млн. цветов), размером 320 на 200, напечатайте текст. Сохраните и запустите "GetCoord". Выберите рисунок, согласитесь при вопросе программы ("Создать координаты в стиле Word?"). Единственное, потребуется отредактировать полученный файл-координат. Нужно изменить имя переменной и в конце (внизу) файла, перенести константу в главный файл "Start.asm", саму строку закомментировать или удалить. Изменить или добавить имена глобальных переменных, также и в коде программы, если планируете увеличить/уменьшить количество "скринов" (пример, смотрите на основе этой демонстрашки).
 Развернуть: Start.asm
Код: Выделить всё
%TITLE "Start.asm"

; Работают клавиши: стрелки, цифры.
; Стрелки увеличивают или уменьшают, скорость смены картинки.
; Стрелка Влево - уменьшает (Вправо - увеличивает), по-максимуму.
; Стрелка Вверх - увеличивает (Вниз - уменьшает), на единицу
; (^тоже для кнопок Минус и Плюс).
; Цифры 1, 2, 3, 4 загружают картинку.
; Клавиша "R" сбросить настройку.

   IDEAL
   P386
   SMART
   JUMPS
   LOCALS   @@
   MODEL   small
   STACK   256

COORD_TOTAL_01   equ   5730   ; Count pixel. Количество точек (пикселей)
COORD_TOTAL_02   equ   6896   ; выводимых координат
COORD_TOTAL_03   equ   6582   ; из четырёх
COORD_TOTAL_04   equ   6250   ; рисунков.

VGA_SEGMENT   equ   0A000h

   DATASEG

   global g_wCoord_01:word, g_wCoord_02:word
   global g_wCoord_03:word, g_wCoord_04:word
   global g_wDelay:word, g_wTick:word, g_wCurMod:word

exCode      db 0
VGASeg      dw VGA_SEGMENT   ; Vga segment in high memory.

red      db 0   ; Red color value
green      db 0   ; Green color value
blue      db 0   ; Blue color value
g_wCount      dw 0
g_wCurMod   dw 0
g_wDelay      dw 0

   CODESEG

   global appKbd:near ; Модуль управления клавиатурой.
Start:
   mov   ax, @data   ; Set DS to point to data segment.
   mov   ds, ax   ; Устанавливает переменные программы
         ; в сегменте данных.

   mov   ah, 0Fh   ; Preserve original video mode.
   int   10h   ; Сохраняет текущий режим видеоадаптера
   push   ax   ;
   mov   ax, 13h   ; Set video mode.
   int   10h   ; Устанавливает видео-режим.

; --- Set palette --- Устанавливает палитру.
   mov   dx, 3C8h   ; Index port.
   mov   al, 0   ; Load AL with first palette register to set.
   out   dx, al   ; Setup port for first palette register.
   inc   dx   ; Sets DX to palette color register.
   mov   cl, 64
@@SPAL:
   mov   al, [red]   ; Load AL with red color value.
   out   dx, al   ; Set red amount.
   mov   al, [green] ; Load AL with green color value.
   out   dx, al   ; Set green amount.
   mov   al, [blue]   ; Load AL with blue color value.
   out   dx, al   ; Set blue amount.
   inc   [red]   ; Increment red value.
   loop   @@SPAL   ; Continue to next register.

   mov   es, [VGASeg] ; Set ES to point to video segment.
   mov   ds, [VGASeg] ; Set DS to point to video segment.
AGAIN:
   mov   ax, 103Ah   
   mov   bx, 320
@@10:
   push   ax
   mov   ax, @data    ; Set DS to point to data segment.
   mov   ds, ax

   push   bx
   push   dx

   mov   bx, [g_wCount]
   add   bx, bx

   cmp   [g_wCurMod], 1 ; Текущая картинка 1?
   je   short @@20   ; Да. Переход на метку @@20
            ; je (джумп равно) jne (не равно)

   cmp   [g_wCurMod], 2 ; Текущая картинка 2?
   je   short @@21   ; Да. Переход на метку @@21

   cmp   [g_wCurMod], 3
   je   short @@22

   mov   dx, COORD_TOTAL_01   ; KapTuHKA #1
   mov   ax, [g_wCoord_01+bx]
   jmp   short @@30
@@20:
   mov   dx, COORD_TOTAL_02   ; KapTuHKA #2
   mov   ax, [g_wCoord_02+bx]
   jmp   short @@30
@@21:
   mov   dx, COORD_TOTAL_03   ; KapTuHKA #3
   mov   ax, [g_wCoord_03+bx]
   jmp   short @@30
@@22:
   mov   dx, COORD_TOTAL_04   ; KapTuHKA #4
   mov   ax, [g_wCoord_04+bx]
@@30:
   mov   ds, [VGASeg]
   mov   di, ax
   mov   ax, @data    ; Set DS to point to data segment.
   mov   ds, ax
   pop   bx

   inc   [g_wCount]
   cmp   dx, [g_wCount]
   pop   dx
   je   short @@40

   pop   ax
   mov   ds, [VGASeg]
   mov   [es:di], al
   jmp   short @@10
@@40:
   mov   [g_wCount], 0
   pop   ax
   mov   ds, [VGASeg]
   mov   [es:di], al
@@50:
   cmp   si, 320 * 200
   jae   short @@60
   lodsb
   or   al, al
   je   short @@60
   dec   ax
   dec   ax
   mov   [si-2], al
   mov   [si], al
   mov   [bx+si-1], al
   mov   [si-1-1*320], al
@@60:
   add   si, dx
   inc   dx
   jne   short @@50

   mov   ax, @data    ; Set DS to point to data segment.
   mov   ds, ax

   cmp   [g_wTick], -1
   je   short @@97

   inc   [g_wDelay]
   mov   ax, [g_wTick]
   cmp   ax, [g_wDelay]
   je   short @@NSCR
@@97:
   call   appKbd      ; Check for KbHit (Обработка наж. клав.)

   jnc   AGAIN
   jmp   short Exit

@@NSCR:         ; Next screen...
   cmp   [g_wCurMod], 3   ; Следующая картинка...
   je   short @@98
   inc   [g_wCurMod]
   jmp   short @@99
@@98:
   mov   [g_wCurMod], 0
@@99:
   mov   [g_wCount], 0
   mov   [g_wDelay], 0
   jmp   AGAIN
Exit:
   pop   ax   ; Restore video mode.
   mov   ah, 0   ; Восстановить видео-режим.
   int   10h

   mov   ah, 4Ch   ; Return to DOS.
   mov   al, [exCode] ; Вернуться в Дос,
   int   21h   ; код-выхда в регистре AL

   END   Start   ; Конец программы, точка входа.

Изображение
И прикрепляю исходный код генератора координат "GetCoord-1-0.zip"
Вложения
GetCoord-1-0.zip
(26.7 Кб) Скачиваний: 751
Greka.zip
(132.67 Кб) Скачиваний: 824
Аватара пользователя
rvg
Мастер Даунгрейда
 
Сообщения: 661
Зарегистрирован: 18 июл 2023, 14:12

Re: Полезные исходники для DOS

Сообщение .::. Typucm .::. » 11 сен 2024, 13:49

rvg, под досбокс готовый вариант из архива вполне работает. Не так красиво выглядит как на картинке, красный цвет и пульсация краски. Если скорость не увеличивать, а оставить по умолчанию 3000, то долго будет обновлять текст. При 20000 вполне шустро меняет сообщения, что под dosbox staging, что под dosbox-x.
«Не стесняйтесь думать. Неэффективно пытаться помочь людям, которые не желают помогать себе сами. Нормально чего-то не знать, прикидываться идиотом — нет.» (Слава С.ПО.)
Аватара пользователя
.::. Typucm .::.
 
Сообщения: 924
Зарегистрирован: 28 янв 2022, 22:43

Re: Полезные исходники для DOS

Сообщение .::. Typucm .::. » 15 дек 2024, 21:28

Попалось, без кодов. Приткну сюда, 5 поделок для dos. Тесты, утилита для распаковки и микродиалог.
Вложения
utils.zip
(123.61 Кб) Скачиваний: 733
«Не стесняйтесь думать. Неэффективно пытаться помочь людям, которые не желают помогать себе сами. Нормально чего-то не знать, прикидываться идиотом — нет.» (Слава С.ПО.)
Аватара пользователя
.::. Typucm .::.
 
Сообщения: 924
Зарегистрирован: 28 янв 2022, 22:43

Re: Полезные исходники для DOS

Сообщение luzga » 18 ноя 2025, 09:21

PJPark - Процедура парковки жесткого диска.
 Развернуть: PJPark.asm
Код: Выделить всё
title   'Park Disk Routine for Hard Disks 5-3-85'

;
;       Hard Disk Parking Routine for MSDOS
;       Version for Seagate 20-60 meg drives, though should work for
;       any size hard disks
;
;       Currently setup for DOS and MASM
;
;       Also provides limited diagnostics (ie Drive Parameters)
;       and parks multiple drives
;
;       Author:         M. Steven Baker
;       Revision date   January 31, 1985
;       Last revision   May 3, 1985
;
;       If using MASM use exe2bin to convert to a .COM file
;       you can then load PARK.com with debug and change CX=260
;       and W (write) out the file shrinking its size
;       This chops off the 200h bytes of stack space from the COM file
;
;       E Q U A T E S
;
cr      equ     0dh
lf      equ     0ah
;
false   equ     0
true    equ     not false
;
CPM86   equ     false
MSDOS   equ     not CPM86

ISMASM    equ true

    if  ISMASM        ;use some Macros
jmps    macro   dummy
        jmp     short   dummy
        endm
;
rs      macro   count
        db      count dup(?)
        endm

cseg    macro
        CODE    segment
        assume  cs:CODE,ds:CODE,es:CODE,ss:CODE
        endm

    ENDIF   ;ISMASM


;
        cseg

        ORG     0100h
;
start:  jmps    start1
dosflg: dw      MSDOS           ;0=CPM86 FF=dos
;
start1: mov     ax,cs
        mov     ds,ax
        mov     es,ax
        mov     ss,ax
        mov     sp,offset stktop
        cld
;
        call    ilprt
        db      cr,lf,'Park version 2.01  5-3-85 (msb)',cr,lf,0
;
parkit: mov     dx,80h
        push    dx
        call    getparms
        jnc     parm_ok
parker: jmp     parm_err
;
parm_ok: mov    ax,dx
        pop     dx
;
        push    ax
        call    ilprt
        db      'DRIVE PARMETERs: TotDrvs=',0
        pop     ax
        push    ax
        add     al,'0'          ;AL = number of drives
        call    conout
        pop     ax
        call    crlf
;
        xor     cx,cx           ;zero CX as loop counter
        mov     cl,al
        or      cx,cx           ; are there any drives
        jz      nodrives
;
parklp: push    cx              ;save number of drives
        push    dx              ;save drive number
        mov     ax,1100h        ;recalibrate hard disk
        int     13h
        jnc     recal_ok
        jmp     recal_err
;
recal_ok:
        call    getparms
        jnc     ok_2
        jmp     parm_err
;

ok_2:   mov     ax,dx
        pop     dx              ;restore drive number
        push    dx
        call    sayparms
        MOV     AX,0C00H        ;seek command
        INT     13H
        jc      seek_err
;
        pop     dx
        inc     dx              ; go to next drive
        pop     cx              ;get back loop counter
        loop    parklp

        call    ilprt
        db      CR,LF,'Head(s) parked !!',CR,LF,0

        jmp     exit            ;and terminate
;
nodrives:
        call    ilprt
        db      cr,lf,'NO HARD DISK drives installed',cr,lf,0
        jmp     exit
;
seek_err:
        call    ilprt
        db      cr,lf,'Seek error on drive ',0
        call    saydrive
        jmp     abort

recal_err:
        call    ilprt
        db      cr,lf,'Recalibrate error on drive ',0
        call    saydrive
        jmp     abort

parm_err:
        call    ilprt
        db      cr,lf,'Disk Parameter call returned error on drive ',0
        call    saydrive
        jmp     abort

saydrive:
        push    ax
        mov     al,dl           ;get hard disk drive # to AL
        and     al,7fh          ;strip 8th bit
        add     al,'0'
        call    conout
        pop     ax
        ret

getparms:
        mov     ax,0800h        ;get current drive parameters
        int     13h
        ret

;       S A Y P A R M S
;       entry:  DL = drive number
;               AL = number of consecutive drives
;               AH = maximum useable head number
;               CH = maximum useable value for cylinder
;               CL = maximum useable value for sector number
;                       and cylinder number high bits
;       exit:   all registers preserved

sayparms:
        push    ax
        push    bx
        push    cx
        push    dx
;
        push    ax
        call    ilprt
        db      'DRIVE PARMs:   Drv=',0
        mov     al,dl           ;Drive #
        and     al,7fh          ;strip off lower bits
        add     al,'0'
        call    conout          ;say drive
;
        call    ilprt
        db      '  Heads=',0
        pop     ax              ;restore heads and tot drives
        xchg    ah,al
        call    hexout
;
        call    ilprt
        db      '  Cyls=',0
        push    cx              ;save cylinders and sectors
        mov     ax,cx
        and     ax,0c0h         ;strip off high bits of CL
;
        push    cx
        mov     cx,6
shloop: shr     ax,1
        loop    shloop
        pop     cx
;
        call    hexout
        pop     cx              ;restore CX = sectors & cylinders
        mov     al,ch           ;now lower 8 bits of cylinders
        call    hexout
        mov     al,'h'
        call    conout
;
        call    ilprt
        db      '  Sectors= ',0
        mov     al,cl
        and     al,3fh          ;strip off lower 6 bits
        call    hexout
        mov     al,'h'
        call    conout
;
        call    crlf
;
        pop     dx
        pop     cx
        pop     bx
        pop     ax
        ret
;
conout: push    ax
        push    bx
        push    dx
        mov     dl,al
        mov     ah,6
        int     21h             ;change this to a CALL BDOS for CP/M
        pop     dx
        pop     bx
        pop     ax
        ret
;
ilprt:
        pop     si
ilprt1: lodsb
        or      al,al
        jz      ilprtr
        call    conout
        jmps    ilprt1
ilprtr: push    si
        ret
;
hexout: push    ax
        shr     al,1
        shr     al,1
        shr     al,1
        shr     al,1
        call    pnib
        pop     ax
        push    ax
        call    pnib
        pop     ax
        ret
;
pnib:   and     al,0fh
        add     al,'0'
        cmp     al,'9'
        jbe     pnib2
        add     al,7
pnib2:
        call    conout
        ret

crlf:   push    ax
        mov     al,CR
        call    conout
        mov     al,LF
        call    conout
        pop     ax
        ret
abort:
        call    ilprt
        db      '  .. Aborting',cr,lf,0
exit:   mov     ax,0
        int     21h             ;change to a call BDOS for CP/M
exit1:  jmps    exit1
;
        db      0

        even

;temp   equ     $ and 0fffeh            ;make on even boundary for CP/M-86
;
;       org     temp
        RS      200h
stktop  dw      0
        dw      0
;
        CODE    ends
        end     start           ;put starting label routine at 100h

Сборка программы c помощью Turbo Assembler (Tasm):
tasm PJPark
tlink /t PJPark
 Развернуть: Удачный результат сборки
Изображение

В приложенном пакете исходный код и собранная программа. Запускать нужно в чистом Дос!
Вложения
PJPark.zip
(2.94 Кб) Скачиваний: 270
Аватара пользователя
luzga
Мастер Даунгрейда
 
Сообщения: 478
Зарегистрирован: 04 сен 2025, 19:35

Re: Полезные исходники для DOS

Сообщение .::. Typucm .::. » 12 июн 2026, 23:57

Попалось. Должно работать на 6-ке, но не дождешься ходов. На 2-3 в эмуле шевелится, но назвать это игрой нельзя.
 Развернуть: автошахматы
program bmcp;
const
bs = 120; bc = bs - 1;
ms = 120; mc = ms - 1;
mp = 1200;
nsd = 3; { 2-3 quick idiot; 6 normal }
type
ti = integer;
tbo = boolean;
tb = array[0..bc] of ti;
tc = char;
tm = record
f, t, p, fl: byte;
end;
tma = record
a: array[0..mc] of tm;
c: ti;
end;
var
ba: tb;
cs, ep, bca, bf, ply: ti;
cbh: LongInt;
ha: array[0..mp] of LongInt;
bm: tm;
bmi: LongInt absolute bm;
const
ib: tb = (
7,7,7,7,7,7,7,7,7,7,
7,7,7,7,7,7,7,7,7,7,
7,12,10,11,13,14,11,10,12,7,
7,9,9,9,9,9,9,9,9,7,
7,0,0,0,0,0,0,0,0,7,
7,0,0,0,0,0,0,0,0,7,
7,0,0,0,0,0,0,0,0,7,
7,0,0,0,0,0,0,0,0,7,
7,1,1,1,1,1,1,1,1,7,
7,4,2,3,5,6,3,2,4,7,
7,7,7,7,7,7,7,7,7,7,
7,7,7,7,7,7,7,7,7,7
);
pc: array[0..15] of char = ' PNBRQK pnbrqk ';
ps: array[0..7] of byte = (0,1,3,3,5,9,15,0);
po: array[0..7,0..8] of ti = (
(0,0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0,0),
(-21,-19,-12,-8,8,12,19,21,0),
(-11,-9,9,11,0,0,0,0,0),
(-10,-1,1,10,0,0,0,0,0),
(-11,-10,-9,-1,1,9,10,11,0),
(-11,-10,-9,-1,1,9,10,11,0),
(0,0,0,0,0,0,0,0,0)
);
pis: array[0..7] of boolean = (false,false,false,true,true,true,false,false);
cam: array[0..bc] of integer = (
0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,
7,15,15,15,3,15,15,11,0,0,
15,15,15,15,15,15,15,15,0,0,
15,15,15,15,15,15,15,15,0,0,
15,15,15,15,15,15,15,15,0,0,
15,15,15,15,15,15,15,15,0,0,
15,15,15,15,15,15,15,15,0,0,
13,15,15,15,12,15,15,14,0,0,
0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0
);

procedure hb;
var
i: ti;
j: LongInt;
begin
j := (LongInt(ep) * $40000000) xor (LongInt(bca) * $04000000);
for i := 20 to 99 do
j := j xor (LongInt(ba[i]) * i);
cbh := j;
end;

procedure nb;
begin
ba := ib;
cs := 0;
bca := 15;
ep := 1;
bf := 0;
ply := 0;
hb;
end;

procedure pb;
var
i, x, y: ti;
c: tc;
begin
for i := 10 to 109 do begin
x := i mod 10;
y := i div 10;
c := pc[ba[i] and 15];
if c = ' ' then
if y in [2..9] then
if x in [1..8] then
if (((x + y) and 1) <> 0) then c := #176 else c := #219
else
else
c := tc(48 + y)
else
if x in [1..8] then c := tc(96 + x);
write(c);
if x = 9 then writeln;
end;
writeln;
end;

function eb: integer;
var
i, j: ti;
begin
j := 0;
for i := 0 to bc do
if (ba[i] and 8) <> 0 then
dec(j, ps[ba[i] and 7])
else
inc(j, ps[ba[i] and 7]);
if cs = 8 then j := -j;
eb := j;
end;

procedure gm(var ma: tma; f, t, fl: ti);
var
i: ti;
begin
if ma.c >= ms then exit;
if ((fl and 16) <> 0) and (((cs = 0) and (t < 30)) or ((cs <> 0) and (t > 90))) then begin
for i := 2 to 5 do begin
if ma.c >= ms then exit;
ma.a[ma.c].f := f;
ma.a[ma.c].t := t;
ma.a[ma.c].p := i;
ma.a[ma.c].fl := fl or 32;
inc(ma.c);
end;
end else begin
ma.a[ma.c].f := f;
ma.a[ma.c].t := t;
ma.a[ma.c].p := 0;
ma.a[ma.c].fl := fl;
inc(ma.c);
end;
end;

procedure gma(var ma: tma);
var
i, j, p, n: integer;
begin
ma.c := 0;
for i := 21 to 99 do begin
if (ba[i] and 8) = cs then begin
p := ba[i] and 7;
if p = 1 then begin
if cs = 0 then begin
if (ba[i - 11] <> 0) and ((ba[i - 11] and 8) = 8) then gm(ma, i, i - 11, 17);
if (ba[i - 9] <> 0) and ((ba[i - 9] and 8) = 8) then gm(ma, i, i - 9, 17);
if ba[i - 10] = 0 then begin
gm(ma, i, i - 10, 16);
if (i >= 80) and (ba[i - 20] = 0) then gm(ma, i, i - 20, 24);
end;
end else begin
if (ba[i + 9] <> 0) and ((ba[i + 9] and 8) = 0) then gm(ma, i, i + 9, 17);
if (ba[i + 11] <> 0) and ((ba[i + 11] and 8) = 0) then gm(ma, i, i + 11, 17);
if ba[i + 10] = 0 then begin
gm(ma, i, i + 10, 16);
if (i <= 40) and (ba[i + 20] = 0) then gm(ma, i, i + 20, 24);
end;
end;
end else begin
j := 0;
while po[p, j] <> 0 do begin
n := i;
while true do begin
inc(n, po[p, j]);
if ba[n] = 7 then break;
if ba[n] <> 0 then begin
if (ba[n] and 8) = (cs xor 8) then gm(ma, i, n, 1);
break;
end;
gm(ma, i, n, 0);
if not pis[p] then break;
end;
inc(j);
end;
end;
end;
end;
if cs = 0 then begin
if (bca and 1) <> 0 then gm(ma, 95, 97, 2);
if (bca and 2) <> 0 then gm(ma, 95, 93, 2);
end else begin
if (bca and 4) <> 0 then gm(ma, 25, 27, 2);
if (bca and 8) <> 0 then gm(ma, 25, 23, 2);
end;
if ep >= 0 then begin
if cs = 0 then begin
if ba[ep + 9] = 1 then gm(ma, ep + 9, ep, 21);
if ba[ep + 11] = 1 then gm(ma, ep + 11, ep, 21);
end else begin
if ba[ep - 11] = 9 then gm(ma, ep - 11, ep, 21);
if ba[ep - 9] = 9 then gm(ma, ep - 9, ep, 21);
end;
end;
end;

function iia(s, ncs: ti): tbo;
var
ocs, i: ti;
ma: tma;
begin
iia := false;
ocs := cs;
gma(ma);
for i := 0 to ma.c - 1 do
if ma.a[i].t = s then begin
iia := true;
break;
end;
cs := ocs;
end;

function iic(ncs: ti): tbo;
var
i: integer;
begin
iic := false;
for i := 20 to 99 do
if ba[i] = (6 or ncs) then begin
iic := iia(i, ncs xor 8);
exit;
end;
end;

function mm(const m: tm): tbo;
var
f, t, obf, obca, oep: ti;
oba: tb;
begin
mm := false;
obf := bf;
oba := ba;
obca := bca;
oep := ep;
if ((ba[m.f] and 8) <> cs) or ((ba[m.t] and 8) = 6) then exit;
if (m.fl and 2) <> 0 then begin
if iic(cs) then exit;
case m.t of
97: begin
if (ba[96] <> 0) or (ba[97] <> 0) or iia(96, cs xor 8) or iia(97, cs xor 8) then exit;
f := 98; t := 96;
end;
93: begin
if (ba[92] <> 0) or (ba[93] <> 0) or (ba[94] <> 0) or iia(93, cs xor 8) or iia(94, cs xor 8) then exit;
f := 91; t := 94;
end;
27: begin
if (ba[26] <> 0) or (ba[27] <> 0) or iia(26, cs xor 8) or iia(27, cs xor 8) then exit;
f := 28; t := 26;
end;
23: begin
if (ba[22] <> 0) or (ba[23] <> 0) or (ba[24] <> 0) or iia(23, cs xor 8) or iia(24, cs xor 8) then exit;
f := 21; t := 24;
end;
else begin f := 0; t := 0; end;
end;
ba[t] := ba[f];
ba[f] := 0;
end;
bca := bca and (cam[m.f] and cam[m.t]);
if (m.fl and 8) <> 0 then
if cs = 0 then ep := m.t + 8 else ep := m.t - 8
else ep := -1;
if (m.fl and 17) <> 0 then bf := 0 else inc(bf);
if (m.fl and 32) <> 0 then begin
ba[m.t] := (m.p and 7) or (ba[m.f] and 8);
ba[m.f] := 0;
end else begin
ba[m.t] := ba[m.f];
ba[m.f] := 0;
end;
if (m.fl and 4) <> 0 then
if cs = 0 then ba[m.t + 10] := 0 else ba[m.t - 10] := 0;
cs := cs xor 8;
if iic(cs xor 8) then begin
cs := cs xor 8;
bf := obf;
ba := oba;
bca := obca;
ep := oep;
exit;
end;
hb;
if ply < mp then begin
ha[ply] := cbh;
inc(ply);
end;
mm := true;
end;

function rc: ti;
var
i, j: ti;
begin
j := 0;
for i := ply - bf to ply - 1 do
inc(j, ord(ha[i] = cbh));
rc := j;
end;

function nss(a, b, d: ti): ti;
var
i, s, obf, obca, oep: ti;
oba: tb;
ma: tma;
f, c: tbo;
begin
if d <= 0 then begin
nss := eb;
exit;
end;
c := iic(cs);
inc(d, ord(c));
gma(ma);
f := false;
obf := bf;
oba := ba;
obca := bca;
oep := ep;
for i := 0 to ma.c - 1 do begin
if not mm(ma.a[i]) then continue;
f := true;
s := -nss(-b, -a, d - 1);
cs := cs xor 8;
bf := obf;
ba := oba;
bca := obca;
ep := oep;
if s > a then begin
if s >= b then begin
nss := b;
exit;
end;
a := s;
if d = nsd then bm := ma.a[i];
end;
end;
if not f then
if c then nss := -10000 + ply else nss := 0
else
if bf >= 100 then nss := 0 else nss := a;
end;

begin
nb;
pb;
writeln('Thinking...');
while true do begin
bmi := 0;
nss(-10000, 10000, nsd);
mm(bm);
if bmi = 0 then begin
if iic(cs) then writeln('CHECKMATE!') else writeln('STALEMATE!');
break;
end else if (bf >= 100) or (rc >= 3) then begin
writeln('DRAW!');
break;
end;
if iic(cs) then writeln('CHECK!');
pb;
end;
readln;
end.
«Не стесняйтесь думать. Неэффективно пытаться помочь людям, которые не желают помогать себе сами. Нормально чего-то не знать, прикидываться идиотом — нет.» (Слава С.ПО.)
Аватара пользователя
.::. Typucm .::.
 
Сообщения: 924
Зарегистрирован: 28 янв 2022, 22:43

Re: Полезные исходники для DOS

Сообщение oldpcfan82 » 14 июл 2026, 21:11

Код VAR.CPP, это типа как в MS-DOS в command.com команда SET (enviroment variables), требуется Borland C++ выше версии 2.X, начиная с версии 3.X. Расширение файла должно быть обязательно cpp, чтобы коментарии /* */ не писать, а писать // такие коментарии:
Код: Выделить всё
#define MAX_VARS 20 // Максимальное количество перменной
#include <stdio.h>
#include <string.h>

int var_index=0; // Индекс
char var_name[MAX_VARS][10]; // Массив для хранения имени переменной
char var_value[MAX_VARS][80]; // Массив для хранения значения переменной

// Добавляет переменную
void add_variable(char *name, char *value) {
  strcpy(var_name[var_index], name);
  strcpy(var_value[var_index], value);
  if(var_index < MAX_VARS) var_index++;
}

// Ищет имя переменной, и возвращает индекс
int get_value(char *name) {
  int i;
  for(i=0; i < var_index; i++) {
    if(strcmp(var_name[i], name) == 0) return i;
  }
  return -1;
}

int main(void) {
  int i;
  add_variable("VAR1", "Привет мир!"); // Записываем в переменную VAR1 значение "Привет мир!"
  i = get_value("VAR1"); // Ищем переменную VAR1
  if(i != -1) printf("\n%s", var_value[i]); // Если нашли, то отображаем значение перменной VAR1
  return 0;
}


Результат:
Привет мир!
Аватара пользователя
oldpcfan82
Мастер Даунгрейда
 
Сообщения: 678
Зарегистрирован: 01 окт 2023, 22:57

Re: Полезные исходники для DOS

Сообщение clihlt » 15 июл 2026, 10:17

oldpcfan82 писал(а):Результат:
Привет мир!
Полезность этого кода разве что в том, что он показывает как не надо писать.
С уважением,
Владислав Васильев (aka clihlt).
Аватара пользователя
clihlt
Мастер Даунгрейда
 
Сообщения: 617
Зарегистрирован: 20 мар 2023, 21:17
Откуда: Брянск, СССР

Re: Полезные исходники для DOS

Сообщение StoYazykov » 15 июл 2026, 13:38

oldpcfan82,
ну зачем же использовать фиксированные массивы, которые при маленьких размерах оказываются слишком маленькими, а при большИх размерах - забивают стек (ведь, выделяются-то они на стеке!)...
И ещё - нехорошо использовать глобальные переменные (в вашем случае).

В общем, переписал я ваш код на более правильный. Размер массива переменных - теперь, не ограничен!

 Развернуть: Фикшенный код
Код: Выделить всё
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#define VARS_INIT(a) memset(&a, 0, sizeof(a))

typedef struct {
   char *n, *v;
} var;

typedef struct {
   var *v;
   size_t p;
} vars;

// Добавляет переменную
void add_variable(vars *a, char *name, char *value) {
   char *z;
   var *x;
   a->v=realloc(a->v, sizeof(var)*(a->p+1));
   x=a->v+a->p;
   x->n=malloc(strlen(name)+1);
   x->v=malloc(strlen(value)+1);
   strcpy(x->n, name);
   strcpy(x->v, value);
   a->p++;
}

void get_variable(vars *a, var *b, char *n) {
   size_t i;
   var *x;
   memset(b, 0, sizeof(var));
   for(i=0; i<a->p; i++) {
      x=a->v+i;
      if(strcmp(x->n, n)) continue;
      b->n=malloc(strlen(x->n)+1);
      b->v=malloc(strlen(x->v)+1);
      strcpy(b->n, x->n);
      strcpy(b->v, x->v);
      return;
   }
}

void free_variables(vars *a) {
   size_t i;
   var *x;
   for(i=0; i<a->p; i++) {
      x=a->v+i;
      free(x->n);
      free(x->v);
   }
   free(a->v);
}

void free_variable(var *a) {
   free(a->n);
   free(a->v);
}


int main(void) {
   vars a;
   var b;
   VARS_INIT(a);
   add_variable(&a, "VAR1", "Привет мир!"); // Записываем в переменную VAR1 значение "Привет мир!"
   get_variable(&a, &b, "VAR1");
   if(b.v) puts(b.v); // если не NULL - то нашли!
   free_variable(&b);
   free_variables(&a);
   return 0;
}
Последний раз редактировалось StoYazykov 15 июл 2026, 13:52, всего редактировалось 4 раз(а).
Самое тёмное дело - это строки в C

Объектно-ориентированное программирование -- метод изготовления граблей по принципу матрешки.

http://revival.narod.ws

Изображение
Аватара пользователя
StoYazykov
Мастер Даунгрейда
 
Сообщения: 280
Зарегистрирован: 25 дек 2023, 11:25
Откуда: Казань
Железо: Intel Pentium MMX 166 MHz, 8 и 2 ГБ HDD, 80 MB RAM; AMD A8-6410 APU with Radeon R5 Graphics, 16 ГБ

Re: Полезные исходники для DOS

Сообщение clihlt » 15 июл 2026, 15:58

StoYazykov писал(а): а при большИх размерах - забивают стек (ведь, выделяются-то они на стеке!)
Глобальные переменные по вашему хранятся на сетке? Чего только не узнаешь в интернетах. ;-D
С уважением,
Владислав Васильев (aka clihlt).
Аватара пользователя
clihlt
Мастер Даунгрейда
 
Сообщения: 617
Зарегистрирован: 20 мар 2023, 21:17
Откуда: Брянск, СССР

Re: Полезные исходники для DOS

Сообщение StoYazykov » 15 июл 2026, 18:53

Глобальные в области данных.
P. S. Да, ошибся немного. Бегло смотрел программу.
Последний раз редактировалось StoYazykov 15 июл 2026, 20:02, всего редактировалось 2 раз(а).
Самое тёмное дело - это строки в C

Объектно-ориентированное программирование -- метод изготовления граблей по принципу матрешки.

http://revival.narod.ws

Изображение
Аватара пользователя
StoYazykov
Мастер Даунгрейда
 
Сообщения: 280
Зарегистрирован: 25 дек 2023, 11:25
Откуда: Казань
Железо: Intel Pentium MMX 166 MHz, 8 и 2 ГБ HDD, 80 MB RAM; AMD A8-6410 APU with Radeon R5 Graphics, 16 ГБ

След.

Вернуться в Программирование

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 6