home *** CD-ROM | disk | FTP | other *** search
/ M.u.C.S. Disc 2000 / MUCS2000.iso / falcon / m_analyz / source / bin_2_o.pas next >
Pascal/Delphi Source File  |  1995-01-15  |  2KB  |  88 lines
  1. program BinToO;
  2.  
  3. uses Tos;
  4.  
  5. var header:array[0..13] of word;
  6.     symbol:array[0..13] of byte;
  7.  
  8. procedure Error;
  9. begin
  10.     Writeln('Error');
  11.     ReadKey;
  12.     Halt;
  13. end;
  14.  
  15. procedure ToO(n,n2,lab:string);
  16. var    h,flen:longint;
  17.     buf:pointer;
  18.     i:integer;
  19. begin
  20.     Writeln(n);
  21.     h:=Fopen(n,FO_READ);
  22.     if h<0 then Error;
  23.     flen:=Fseek(0,h,2);
  24.     Fseek(0,h,0);
  25.     buf:=Malloc(4*(flen+3) div 4);
  26.     if buf=pointer(0) then Error;
  27.     if Fread(h,flen,buf)<flen then begin
  28.         Fclose(h);
  29.         Error;
  30.     end;
  31.     Fclose(h);
  32.  
  33.     flen:=((flen+3) div 4)*4;
  34.     header[0]:=$601a;
  35.     header[1]:=0;
  36.     header[2]:=0;
  37.     header[3]:=flen shr 16;
  38.     header[4]:=flen and $ffff;
  39.     header[5]:=0;
  40.     header[6]:=0;
  41.     header[7]:=0;
  42.     header[8]:=14;
  43.     header[9]:=0;
  44.     header[10]:=0;
  45.     header[11]:=0;
  46.     header[12]:=0;
  47.     header[13]:=0;
  48.  
  49.     h:=Fcreate(n2,0);
  50.     if h<0 then Error;
  51.     if Fwrite(h,28,@header[0])<28 then begin
  52.         Fclose(h);
  53.         Error;
  54.     end;
  55.     if Fwrite(h,flen,buf)<flen then begin
  56.         Fclose(h);
  57.         Error;
  58.     end;
  59.  
  60.     for i:=0 to 13 do
  61.         symbol[i]:=0;
  62.     if Ord(lab[0])<=8 then begin
  63.         for i:=0 to Ord(lab[0])-1 do
  64.             symbol[i]:=Ord(lab[i+1]);
  65.     end
  66.     else begin
  67.         for i:=0 to 7 do
  68.             symbol[i]:=Ord(lab[i+1]);
  69.     end;
  70.     symbol[8]:=$a4;
  71.     if Fwrite(h,14,@symbol[0])<14 then begin
  72.         Fclose(h);
  73.         Error;
  74.     end;
  75.     FillChar(buf^,flen,0);
  76.     if Fwrite(h,flen,buf)<flen then begin
  77.         Fclose(h);
  78.         Error;
  79.     end;
  80.     Fclose(h);
  81. end;
  82.  
  83. begin
  84.     ToO('MAINSCR.IMG', 'MAINSCR.O', 'mainscrdat');
  85.     ToO('ICONS.IMG', 'ICONS.O', 'iconsdat');
  86.     ToO('MOUSE.IMG', 'MOUSE.O', 'mousedat');
  87.     ToO('HELP.IMG', 'HELP.O', 'helpdat');
  88. end.