bin2inc.pas

世界著名病毒组织29a的一个病毒源码

program BIN2INC;

{$A+,B-,D+,E-,F-,G+,I-,L+,N+,O-,P-,Q-,R-,S-,T-,V+,X+}
{$M 16384,0,0}

uses Dos;

const
  DefEXT = '.INC';
  err_1 = 'Incompatible options';

function FStr(L : Longint) : String;
  var
    S : String;
  begin
    Str(L:0, S);
    FStr := S;
  end;

type

  Long = Longint;

const
  hexchar : array[0..15] of char = '0123456789ABCDEF';

function F(L : Long; Base,Len:Integer) : String;
  var
    i : integer;
    s : string;
    ch : char;
  begin
    s := '';
    repeat
      asm
        DB 66H; MOV AX, word ptr L
        DB 66H; XOR DX, DX
        DB 66H; XOR BX, BX
        MOV BX, base
        DB 66H; DIV BX
        DB 66H; MOV word ptr L, AX
        XCHG DX, BX
        MOV AL, byte ptr hexchar[BX]
        MOV &ch, AL
      end;
      s := ch + s;
      dec(len);
    until (len <= 0) and (l = 0);
    F := s;
  end;

function F_s(L : Long; Base,Len:Integer) : String;
  var
    i : integer;
    s : string;
    ch : char;
    c : string[1];
  begin
    s := '';
    c := '';
    if l < 0 then
    begin
      l := -l;
      c := '-';
    end;
    repeat
      asm
        DB 66H; MOV AX, word ptr L
        DB 66H; XOR DX, DX
        DB 66H; XOR BX, BX
        MOV BX, base
        DB 66H; DIV BX
        DB 66H; MOV word ptr L, AX
        XCHG DX, BX
        MOV AL, byte ptr hexchar[BX]
        MOV &ch, AL
      end;
      s := ch + s;
      dec(len);
    until (len <= 0) and (l = 0);
    F_s := c + s;
  end;

function HexByte(B: Byte) : String; begin HexByte := F(B,16, 2); end;
function HexWord(W: Word) : String; begin HexWord := F(W,16, 4); end;
function HexLong(L: Long) : String; begin HexLong := F(L,16, 8); end;

function DecByte(B: Longint) : String; begin DecByte := F(B,10, 0); end;
function DecWord(W: Longint) : String; begin DecWord := F(W,10, 0); end;
function DecLong(L: Long) : String; begin DecLong := F(L,10, 0); end;

function OctByte(B: Byte) : String; begin OctByte := F(B, 8, 0); end;
function OctWord(W: Word) : String; begin OctWord := F(W, 8, 0); end;
function OctLong(L: Long) : String; begin OctLong := F(L, 8, 0); end;

function BinByte(B: Byte) : String; begin BinByte := F(B, 2, 8); end;
function BinWord(W: Word) : String; begin BinWord := F(W, 2,16); end;
function BinLong(L: Long) : String; begin BinLong := F(L, 2,32); end;

procedure Error(ErrMsg : String);
  begin
    writeln(ErrMsg);
    Halt(1);
  end;

procedure STOP;
  begin
    Error('濃