home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / BINOBJ.ZIP / BINOBJU.PAS
Encoding:
Pascal/Delphi Source File  |  1989-01-12  |  3.5 KB  |  124 lines
  1. Unit BINOBJu;
  2.  
  3. {
  4.  
  5. This unit allows TP programs to emit .OBJ-files containing data
  6. in the same format as the BINOBJ.EXE utility does
  7.  
  8. Author: Per B. Larsen ; CIS:75470,1320
  9.  
  10. Extensive information on the internals of .OBJ-files can be found in
  11. any Programmers Reference Manual to MS-DOS
  12.  
  13. The unit works, but it could need better I/O-error checking and handling.
  14.  
  15. Feel free to modify and use.
  16.  
  17. }
  18.  
  19. {==========================================================================}
  20. Interface
  21. {$I-}
  22.  
  23. Procedure BINOBJ(Var Data;DataLen:Word;FileName:String;PublicName:String);
  24.  
  25. {==========================================================================}
  26. Implementation
  27.  
  28. Procedure BINOBJ(Var Data;DataLen:Word;FileName:String;PublicName:String);
  29. Const
  30.   TMOD:ARRAY[1..7] OF Byte =  ($80,$04,$00,$02,$3A,$3A,$06);
  31.   LNAM:ARRAY[1..11] OF Byte = ($96,$08,$00,$00,$04,$43,$4F,$44,$45,$00,$43);
  32.   SEGD:ARRAY[1..10] OF Byte = ($98,$07,$00,$28,$00,$00,$02,$01,$01,$00);
  33.   {                                            length-             Chk}
  34.   PUBD:ARRAY[1..5] OF Byte = ($90,$00,$00,$00,$01);     {+NAME+}
  35.   PUBT:ARRAY[1..3] OF Byte = ($00,$00,$00);             {+CHECKSUM}
  36.   LEDA:Byte=$A0;                                        {+RECLEN(Data+4)+}
  37.   LEDD:ARRAY[1..3] OF Byte = ($01,$00,$00);             {+Data+CHECKSUM}
  38.   MODE:ARRAY[1..5] OF Byte = ($8A,$02,$00,$00,$74);
  39. Var
  40.   UD:FILE;
  41.   I,REST,BLOCKS,DAOF,BYTES,RBYTES,FS:Word;
  42.   BUFFER:ARRAY[1..2048] OF Byte;
  43.   DATABUF:ARRAY[1..63,1..1024] OF Byte absolute Data;
  44.  
  45. Procedure CHECK(Var A;L:Word);
  46. Var
  47.   I,C:Word;
  48.   AR:ARRAY[1..2048] OF Byte absolute A;
  49. BEGIN
  50.   C:=0;
  51.   For I := 1 to PRED(L) do
  52.     C := (C AND $FF)+AR[I];
  53.   C := ($FF-(C AND $FF)+1) AND $FF;
  54.   AR[L] := C;
  55. END;
  56.  
  57. BEGIN
  58.   For I:=1 to length(PublicName) do
  59.     PublicName[I] := upcase(PublicName[I]);
  60.   FS:=DataLen;
  61.   For I:=1 to length(FileName) do
  62.     FileName[I]:=upcase(FileName[I]);
  63.   IF pos('.',FileName)=0 THEN
  64.     FileName:=FileName+'.OBJ';
  65.   Assign(UD,FileName);
  66.   ReWrite(UD,1);
  67.   IF ioresult<>0 THEN
  68.     BEGIN
  69.       WriteLn('Cannot create .OBJ-file');
  70.       Halt;
  71.     END;
  72.   Write('Writing ',FileName);
  73.   BLockWrite(UD,TMOD,sizeof(TMOD),BYTES);
  74.   BLockWrite(UD,LNAM,sizeof(LNAM),BYTES);
  75.   SEGD[5]:=lo(FS);
  76.   SEGD[6]:=hi(FS);
  77.   CHECK(SEGD,sizeof(SEGD));
  78.   BLockWrite(UD,SEGD,sizeof(SEGD),BYTES);
  79.   FS:=4+length(PublicName)+sizeof(PUBT);
  80.   PUBD[2]:=lo(FS);
  81.   PUBD[3]:=hi(FS);
  82.   Move(PUBD,BUFFER,sizeof(PUBD));
  83.   Move(PublicName,BUFFER[sizeof(PUBD)+1],length(PublicName)+1);
  84.   Move(PUBT,BUFFER[sizeof(PUBD)+length(PublicName)+2],3);
  85.   CHECK(BUFFER,sizeof(PUBD)+length(PublicName)+5);
  86.   DAOF:=0;
  87.   BLockWrite(UD,BUFFER,sizeof(PUBD)+length(PublicName)+5,BYTES);
  88.   BLOCKS := DataLen DIV 1024;
  89.   REST := DataLen MOD 1024;
  90.   IF REST<>0 THEN
  91.     Inc(BLOCKS)
  92.   ELSE
  93.     REST:=1024;
  94.   IF BLOCKS>63 THEN
  95.     BEGIN
  96.       WriteLn('Data buffer too large for BINOBJ');
  97.       Halt;
  98.     END;
  99.   For I := 1 to BLOCKS do
  100.     BEGIN
  101.       IF I=BLOCKS THEN
  102.         RBYTES:=REST
  103.       ELSE
  104.         RBYTES:=1024;
  105.       BUFFER[1]:=LEDA;
  106.       LEDD[2]:=lo(DAOF);
  107.       LEDD[3]:=hi(DAOF);
  108.       Move(LEDD,BUFFER[4],sizeof(LEDD));
  109.       Move(DATABUF[I,1],BUFFER[7],1024);
  110.       FS:=RBYTES+4;
  111.       BUFFER[2]:=lo(FS);
  112.       BUFFER[3]:=hi(FS);
  113.       CHECK(BUFFER,RBYTES+7);
  114.       BLockWrite(UD,BUFFER,RBYTES+7);
  115.       Inc(DAOF,RBYTES);
  116.       Write(DAOF:6,#8#8#8#8#8#8);
  117.     END;
  118.   WriteLn;
  119.   BLockWrite(UD,MODE,sizeof(MODE),BYTES);
  120.   Close(UD);
  121. END;
  122.  
  123. END.
  124.