На главную
ПРАВИЛА FAQ Помощь Участники Календарь Избранное DigiMania RSS
msm.ru
! Правила раздела "Наши Исходники"
Раздел предназначен для публикации различных исходников и программных решений (в виде исходных текстов), которые Вы считаете достойными внимания и/или интересными. Язык исходника значения не имеет. Это может быть C/C++, Pascal, Perl, PHP, C#, Foth, Prolog или любой другой существующий язык программирования. Единственный момент – в названии темы этот язык должен быть указан. Например, «[C++] Представление чисел в римской записи». Сам исходный текст должен содержаться в первом посте темы. Если исходник занимает не больше одного-двух экранов, то допустимо его публикация непосредственно в посте. Иначе исходный текст должен быть прикреплен к посту в виде архива. Кроме того, первый пост должен содержать:

- Информацию о платформе/компиляторе, для которых предназначен исходный текст (если эта информация существенна)
- Ссылку на оригинал и автора (если публикуется чужой исходный текст)
- Максимально подробное описание – какую задачу решает опубликованный исходный текст, и чем он интересен.

Плагиат крайне не приветствуется. Также не приветствуется публикация исходных текстов вирусов, крэков и т. п. информации. Это элементарно противозаконно.

Для быстрого поиска нужного исходника можно воспользоваться навигатором:
Быстрый поиск по разделу
Модераторы: Flex Ferrum
Страницы: (2) [1] 2  все  ( Перейти к последнему сообщению )  
> Delphi-программы для MS-DOS :), статья на тему 'Дельфи Всемогущий'
    Данный прием позволяет адаптировать, несложные программы (стиля аля TP7), написаные и скомпилированые на Delphi, для исполнения их в среде или эмуляции MS-DOS, в которых есть подержка DPMI интерфейса, например в Dos-сессиях MS-Windows.

    Хочу сразу предупредить - вариант очень простейший и минимальный, поскоку писался исключительно ради собственного just-for-fun (and fan) :). Так как используються урезаные и доработаные модули System и Sysutils, следовательно функциональная полнота языка Obj-Pascal, немного пострадала, поэтому не стоит использовать некоторые типы данных, как AnsiString/Variant.

    Из ограничений, необходимо отметить, что совокупной длине кода + данных, желательно не превышать 64-ре килобайта.

    Собственно, основой скажем так, 'технологии', являеться утилита утилита DOSHACK, преобразующая PE файлы в DOS проги, настраивая смещения (релоки) для работы в низких диапазонах адресов, а также специальный STUB на assembler'е, выступающий в роли первичного стартового модуля.
    Перестройка и расширение секций, не реализовано, что несущественно для небольших программ (хотя и желательно)..


    Тестировано в DOS-сессиях Win9X/Win2к, c консольными компиляторами dcc32, из пакетов Delphi4 и Delphi7.

    Итак: (!!!NEW!!!)
    ExpandedWrap disabled
      {$APPTYPE CONSOLE}{$H+}{ уменьшитель *.exe заголовка для dos-stub }
      program DOSHACK;   { +креатор 'невалидного' для Win32 PE-файла }
      TYPE { типы и структуры данных  }
        IMAGE_DOS_HEADER = packed record  { from winnt.h }
      {00} e_magic    : word; { Magic number }
      {02} e_cblp     : word; { Bytes on last page of file }
      {04} e_cp       : word; { Pages in file }
      {06} e_crlc     : word; { Relocations   }
      {08} e_cparhdr  : word; { Size of header in paragraphs     }
      {0A} e_minalloc : word; { Minimum extra paragraphs needed  }
      {0C} e_maxalloc : word; { Maximum extra paragraphs needed  }
      {0E} e_ss       : word; { Initial (relative) SS value  }
      {10} e_sp       : word; { Initial SP value }
      {12} e_csum     : word; { Checksum  }
      {14} e_ip       : word; { Initial IP value }
      {16} e_cs       : word; { Initial (relative) CS value }
      {18} e_lfarlc   : word; { File address of relocation table }
      {1A} e_ovno     : word; { Overlay number }
      {1C} e_res  : array[1..4] of word; { Reserved words }
      {24} e_oemid    : word; { OEM identifier (for e_oeminfo) }
      {26} e_oeminfo  : word; { OEM information; e_oemid specific }
      {28} e_res2 : array [1..10] of word; { Reserved words }
      {3C} e_lfanew : cardinal; { File address of new exe header }
      end;
      { Примечание: в оптимизированом по размеру dos-файле (заглушке),
        код начинаеться со смещения $20, то есть с  e_res[3]      }
       
      { Описание структуры PE формата (с более развёрнутым, и упрощенным видом }
      { Directory format. }
       TImageDataDirectory  = packed record
        VA: cardinal; { VirtualAddress }
        Size : cardinal;
      end;
       
      PImageNtHeaders = ^TImageNtHeaders;
      TImageNtHeaders = packed record
      { Nt header }
        Signature: cardinal;
      { File header }
        Machine: Word;
        NumberOfSections: Word;
        TimeDateStamp: cardinal;
        PointerToSymbolTable: cardinal;
        NumberOfSymbols: cardinal;
        SizeOfOptionalHeader: Word;
        Characteristics: Word;
      { Optional header }
        Magic: Word;
        MajorLinkerVersion: Byte;
        MinorLinkerVersion: Byte;
        SizeOfCode: cardinal;
        SizeOfInitializedData: cardinal;
        SizeOfUninitializedData: cardinal;
        AddressOfEntryPoint: cardinal;
        BaseOfCode: cardinal;
        BaseOfData: cardinal;
      { NT additional fields. }
        ImageBase: cardinal;
        SectionAlignment: cardinal;
        FileAlignment: cardinal;
        MajorOperatingSystemVersion: Word;
        MinorOperatingSystemVersion: Word;
        MajorImageVersion: Word;
        MinorImageVersion: Word;
        MajorSubsystemVersion: Word;
        MinorSubsystemVersion: Word;
        Win32VersionValue: cardinal;
        SizeOfImage: cardinal;
        SizeOfHeaders: cardinal;
        CheckSum: cardinal;
        Subsystem: Word;
        DllCharacteristics: Word;
        SizeOfStackReserve: cardinal;
        SizeOfStackCommit: cardinal;
        SizeOfHeapReserve: cardinal;
        SizeOfHeapCommit: cardinal;
        LoaderFlags: cardinal;
        NumberOfRvaAndSizes: cardinal;
      { Directory Entries }
        Export:      TImageDataDirectory;{ [0] - Export Directory }
        Import:      TImageDataDirectory;{ [1] - Import Directory }
        Resource:    TImageDataDirectory;{ [2] - Resource Directory  }
        Exception:   TImageDataDirectory;{ [3] - Exception Directory }
        Security:    TImageDataDirectory;{ [4] - Security Directory  }
        BaseReloc:   TImageDataDirectory;{ [5] - Base Relocation Table }
        Debug:       TImageDataDirectory;{ [6] - Debug Directory }
        Copyright:   TImageDataDirectory;{ [7] - Architecture Specific Data }
        GlobalPtr:   TImageDataDirectory;{ [8] - RVA of GP }
        TlsData:     TImageDataDirectory;{ [9] - Thread Local Storage Dir }
        LoadConfig:  TImageDataDirectory;{ [10]- Load Configuration Directory }
        BoundImport: TImageDataDirectory;{ [11]- Bound Import Dir in headers }
        IAT:         TImageDataDirectory;{ [12]- Import Address Table }
        DelayImport: TImageDataDirectory;{ [13]- Delay Load Import Descriptors }
        ComRtDescr:  TImageDataDirectory;{ [14]- COM Runtime descriptor }
      end;
       
      TImageSectionHeader = packed record
        Name: packed array[0..7] of Byte;
        VirtualSize: cardinal;
        VirtualAddress: cardinal;
        SizeOfRawData: cardinal;
        PointerToRawData: cardinal;
        PointerToRelocations: cardinal;
        PointerToLinenumbers: cardinal;
        NumberOfRelocations: Word;
        NumberOfLinenumbers: Word;
        Characteristics: cardinal;
      end; TSections=array[0..10] of TImageSectionHeader; {.text/.data/.reloc/etc}
       
      TReloc_Table = packed record
      { Relocations Table - полублоки, патч-смещений (хаков), длиной до $FFF }
      { |-------------  SIZE --------------| |-------------  SIZE --------------| }
      { DWORD VA, DWORD SIZE, WORD,WORD,WORD DWORD VA, DWORD SIZE, WORD,WORD,WORD }
        VA:cardinal;Size:cardinal;OFFSETS: array[1..1000] of word;
      end;                  
       
      VAR { используемые переменные  }
        DOS: ^IMAGE_DOS_HEADER;
        PE: PImageNtHeaders;
        Sections: ^TSections;
        f: file;
        str: string;
        StubSize, len, offset:cardinal;
        data: ^Cardinal;
      { Доп. 64кб резерв, для больших STUB'ов и расп. секций }
        R: cardinal = $10000;
       
      { конвертор 'виртуального' адреса в 'реальный' }
      function VA_TO_RAW (VA:cardinal{; PE:PImageNtHeaders}):cardinal;
        var {Sections: ^TSections;} i:byte; label done1,done2;
        begin
      { установить указатель на структуры ImageSectionHeader (.code/.data/etc) }
        Sections:= pointer(cardinal(@PE.Magic) + PE.SizeOfOptionalHeader);
      { перебор секций до совпадения или попадания значения в диапазон секции  }
        for i:=0 to PE.NumberOfSections-1 do
        if VA = Sections[i].VirtualAddress then goto done1 else
        if VA < Sections[i].VirtualAddress + Sections[i].VirtualSize  
        then goto done2; Result := 0; exit; { ничего не найдено? прикол..  }
        done1: Result := Sections[i].PointerToRawData; exit;
        done2: Result := VA - Sections[i].VirtualAddress +
                              Sections[i].PointerToRawData; exit;
        end;
       
      procedure RELOCATE();
      var                
        RelocTab: ^TReloc_Table; i, code, position: Cardinal;
      begin;
      { получить расположение данных секции .reloc  }
       RelocTab := pointer(VA_TO_RAW(PE.BaseReloc.VA{,PE})+cardinal(PE)-StubSize);
      repeat  { патчить код до конца таблицы релоков  }
        Position := VA_TO_RAW (RelocTab.VA{, PE})+ (cardinal(PE)-StubSize);
       for i := 1 to ((RelocTab.Size -8) div 2) do
        begin if RelocTab.Offsets[i] = 0 then break; { 0 - конец секции }
      { cуммировать указатель на коде со смещением из  хак-блока }
        { TODO!!! - желательно ввести проверку типа релока }
        data := pointer (position+ (RelocTab.Offsets[i] and not $F000));
        data^ := VA_TO_RAW (data^  - PE.ImageBase{, PE});
      { Вычесть неиспользуемое в dos-адресации, смещение заголовка  }
        data^ := data^ -$20;
       end;{ Конец цикла, Обработать следующий хак-блок =)  }
            RelocTab := pointer(cardinal(RelocTab)+ RelocTab.Size);
      until RelocTab.VA = 0; { конец таблицы VA=0 }
      end;
        
      function COPY_STUB_FILE():boolean;
      var
        f:file; i,len, OldSize:cardinal;
      begin      
        Result:= false;
      { открыть файл для чтения  }
        Assign (f, ParamStr(2)); Reset (f,1); if IOResult <> 0 then exit;      
        len := FileSize(f);
        if len > StubSize then
      { Новый STUB больше? }
        begin
        OldSize := StubSize;
        R := R + StubSize; { Установить индекс только на PE секцию }
        StubSize := 0;
      { Вычислить размер с учетом выравнивания }
        repeat  
          inc (StubSize, PE.FileAlignment);
        until  StubSize > len;
      { Cкорректировать указатели, c учетом новой длины  }
        R :=R-StubSize; DOS:= @str[R]; PE:= @str[R+StubSize];
      { Скорректировать смещения относительно расположения в файле  }
        Sections:= pointer(cardinal(@PE.Magic) +
                                      PE.SizeOfOptionalHeader);
        for i:=0 to PE.NumberOfSections-1 do
                      inc (Sections[i].PointerToRawData, (StubSize-OldSize));
        end;
      { считать STUB-файл в начало строки }
          BlockRead (f, str[R], len);          { --- STR TOP ---      }
        Close (f); Result:= true;              {  |    move   |       }
      end;                                     {  |       up -R- DOS  }
                                               { -R- DOS      |- PE   }
             procedure FixPE ();               {  |- PE       |.text  }
                                               {  |.text      | CODE  }
                                               {  | CODE      ~ ....  }
      var i, len:cardinal;                     {  |.itext     |.itext }
      begin                                    {  | CODE      | CODE  }
      { вычислить полную длинну секции }       { --- STR END ---      }
         len:= Sections[0].SizeOfRawData;      
      if len < Sections[0].VirtualSize then len:= Sections[0].VirtualSize;
      { скоректировать к текущему расположению смещений, чтобы совпадали }
      { смещения в CALL-ах из секции .itext  на секцию .text }
        len:= (Sections[1].VirtualAddress - Sections[0].VirtualAddress)-len;
      { переместить содержимое (DOSh+PEh+.TEXT) }
        for i:= 0 to VA_TO_RAW (Sections[1].VirtualAddress)-1 do
         begin
           str [(R-len)+i] := str[R+i];  
           str[R+i]:= #0; { Затереть старые данные }
         end;
      { Cкорректировать указатели, c учетом новой длины  }
        R :=R-len; DOS:= @str[R]; PE:= @str[R+StubSize];
        Sections:= pointer(cardinal(@PE.Magic) +
                                      PE.SizeOfOptionalHeader);
      { Скорректировать смещения секций, относительно расположения в файле }
        for i:=1 to PE.NumberOfSections-2 do
                      inc (Sections[i].PointerToRawData, len);
      end;
       
      function BadPE():boolean;
      begin Result:= true;
      if ( DOS.e_lfanew < length(str)-R ) { Не будет вылета с указателем? }
       then {  проверить наличие сигнатуры и секции релокаций }
         if (pchar(PE) = 'PE') and (PE.BaseReloc.VA<>0 ) then Result := false;
      end;
       
      label { используемые метки }
        done, hint, error;
      BEGIN { НАЧАЛО ПРОГРАММЫ }
        if ParamCount = 0 then goto hint;
      { открыть файл к чтению  }
        Assign (f, ParamStr(1)); Reset (f,1); if IOResult <> 0 then goto hint;
        len := FileSize(f); SetLength (str, len+R-1); { строка = размер файла }
        BlockRead (f,str[R],len); DOS := @str[R]; { считать файл в строку }
      { Если STUB - выполнить уменьшение размера dos - заголовка  }
        if ParamCount = 1 then begin
      { Значение размера дос-файла, вычисляется спец. алгоритмом ;)  }
        StubSize := ((DOS.e_cp shl 9) - (-DOS.e_cblp and 511)) - 512 + 32;
        DOS.e_cblp := StubSize and 511; DOS.e_cp := (StubSize + 511) shr 9;
        DOS.e_cparhdr :=2; { теперь заголовок = 32 байта }
        Rewrite(f, 1); { установить файл на запись }
      { записать  DOS-заголовок c основными характеристиками }
        BlockWrite(f, str[R], 32); { смещение 0..$1F }
      { записать только код, пропустив нули }
        BlockWrite(f, str[R+512], len-512); { смещение $20..$FF }
          writeln ('STUB updated.'); goto done; {..и выйти }
       end;
      { Для прочих - изменить 'круглую', длину PE файла (дополнив нулями) }
        str := str + #0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0;
      { загрузить указатели на структуры данных (dos и pe заголовки) }
        DOS  := @str[R]; PE := @str[R+DOS.e_lfanew];
        Sections:= pointer(cardinal(@PE.Magic) + PE.SizeOfOptionalHeader);
      { Вычислить размер STUB (в принципе, равен значению e_lfanew ) }
        StubSize := cardinal(PE) - cardinal(DOS);
      { проверить PE на валидность }
        if BadPE() then goto error;
      { PE имидж by BDS2006? }
      if (Pchar(@Sections[0].Name) = '.text') and
                     (Pchar(@Sections[1].Name) = '.itext') then
        FixPE (); { распаковать секцию .text до физического вида в памяти }
      { заменить 'заглушку' }
        if COPY_STUB_FILE() = false then goto hint;
      { Получить стартовый адрес PE программы }
        Offset := VA_TO_RAW (PE.AddressOfEntryPoint{, PE});
      { Вычесть неиспользуемое в dos-адресации, смещение заголовка }
        Offset := Offset - $20;
      { Передать его в программу }
      { $20 mov dl,} str[R+ $21] := char(offset);
      { $22 mov dh,} str[R+ $23] := char(offset shr 8);
        data:= @str[R+ $24];
        if data^ = $00B500B1 then begin { программа SelfRelocated? }
      { Передать в программу смещение PE-заголовка }
        Offset := StubSize - $20;
      { $24 mov cl (B1),} str[R+ $25] := char(offset);
      { $26 mov ch (B5),} str[R+ $27] := char(offset shr 8);
        end { либо перестроить смещения  с 040xxxx на 0000xxxx }
           else { (по данным из RelocTable )  }
              RELOCATE ();
      { Установить полный размер, Dos exe файла }
        len := length (str)-R;
        DOS.e_cblp := len and 511; DOS.e_cp := (len + 511) shr 9;
      { Настроить область стека на конец 64кб }
        DOS.e_sp := $FFF0;
      { Сохранить изменения }
        Rewrite(f, 1); BlockWrite(f, str[R], len);
        writeln ('PE updated.');
      done:
        Close (f); exit;
      hint:
        writeln ('No file(s) to process, please use: ');
        writeln (' doshack <stub> - optimize size DOS STUB ');
        writeln (' doshack <pe-exe> <stub> - hack PE32 APP ');
      exit;
      error:
        writeln ('PE is not valid!');  
      goto done;
      END.


    STUB - модуль, переводит исполнение кода в 16-битной разрядности в 32-битную, после чего передает управление PE приложению.

    Собираеться практически любой версией TASM, и иже с ним 16-битным линкером (например из пакетов BP7, BorlandC++5.x), а также MASM & 16-бит MS-Link. DOSHACK дополнительно уменьшает размер dos-exe файлов, длинна которых не должна превышать 256 байт. Это вызвано тем, что в самом компиляторе dcc32, заглушка, обычно выводящая надпись "This program must be run under Win32" тоже небольшой и PE заголовок начинаеться со смещения $100, относительно начала файла.

    ExpandedWrap disabled
      ;build tasm:
      ;        TASM /ML /M2 STUB.ASM
      ;        TLINK /3 STUB.OBJ
      ;build masm:
      ;        ML /OMF /C STUB.ASM
      ;        LINK STUB.OBJ;
      ;optimize:
      ;        DOSHACK STUB.EXE
      ;
      ;simply, one segment model
             .model tiny
             .386P        
             .code        
      start:  ; entry point for linker
      ; ax : PE entry  (setup from DOSHACK)
              mov al, 000 ;
              mov ah, 000 ;
      ; push zero-expanded values (for 32-bit code)
              push 0
              push ax ;PE entry
      ;
              push cs  
              pop  ds      ; ds=cs
      ;
          mov  ah,16h  ; check for DPMI, and get far pointer
          mov  al,87h  ;
          int  2Fh     ; ES:DI -> DPMI entry point
          or   ax,ax   ; Return: AX = 0 if DPMI installed
          jnz  exit    ; fail?!  
       
              push cs      ; push far pointer for retf by DPMI
              push pm16-start ; (vs offset pm16)
       
          push es      ; push DPMI entry point
              push di      ; for call DPMI host
       
          mov  ax, ss  
              mov  cl, 00    
              mov  ch, 10h  
              add  cx, ax    
          mov  es, cx  ; ES=SS+1000h (buffer, need to work DPMI)
          xor  ax, ax
          inc  ax      ; AX = 1
      ; goto 16-bit Protected Mode
              retf         ; бall DPMI host (vs call dword ptr [esp])
       pm16:
      ; now, int31 is avialable, prepare to flat mode
      ; setup large data selector
          xor  cx, cx   ; cx = 0
          dec  cx       ; cx = FFFF
          mov  al,8     ; Set Segment Limit
              mov  bx,ds    ; BX = code segment selector
              mov  dx,cx    ; CX : DX - length (-1)
              int  31h
              jb   exit    ; fail?!  
              push ds
              pop  es     ; es = ds
      ; setup flat mode code selector
              mov  bx,cs
              lar  cx,bx    ; get selector property
              mov  al,9           ; Set Descriptor Access Rights
              xchg ch,cl        ; ( BX=selector; CX=access bits)
              or   ch, 01000000b ; bit B/D - chaged 16/32 mode.
              int  31h
              jb   exit    ; fail?!  
      ;now, opcode decode is 32-bit flat
              pop  ax ; eax- PE entrypoint
      ;        pop  dx ; edx- pointer to PE header
              call ax ; Execute code in 32-bit PE module
      exit:
              xor al,al
          mov ah,4Ch  ;return to dos
          int 21h    
      end     start


    Модули System/Sysutils...

    Данные модули должны помещаться, в каталоги с DOS-проектами. Многое из низкоуровневого функционала, такие как внутрение преобразования компилятора, (которые можно заимствовать из оригинальных файлов) операции с короткими строками, работают без проблем, за исключением разумееться функций которые обращаються к Win32API.

    Так как компилятор обычно создает небольшой стековый фрейм, то в Halt0 (на которой обычно завершаеться исполнение программы), он устраняеться, и управление возвращаеться обратно в 'заглушку'..

    ExpandedWrap disabled
      {build:
               DCC32 -Y -B SYSTEM.PAS
      }
      unit System;
      {$H-,I-,S-,L-}
      interface
       
      type
        PGUID = ^TGUID;
        TGUID = record
          D1: LongWord;
          D2: Word;
          D3: Word;
          D4: array[0..7] of Byte;
        end;
        PWideString = ^WideString;
       
      var IsConsole : Boolean;
          RandSeed:integer;
       
      procedure _Halt0;
      procedure _HandleFinally;
      procedure _SIN;
      procedure _ROUND;
      procedure _RandInt;
       
      implementation
       
                uses sysinit;
       
      procedure _Halt0;
      asm
        //
         pop eax
         leave // kill the stack frame
        //and return to caller (stub)
      end;
       
      procedure       _HandleFinally;
      asm
      end;
       
      procedure       _SIN;
      asm
              FSIN
      end;
       
      procedure       _ROUND;
      asm
              { ->    FST(0)  Extended argument       }
              { <-    EDX:EAX Result                  }
       
              SUB     ESP,8
              FISTP   qword ptr [ESP]
      //        FWAIT
              POP     EAX
              POP     EDX
      end;
       
      procedure       _RandInt;
      asm
      {     ->EAX     Range   }
      {     <-EAX     Result  }
              IMUL    EDX,RandSeed,08088405H
              INC     EDX
              MOV     RandSeed,EDX
              MUL     EDX
              MOV     EAX,EDX
      end;
       
      end.


    ExpandedWrap disabled
      unit SysInit;
      interface
      var
        TlsIndex: Integer;          
        TlsLast: Byte;
        PtrToNil: Pointer = nil;
      procedure _InitExe;
      implementation
      procedure _InitExe;
      asm
      end;
      end.


    Итак после успешной (я надеюсь), сборки утилиты и ингридиентов, в Delphi открываеться возможность использовать 'старые добрые прерывания', такие как int $10 (video-bios), int $21 (ms-dos), int $31 (dpmi).

    Пример простейшей программы:
    ExpandedWrap disabled
      program Hello;
      var str: pchar = 'Hello World!$';
       
      procedure int21_print (_ax:word;_dx:pchar);
      asm
           Int $21
      end;
      begin
      int21_print ($900, str);
      end.


    Разумееться, в таких программах, приходиться часто использовать вставки, но ведь главное то в Delphi - это ассемблер. :)
    Сообщение отредактировано: n0p -
      Несколько замечаний, относительно программирования таких программ..

      Так как код в MS-DOS ехе приложении, получает старт с $00000000 адреса, то и при переводе в 32-битную адресацию, данная модель сохраняеться, что дает возможность делать прямые вызовы функциональных прерываний DOS и BIOS, причем с передачей в них указателей (т.е не прибегая к специальным ф-кциям DPMI). Oднако это справедливо для небольших программ, поскольку смещения не должны превышать значений, больше $0000FFFF..

      Согласование сегментных регистров (cs/ds/es/etc..) и селекторов - целиком забота менеджера 'виртуальной машины' (например NTVDM в win2k/XP), поэтому, использование их, подобно тому как это делают 'чистые' 16-бит приложения, строго исключено - все таки, код, работает в защищенном, плоском режиме, в которых эти регистры ведут себя совсем по другому :)

      На выполнение обычно выделяеться стандартный, 1-MB диапазон памяти, которые включают физические участки, таких как Video BIOS, System BIOS и видеопамять. Для прямого доступа к ним, необходимо корректировать указатели, используя 6-ую функцию, DPMI прерывания (ака Get Segment Base Address).

      После перевода в PM, cтоит отметить, и такую замечательную особеность, как возможность отлаживать код, например расставляя int 1, в нужных участках и ловя его S-ICE (по bpint), в то время как в V86-ом (под все тем же 'дубовым' NTVDM) заставить его всплыть, в нужное время и в нужном месте - весьма проблематично..

      Приведу пример пары графических демок, в которых использование asm'a сведено до минимума, путем вынесения в отдельный модуль... :)

      ExpandedWrap disabled
        program Matrix; uses lowlevel;
         
        type
          VideoMem = array [0..65535] of byte;
         
         TCharInfo =  packed record
                AsciiChar:  char;
                Attributes: byte;
          end;  
         
         Tdata = packed record
             numtab:byte;
             startpos:byte;
          end;
         
        var
              SCR: ^VideoMem;
            ConCh: array [0..2000] of TCharInfo;
                d: array [0..80]   of Tdata;
         
        { генератор HEX символов из диапазона 0-F }
        function RandHexSymb:char; var i:integer;
        begin i  := $30 + random (16); if i >$39 then inc(i,7);
          result := char (i);
        end;
        {vertical one column render}
        procedure render_column (c : integer);
        var  i : integer;
        begin
          for i := 0 to 24 do
          begin
           SCR[(c*2)+ 2* i*80] := byte (ConCh[c +i*80].AsciiChar);
           SCR[(c*2)+1+2*i*80] := ConCh[c +i*80].Attributes;
         end;
        end;
        { поместить цвет и знак в массив TCharInfo char/color,char/color...}
        Procedure Peek_item(chr:char; color,i:integer);
        begin
         ConCh[i].Attributes := color; if chr <> #0 then ConCh[i].AsciiChar:= chr;
        end;
        { алгоритм типа 'питона' или стекающих цифр }
        procedure FlowTear (c: integer);  
        var y, i :word;
        begin  
         for y := 0 to 24 do
          begin
           i := c + (y*80);
        { нарисовать пробелы }
             if (d[c].startpos=0) and (y < d[c].numtab) then  
              begin   Peek_Item (' ', 2, i);
                  break;
              end;
        { общая масовка цифр следущая за концом }
             if d[c].startpos-d[c].numtab   = y  then  Peek_Item (RandHexSymb, 2, i);
        { прокладываем пробелы }
             if d[c].startpos+d[c].numtab-1 = y  then  Peek_Item (' ', $02, i);
        { подсвечиваем нижестоящий символ }
             if d[c].startpos+d[c].numtab   = y  then  Peek_Item (#0, 10, i);
        end; {y}
            render_column(c);
             if d[c].startpos - d[c].numtab <> 25 then inc(d[c].startpos) else
             if random (random(10)) = 2 then    
              begin
               d[c].numtab := 1+ random(14);  d[c].startpos:=0;
              end;
        end;
         
        {Matrix} var i :integer;
        begin
         {setup text mode}
           SetMode(3);  
         {get text screen ptr}
           SCR := GetFlatPtr ($0B8000);
         {clear garbage}
           for i := 0 to 25*80 do  ConCh[i].Attributes := 0;
         {do cycle loop}
        repeat
         {do process}
           for i := 0 to 79 do  FlowTear (i);
         {Make Delay}
           for i := 0 to $0fff do if key <> 0 then break;
        until key <> 0;
        end.



      ExpandedWrap disabled
        program burn; uses lowlevel;
         
         type  VideoMem = array [0..65535] of byte;
         
         var
            SCR:  ^VideoMem;
            VSCR: ^VideoMem;
            data: array[0..1023] of byte;
         
        Type
          ColorValue     = record
                             R, G, B : byte;
                           end;
         
        Procedure Hsi2Rgb(H, S, I : single; var C : ColorValue);
        {Convert (Hue, Saturation, Intensity) -> (RGB)}
        var
          T , Rv, Gv, Bv : single;
        begin
          T := H;
          Rv := 1 + S * Sin(T - 2 * Pi / 3);
          Gv := 1 + S * Sin(T);
          Bv := 1 + S * Sin(T + 2 * Pi / 3);
          T := 63.999 * I / 2;
          C.R := round(Rv * T);
          C.G := round(Gv * T);
          C.B := round(Bv * T);
        end; { Hsi2Rgb }
         
        Procedure MakePal(MaxColor:integer);
        Var
          I : Byte; C : ColorValue;
        begin
         For I:=0 To 255 do begin
          if i < MaxColor then  HSI2RGB(1*I/MaxColor,-1* I/MaxColor,I/MaxColor,C) else
            begin
               If C.R<63 Then Inc(C.R);
               If C.R<63 Then Inc(C.R);
               If (I Mod 2=0) And (C.G<53)  Then Inc(C.G);
               If (I Mod 2=0) And (C.B<63) Then Inc(C.B);
            end;
                data [i*3] := C.R;
                data [i*3+1] := C.G;
                data [i*3+2] := C.B;
        end;
        end;
         
         
        procedure PutPix (x, y : word; c : byte);
        var t : word; p:cardinal;
        begin
         t := y * 320 + x; VSCR [t] := c;
        end;
         
        function GetPix (x, y : word) : byte;
        var t : word; p:cardinal;
        begin
         t := y * 320 + x; Result := VSCR [t];
        end;
         
         
        const
         
          RootRand     =  20;  { Max/Min decrease of the root of the flames }
          Decay        = 4;    { How far should the flames go up on the screen? }
         
          Smooth       =   2;   { How descrete can the flames be?}
          MinFire      =  10;   { limit between the "starting to burn" and  the "is burning" routines }
          XStart       =  0;   { Startingpos on the screen }
          XEnd         = 320;   { Guess! }
         
          MinY         = 1;   { Startingline of the flame routine. }
          YEnd         = 199;
          Width        = XEnd-XStart; {Well- }
          FireIncrease =  53;  {3 = Wood, 90 = Gazolin}
          Power        =  1;
         
        var
            x, y, tmp : integer;
        begin
            SCR  := GetFlatPtr ($0A0000);
            VSCR := GetMem  (65535*2);
            SetMode ($13);
            MakePal (148);
            SetPal  (@data);
        {Initialize FlameArray}
        For x:=XStart To XEnd Do Data[x]:=Random(2)*255;
         
        while Key = 0 do
         begin
            { Put the values from FlameArray on the bottom line of the screen }
            For x:=XStart To XEnd Do  PutPix(x,YEnd, Data[x]);
            { This loop makes the actual flames }
            For x:=XStart To XEnd Do
            For y:=MinY To YEnd Do
            begin
              tmp:=Getpix(x,y);
              If (tmp=0) Or
                 (tmp<Decay) Or
                 (x<=XStart) Or
                 (x>=XEnd) Then
                Putpix(x,Pred(y),0)
              else
                Putpix(x-Pred(Random(3)),Pred(y),tmp-Random(Decay));
            end;
         
            If (Random(150)=1) Then
             For x:=XStart To XEnd Do
         
              if Random(2) > 0 then  Data[x]:= Random(255);
         
            For x:=XStart To XEnd Do
            begin
              tmp:=Data[x];
         
              If tmp<MinFire Then { Increase by the "burnability"}
              begin
                {Starting to burn:}
                If tmp>10 Then Inc(tmp,Random(FireIncrease));
              end
              else
              { Otherwise randomize and increase by intensity (is burning)}
                 Inc (tmp, Power + Random(RootRand*2+1)-RootRand );
              If tmp>255 Then tmp:=255; { tmp Too large ?}
              Data[x]:=tmp;
            end;
         
            For x:=XStart+Smooth To XEnd-Smooth Do
            begin
              tmp:=0;
              For y:=-Smooth To Smooth Do tmp:=tmp+Data[x+y];
              Data[x]:=tmp Div (2*Smooth+1);
            end;
         
           fpu_mem_copy (VSCR,SCR, 4096);
         
          end;{while}
                SetMode($3);
        end.



      ExpandedWrap disabled
        unit lowlevel;
         
        interface
         
        function  GetFlatPtr (value: integer): pointer;
        function  GetMem (val:integer):pointer;
         
        function  key:integer;
         
        procedure SetMode (ax:smallint);
        procedure SetPal  (val:pointer);
        function  fpu_mem_copy(src,dst:pointer;it:integer):pointer;
         
        implementation
         
        function GetFlatPtr (value: integer): pointer;
        asm
                 push eax
                 mov  ebx, ds      { BX = code segment selector    }
                 mov  ah,0; mov al,6 { DPMI (06) - Get Segment Base Address }
                 int  31h           { Return: CX:EDX linear address }
                 shrd eax,edx, 16   { move CX:DX                    }
                 shrd eax,ecx, 16   { to  EAX                       }
                 mov  edx, eax
                 pop  eax
                 sub  eax, edx
        end;
         
         
        function GetMem (val:integer):pointer; asm
                 mov  ecx, eax
                 shld ebx, ecx, 16
                 mov  ah,5; mov al,1 { DPMI (501) - Allocate Memory Block }
                 int  31h
                 shrd eax, ecx, 16  { move BX:CX }
                 shrd eax, ebx, 16  { to EAX     }
        end;
        (************ setup video ************)
        procedure SetMode (ax:smallint); asm  int 10h end;
         
        procedure SetPal(val:pointer);
        asm
                 pushad
                 mov  edx, eax
                 mov  ebx,0;
                 mov  ecx,255
                 mov  eax,1012h;
                 int  10h
                 popad
        end;
         
        (*********** check for pressed anykey **********)
        function key:integer; asm
             mov  ah,1;   int 16h
                 jnz  @@exit; xor eax,eax
        @@exit: end;
        (** copy memory blocks use FPU (from AgnerFog) **)
        function fpu_mem_copy(src,dst:pointer;it:integer):pointer;
        asm  @@Top:
                 fiLd  qword ptr [eax]; add eax, 8
                 fiLd  qword ptr [eax]; add eax, 8
                 fxch
                 fiStp qword ptr [edx]; add edx, 8
                 fiStp qword ptr [edx]; add edx, 8
                 loop @@top      
        end;
         
        end.

      Прикреплённый файлПрикреплённый файлarchive.zip (17.6 Кбайт, скачиваний: 133)
        p.s
        хм.. по всей видимости придеться думать относительно полной распаковки секций в особености BSS, так обнаружилась несколько глючная работа демки Matrix - иногда, некоторые столбцы почемуто не прорисовываються.. :\

        Доработка, кода
        ExpandedWrap disabled
          var
                SCR: ^VideoMem;
              ConCh: array [0..2000] of TCharInfo;
                  d: array [0..80]   of Tdata;


        До вида:
        ExpandedWrap disabled
          var
                SCR: ^VideoMem;
                  d: array [0..80]   of Tdata;
              ConCh: array [0..2000] of TCharInfo;

        устраняет эту проблему, вероятно из-за перераспределения данных... :wacko:
          Цитата Rouse_

          1. в какой раздел FAQ ты хочешь поместить это?

          Ну или сюда,
          Системные функции, WinAPI, работа с железом
          (Системные функции, WinAPI, работа с железом/ Работа с устройствами PC )

          или можно двинуть в "Наши исходники", поскольку сдаеться мне 'технология' несколько сыровата :)

          Цитата Rouse_

          2. какое практическое применение твоему коду можно найти?

          В первую очередь, проект задумывался в плане, альтернативного способа, исследовательской работы с железом, на более оперативном и безопасном уровне VDM, нежели в режиме ядра или 'виртуальных компов'. К тому же не меняя, своих предпочтений в выборе инструмента, IDE, (а то и разрядности CPU)..

          На базе 'PE-крякалки' можно, реализовать утилиты навроде 'Lord-Pe', оптимизирующие размер ЕХЕ, или исправляющих некорректные PE экземпляры...

          Добавлено
          p.s Думаю, в хозяйстве все пригодится.. А то из инструментов для компиляции, если приcмотреться, на выбор-то есть мало чего, да и на одном Win32, свет клином не сошелся...
            Может готовые EXE,DCU,.. выложишь?

            Добавлено
            Извянки... разобрался ;)

            Добавлено
            Вообщем это можно назвать PASCAL32
            вот если ты ещё сделаешь не под Консоль
            что бы можно было использовать всю мощь DELPHI(компоненты, формы,...)
            и ДОС (прерывания, порты ввода вывода и память)
            То это будет Visual Pascal++ 64bit (SUPPORT) :o
            ;)

            Добавлено
            А вот по поводу категори
            Паскаль 32
              Цитата Arazel

              вот если ты ещё сделаешь не под Консоль что бы можно было использовать всю
              мощь DELPHI(компоненты, формы,...)

              В первую очередь, чего хотелось бы избежать - это раздувание кода, поскольку в таких маленьких программах - на счету каждый байт. Поэтому с менеджером памяти, я пока особо не тороплюсь, так как оберточные реализации GetMem для тех же VirtualAlloc/HeapAlloc, довольно тяжеловаты..

              Програмирование в минимуме, помогает быстрее выявлять те или иные ошибки, а то и по другому пересмотреть код.

              В той же 'матрице', наверное куда уж проще наверно было сделать:
              ExpandedWrap disabled
                 var
                  startpos, numtab: array[0..80] of byte;
                  ConCh: array [0..2000] of TCharInfo;
                (cut...)
                procedure FlowTear (c: integer);  
                var  i :byte;
                begin  
                { проложить цифру за концом }
                 i:=startpos[c] - numtab[c];
                    if (i >= 0) and (i <= 25) then Peek_Item(RandHexSymb,2,c+i*80);
                { проложить пробел }
                 i:=startpos[c];
                    if (i >= 0) and (i <= 25) then Peek_Item(' ',$2,c+i*80);
                { подсветить нижестоящий символ }
                 inc(i);
                    if (i >= 0) and (i <= 25) then Peek_Item(#0,10,c+i*80);
                { вывести вертикаль }
                  render_column(c);
                    if startpos[c] - numtab[c] < 25 then inc(startpos[c])
                  else
                    begin
                         startpos[c]:=0;
                     if random (random(10)) = 2 then    
                      begin
                         numtab[c] := 1 + random(14);  
                      end;
                    end;
                end;


              Нежели в win32 оригинале, в котором использовалось 80 потоков (ну он, тогда ваялся на скорую руку, да ещё под 'новый год' :D)

              Цитата Arazel

              ДОС (прерывания, порты ввода вывода и память)

              ну в этом плане, ведуться некоторые наработки, относительно ядра защищенного режима =), и иже с ним автономных модулей. Поэтому особо тщательно приходиться вести всестороннее тестирование, ну и отлов багов... Например уже замеченый выше 'косяк', c распределением и расположением данных в статических массивах, (которые обычно находяться в секции BSS) как оказалось наблюдаеться и у версии для win32. :huh: Это конечно не повод, думать на 'кривоватость' Delphi компилятора, однако придеться теперь учитывать подобный фактор. :wacko:
                А как отлаживать программы? :o
                  Цитата Romtek

                  А как отлаживать программы?

                  Про всплытие 's-ice' под такими программами, я уже вышеупомянал, да и небольшие программы, в отладке, путем трассирования asm-кода нуждаються довольно редко, так так, зачастую, куда больше информации, дает диагноститечеcкий вывод на консольный/файловый вывод, сведений о состояний переменных, адресных указателей, etc... :wistle: что довольно легко организуеться даже в среде FreeDOS/MS-DOS :)
                    По поводу маленьких программ, есть кучу в сети исходников включая твой.

                    И сейчас технология растет как и компьютерные системы+++++
                    Расчитывая на самую большую мощь...
                    А потом скажим, а зачем нужена программа такая маленькая которая кроме
                    матрицы нечего не умеет (и которая все процессорное время забирает на себя)
                    при этом работая на низком уровне где нет многозадачности А зачем тогда Windows
                    А где красивый дизайн? в котором нуждаються все пользователи...

                    И здесь будет один вывод ЕСЛИ ПИШЕШЬ ПОД DOS так пиши в DOS(е)
                    Хочешь 32/64 разрядную систему счисления? Пиши на FreePascal..... (в многозадачном режиме)
                    И ещё лет через пять DOS вообще закроеться, и накрылась вся эта ИДЯ...
                    Нужно работать с аппаратной частью? Пиши драйвера А зачем они тогда нужны
                    если все передут на твой модуль?

                    ДААААаааааааааа ЛЮДИ РАСТУТ А ТЫ НАОБОРОТ... ;)
                      Размер кода важен в основном только при программировании микроконтроллеров. Остальное ненужная блаж...
                      user posted image
                      В русском языке есть слова, их там много.
                      Когда их составляешь вместе, получается предложение, где есть сказуемое, подлежащее и прочая светотень.
                      В нём переставь местоимение, сказуемое и подлежащее, и появится интонация!
                        Smike, сенкс! :)
                        Цитата _Rouse

                        Размер кода важен в основном только при программировании микроконтроллеров. Остальное ненужная блаж...

                        Согласен.. ровно как и 99.9% глючных программулин на том же дельфи :) постоянно отваливающихся на ходу с 'Run-time error', и абсолютно мне не нужных :lool:

                        Цитата Arazel

                        А потом скажим, а зачем нужена программа такая маленькая которая кроме матрицы нечего не умеет

                        С такимже успехом, можно сказать и про 3D игры. Зачем они нужны? - Они ничего не умеют (кроме как туманить моск).. Хотя заметь, - эта прога- малютка, матрицу непосредственно на экране вырисовывает, причём - самостоятельно... без всякой помощи.. Напрямую используя экран... А теперь представь, сколько системных вызовов потребуеться сделать в ntoskrnl.exe/hal.dll чтобы реализовать такую же возможность у Ring3 прог? ужос, причем неописуемый ужос (ИМХО).. Хотя вот думаю тоже над этим, правда в плане мэппирования в память LFB (Linear Frame Buffer).. С полным доступом к портам, вроде проблем нет :) поскольку NTVDMD.DLL легко апгрейдируеться на либу, с нужным функционалом :)

                        Цитата

                        (и которая все процессорное время забирает на себя)

                        Если в полноэкранном режиме, то все довольно нормально.. :) А так претензии и пожелания направляйте на адрес (с)микрософт :) которая весьма кривовато реализовала NTVDM.EXE (ну спасибо что хоть как то оно работает :) )..

                        Цитата Arazel

                        при этом работая на низком уровне где нет многозадачности

                        Строго говоря, на самом деле нет никакой многозадачности - только иллюзия :) Возможность работы с разными -окнами (под которой её зачастую подразумевают), хорошо сэмулированый трюк.. Хотя бывают случаи, когда в самом коде необходимо организовать несколько задач, потоков. Скажем для консольной 'матрицы' для Win32, их требуеться довольно приличное количество - 80штук.. А в DOS-программе, она легко эмулируеться.. Как говориться найдите пару отличий...


                        ExpandedWrap disabled
                          {$apptype console}
                          program Matrix; uses windows;
                           
                          var
                              hStdout : thandle;
                              ccInfo: TConsoleCursorInfo;
                              i, dwThreadId:dword;
                              startpos, numtab: array[0..80] of byte;
                              ConCh : array [0..2000] of TCharInfo;
                           
                          { Вертикальный рендер }
                          procedure render_column (column : integer);
                          var  co,co1: Tcoord; Rect:TSmallRect;
                          begin { нечто трудноописуемое из Win32api }
                            co.X:=80; co.Y:=25; co1.X:=column; co1.Y:=0;
                            Rect.Left  := column; Rect.Right := column;
                            Rect.Top := 0; Rect.Bottom := 24;
                            WriteConsoleOutput (hStdOut, @ConCh, co, co1, Rect);
                            Sleep(55);  
                          end;
                          { поместить цвет и знак в массив TCharInfo {char/color,char/color...}
                          Procedure Peek_item(chr:char; color,i:integer);
                          begin
                           ConCh[i].Attributes := color; if chr <> #0 then ConCh[i].AsciiChar:= chr;
                          end;
                          { генератор HEX символов из диапазона 0-F }
                          function RandHexSymb:char; var i:integer;
                          begin i  := $30 + random (16); if i >$39 then inc(i,7);
                            result := char (i);
                          end;
                          { Триада, алгоритм типа 'питона' или стекающих цифр }
                          procedure FlowTear (c: integer);  stdcall;
                          var  i :byte;
                          begin  
                          repeat
                          { проложить цифру за концом }
                           i:=startpos[c] - numtab[c];
                              if (i >= 0) and (i <= 25) then Peek_Item(RandHexSymb,2,c+i*80);
                          { проложить пробел }
                           i:=startpos[c];
                              if (i >= 0) and (i <= 25) then Peek_Item(' ',$2,c+i*80);
                          { подсветить нижестоящий символ }
                           inc(i);
                              if (i >= 0) and (i <= 25) then Peek_Item(#0,10,c+i*80);
                          { вывести вертикаль }
                            render_column(c);
                           
                              if startpos[c] - numtab[c] < 25 then inc(startpos[c])
                            else
                              begin
                                   startpos[c]:=0;
                               if random (random(10)) = 2 then    
                                begin
                                   numtab[c] := 1 + random(14);  
                                end;
                              end;
                           
                          until false;
                          end;
                           
                          { НАЧАЛО ПРОГИ }
                          begin  { получить хендл консольного вывода }
                             hStdOut := GetStdHandle(std_output_handle);
                          { Спрятать курсор }
                             GetConsoleCursorInfo (hStdOut, CCinfo);
                             ccinfo.bVisible := false;
                             SetConsoleCursorInfo (hStdOut, CCinfo);
                          { Запустить 80 зацикленыех потоков }
                          for i:=0 to 79 do  CreateThread(nil,0,@FlowTear,pointer(i),0,dwThreadId);
                          { Ждать нажатия enter для выхода }
                            Readln;
                          end.


                        Дос-вариант

                        ExpandedWrap disabled
                          program Matrix; uses lowlevel;
                          type
                            VideoMem = array [0..65535] of byte;
                           
                           TCharInfo =   record
                                  AsciiChar:  char;
                                  Attributes: word;
                            end;  
                           
                          var
                            SCR: ^VideoMem;
                            startpos, numtab: array[0..80] of byte;
                            ConCh: array [0..2000] of TCharInfo;
                           
                          { генератор HEX символов из диапазона 0-F }
                          function RandHexSymb:char; var i:integer;
                          begin i  := $30 + random (16); if i >$39 then inc(i,7);
                            result := char (i);
                          end;
                          {vertical one column render}
                          procedure render_column (c : integer);
                          var  i : integer;
                          begin
                            for i := 0 to 24 do
                            begin
                             SCR[(c*2)+ 2* i*80] := byte (ConCh[c +i*80].AsciiChar);
                             SCR[(c*2)+1+2*i*80] := ConCh[c +i*80].Attributes;
                           end;
                          end;
                          { поместить цвет и знак в массив TCharInfo char/color,char/color...}
                          Procedure Peek_item(chr:char; color,i:integer);
                          begin
                           ConCh[i].Attributes := color; if chr <> #0 then ConCh[i].AsciiChar:= chr;
                          end;
                          { алгоритм 'питона' или стекающих цифр }
                          procedure FlowTear (c: integer);  
                          var  i :byte;
                          begin  
                          { проложить цифру за концом }
                           i:=startpos[c] - numtab[c];
                              if (i >= 0) and (i <= 25) then Peek_Item(RandHexSymb,2,c+i*80);
                          { проложить пробел }
                           i:=startpos[c];
                              if (i >= 0) and (i <= 25) then Peek_Item(' ',$2,c+i*80);
                          { подсветить нижестоящий символ }
                           inc(i);
                              if (i >= 0) and (i <= 25) then Peek_Item(#0,10,c+i*80);
                          { вывести вертикаль }
                            render_column(c);
                           
                              if startpos[c] - numtab[c] < 25 then inc(startpos[c])
                            else
                              begin
                                   startpos[c]:=0;
                               if random (random(10)) = 2 then    
                                begin
                                   numtab[c] := 1 + random(14);  
                                end;
                              end;
                          end;
                           
                          {Matrix} var i :integer;
                          begin
                           {setup text mode}
                             SetMode(3);  
                           {get text screen ptr}
                             SCR := GetFlatPtr ($0B8000);
                           {clear garbage}
                             for i := 0 to 25*80 do  ConCh[i].Attributes := 2;
                           {do cycle loop}
                          repeat
                           {do process}
                             for i := 0 to 79 do  FlowTear (i);
                           {Make Delay}
                             for i := 0 to $1fff do if key <> 0 then break;
                          until key <> 0;
                          end.


                        Так что Господа, не надо 'ля-ля', DOS-проги это круто... Это 'Дью', на уровне 'Дзена'... И исключительно, для тех кто в теме :)
                        Сообщение отредактировано: n0p -
                          n0p
                          Я тебе ещё раз говорю, сейчас 21-век, а ДОС остался в 20-веке
                          По поводу Матрицы в Windows, которая загружает все такое…
                          На то оно и Матрица что бы работать в Windows без глюков…
                          Все что ты делаешь в DOS все это есть в Windows и кстати
                          Твоя DOS программа не кому не будет нужна!!!!!
                            n0p, Free Pascal компилирует и для ДОСа. Причём, без подобных извратов.
                              n0p За такой труд, тебя можно похвалить!!! ;)
                              Только вот не туда свой мозги напрягаешь... Лучше в сторону драйверов...
                              Сообщение отредактировано: Arazel -
                                А что, проблемы с драйверами? В данный момент, WDM-драйвер играет музычку. Другой сидит в системе, перехватив прерываниие, через которое мои маленькие проги, для DOS, обращаються в Ring0, за кой какой системной инфой.. Все так или иначе созданы при помощи дельфи..

                                Извини, приятель, но я не буду напрягать мозги, курением DDK доков от M$ для потуг "правельного программинга" этой тормозной системки :) Мну DOS-овские подходы рулят. По крайней мере работают быстрее, и зря воду не молотят.

                                А то вон-WDM уходил в 'синяк' , видимо его инженеры, руководствовались:
                                Цитата

                                Размер кода важен в основном только при программировании микроконтроллеров.

                                и должным образом не тестили, и даже не оптимизировали. пришлось урезать несколько 'левых' циклов, в Tasm-исходнике, полученом в IDA, и несколько процедур вынести в OPascal..

                                Так что, чуваг, на DELPHI, я БУДУ реализовывать любой бред который мне придет
                                в голову. :)

                                Но довольно флейма- вот еще один скринсейвер для старого доброго 320х200, который хаотично рисует круги, и при этом не прибегая к плавающей запятой...
                                ExpandedWrap disabled
                                  program Circle; uses lowlevel;
                                   
                                  type VideoMem = array[0..65535] of byte;
                                     var SCR:^VideoMem;
                                   
                                   
                                  procedure PutPix (x, y : word; c : byte);
                                  var t : word;
                                  begin
                                    t := y;
                                    y := y shl 8;
                                    t := t shl 6;
                                    t := t + y + x;
                                    SCR[t] := c;
                                  end;
                                   
                                   
                                  PROCEDURE Ellipse( xc, yc, a, b : Integer; c : Byte );
                                   
                                        PROCEDURE Plot4( xc, yc, xr, yr : integer; c : Byte );
                                          BEGIN
                                           PutPix( xc + xr, yc + yr, c );
                                           PutPix( xc + xr, yc - yr, c );
                                           PutPix( xc - xr, yc + yr, c );
                                           PutPix( xc - xr, yc - yr, c );
                                         END;
                                   
                                  VAR aSqr        : Integer;
                                      bSqr        : Integer;
                                      twoaSqr     : Integer;
                                      twobSqr     : Integer;
                                      X, Y        : Integer;
                                      twoXbSqr        : Integer;
                                      twoYaSqr        : Integer;
                                      error       : Integer;
                                  BEGIN
                                    aSqr := a * a;
                                    bSqr := b * b;
                                    twoaSqr := 2 * aSqr;
                                    twobSqr := 2 * bSqr;
                                    X := 0;
                                    Y := b;
                                    twoXbSqr := 0;
                                    twoYaSqr := Y * twoaSqr;
                                    error := -y * aSqr;
                                    WHILE twoXbSqr <= twoYaSqr DO
                                      BEGIN
                                        plot4( xc, yc, X, Y, c );
                                        Inc( X );
                                        Inc( twoXbSqr, twobSqr );
                                        Inc( error, twoXbSqr - bSqr );
                                        IF error >= 0 THEN
                                      BEGIN
                                        Dec( Y );
                                        Dec( twoYaSqr, twoaSqr );
                                        Dec( error, twoYaSqr )
                                      END;
                                      END;
                                    X := a;
                                    Y := 0;
                                    twoXbSqr := X * twobSqr;
                                    twoYaSqr := 0;
                                    error := -x * bSqr;
                                    WHILE twoXbSqr > twoYaSqr DO
                                      BEGIN
                                        plot4( xc, yc, X, Y, c );
                                        Inc( Y );
                                        Inc( twoYaSqr, twoaSqr );
                                        Inc( error, twoYaSqr - aSqr );
                                        IF error >= 0 THEN
                                      BEGIN
                                        Dec( X );
                                        Dec( twoXbSqr, twobSqr );
                                        Dec( error, twoXbSqr )
                                      END;
                                      END;
                                  END;
                                   
                                   
                                  var x,y : word;
                                    var i:integer;
                                   
                                  label quit;
                                   
                                  BEGIN
                                      SCR  := GetFlatPtr ($0A0000);
                                   
                                  SetMode($13);
                                   
                                   while Key = 0 do
                                    begin
                                    x:=Random (320);
                                     y:= Random(200);
                                   
                                  ellipse (x, y, 60 ,50 , random (255));
                                   
                                  for i := 0 to $fF do
                                  begin
                                     if key <> 0 then goto quit;
                                   end;
                                  end;{while}
                                  Quit:
                                  SetMode($3);
                                  end.
                                0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                                0 пользователей:


                                Рейтинг@Mail.ru
                                [ Script Execution time: 0,2235 ]   [ 16 queries used ]   [ Generated: 18.02.19, 00:10 GMT ]