DataMuseum.dk

top - download

    Length: 11032 (0x2b18)
    Types: TextFile
    Names: »FILES.PAS«

└─⟦02956c927⟧ Bits:30010510 DVBS1.SW2114.src.2.14-1 SW2114 REAL #1/4 TIME PASCAL SOURCE REL 2.14
    └─⟦this⟧ »RTP\FILES.PAS« 
└─⟦4f587ad96⟧ Bits:30010518 DVBS1.SW2114.src.2.7-1 SW2114 1/4 Real Time Pascal 2.7 92.06.16
    └─⟦this⟧ »RTP\FILES.PAS« 
└─⟦a2a9e188c⟧ Bits:30010526 DVBS1.SW2114.src.2.6-4 RTP Compiler Source SW2104+SW2114 Disk 1 92.02.03 HEJ HHA
    └─⟦this⟧ »RTP\FILES.PAS« 
└─⟦b607d6035⟧ Bits:30010532 RTP compiler Source 1 2.14 26/9(?)-92 DVBS1.SW2114.src.2.14-8
    └─⟦this⟧ »FILES.PAS« 
└─⟦fd2665794⟧ Bits:30010523 DVBS1.SW2114.src.2.6-1 RTP compiler source SW2104+SW2114 Disk#1 30/1-92 HHA
    └─⟦this⟧ »RTP\FILES.PAS« 

TextFile

unit files;\r
interface\r
uses pscplm;\r
{$F+}\r
var end_of_file:boolean;\r
    file_mark:longint;\r
    sourcedate : longint;\r
procedure change_ext(var s:string;ext:three_char);\r
\r
procedure init_files;\r
\r
procedure reset_file(var s:string;ext:three_char);\r
\r
procedure rewrite_file(var s:string;ext:three_char);\r
\r
procedure append_file(var s:string; ext:three_char);\r
\r
procedure files_abs_write(addr: longint; b:byte);\r
\r
procedure close_files;\r
\r
procedure delete_file(var s:string;ext:three_char);\r
\r
procedure put_byte(b:byte);\r
\r
procedure put_2_byte(w:word);\r
\r
procedure put_word(w:word);\r
\r
function get_byte:byte;\r
\r
function next_byte:byte;\r
\r
function get_2_byte:word;\r
\r
function get_word:word;\r
\r
function next_word:word;\r
\r
function get_line(var line: string):integer;\r
\r
procedure files_set_mark;\r
\r
procedure files_jump_start;\r
\r
procedure files_return_to_mark;\r
\r
function files_pos:longint;\r
\r
function files_read_pos:longint;\r
\r
procedure files_skip_to(addr:longint);\r
\r
Procedure SetSourceDate;\r
implementation\r
uses mpaunit,dos;\r
(* !!! TURBO !!! *)\r
(*const systemx = 15;\r
procedure fatal_error(s: integer; e: word);\r
begin end;\r
*)\r
type buf_page= array[0..1025] of byte;\r
     buf_page_ptr= ^buf_page;\r
\r
\r
     buf_index=record case integer of\r
                 0: (i,j: word);\r
                 1: (pw:  ^word);\r
                 2: (pb:  ^byte);\r
                 3: (buf: buf_page_ptr);\r
               end; \r
(*$I codes*)\r
\r
var \r
    udi_read_conn,udi_write_conn: file;\r
    udi_end_read:word;\r
    udi_end_write: word;\r
    udi_read_index, udi_write_index: buf_index;\r
    udi_read_start, udi_write_start: word;\r
    read_buffer, write_buffer: buf_page_ptr;\r
	write_addr,read_addr:longint;\r
\r
Procedure SetSourceDate;\r
  Begin\r
    GetFTime(udi_read_conn,SourceDate);\r
  end;\r
procedure change_ext(var s:string;ext:three_char);\r
var i,pos:integer;\r
begin\r
  pos:= length(s)+1;\r
  for i:=1 to length(s) do\r
    if s[i]='.' then pos:= i;\r
  delete(s, pos, 255);\r
  s:= concat(s, '.', ext);\r
(*  writeln('CHANGE extention: ',s);*)\r
end;\r
\r
procedure init_files;\r
begin\r
  new(read_buffer);\r
  udi_read_index.buf:=read_buffer;\r
  udi_read_index.j:=udi_read_index.j+udi_read_index.i div 16-1;\r
  udi_read_start:=udi_read_index.i mod 16+16;\r
  udi_read_index.i:=65535; (* 0FFFFH *)\r
  new(write_buffer);\r
  udi_write_index.buf:=write_buffer;\r
  udi_write_index.j:=udi_write_index.j+udi_write_index.i div 16;\r
  udi_write_start:=udi_write_index.i mod 16;\r
  udi_end_write:=udi_write_start+1022;\r
  udi_write_index.i:=65535; (* 0FFFFH *)\r
  end_of_file:=true;\r
  file_mark:=0;\r
end;\r
\r
function close_read_file:word;\r
begin\r
  if udi_read_index.i<>65535 (*0FFFFH*) then\r
  begin\r
    udi_read_index.i:=65535 (*0FFFFH*);\r
    end_of_file:=true;\r
    close(udi_read_conn);\r
  end;\r
  close_read_file:=0;\r
end;\r
\r
function close_write_file:word;\r
var exc,dump:word;\r
begin\r
  exc:=0;\r
  if udi_write_index.i<>65535 (*0FFFFH*) then\r
  begin\r
    dump:=udi_write_index.i-udi_write_start;\r
    if dump>0 then\r
    begin\r
      blockwrite(udi_write_conn,write_buffer^,dump,exc);\r
      exc := dump - exc;\r
    end;\r
    udi_write_index.i:=65535 (*0FFFFH*);\r
    if exc=0 then close(udi_write_conn);\r
  end;\r
  close_write_file:= exc;\r
end;\r
\r
procedure files_abs_write(addr:longint;b:byte);\r
var dump:word;\r
begin\r
  if udi_write_index.i<>65535 (*0FFFFH*) then\r
  begin\r
    dump:=udi_write_index.i-udi_write_start;\r
    if dump>0 then\r
      blockwrite(udi_write_conn,write_buffer^,dump);\r
    udi_write_index.i:=udi_write_start;\r
    close(udi_write_conn);\r
    filemode := 2;\r
    reset(udi_write_conn,1);\r
    filemode := 0;\r
  end;\r
  seek(udi_write_conn,addr);\r
  udi_write_index.pb^:=b;\r
  blockwrite(udi_write_conn,write_buffer^,1);\r
end;\r
\r
  \r
\r
procedure close_files;\r
var exc:word;\r
begin\r
  exc:=close_write_file;\r
  exc:=close_read_file;\r
end;\r
\r
procedure rewrite_file(var s:string;ext:three_char);\r
var exc:word;\r
begin\r
  if ext[1]<>'.' then change_ext(s,ext);\r
  exc:=close_write_file;\r
  assign(udi_write_conn,s);\r
  rewrite(udi_write_conn,1);\r
  udi_write_index.i:=udi_write_start;\r
  write_addr:=0;\r
end;\r
\r
procedure append_file(var s:string;ext:three_char);\r
var exc:word;\r
begin\r
  if ext[1]<>'.' then change_ext(s,ext);\r
  exc:=close_write_file;\r
  assign(udi_write_conn,s);\r
  rewrite(udi_write_conn,1);\r
  seek(udi_write_conn,filesize(udi_write_conn));\r
  udi_write_index.i:=udi_write_start;\r
end;\r
\r
(*b* )\r
procedure dump_buffer(l:word);\r
var i:integer;\r
    s:word;\r
begin\r
  s:=udi_read_index.i;\r
  for i:=0 to l-1 do write(chr(read_buffer^[i]));\r
  writeln('*');\r
  udi_read_index.i:=udi_read_start;\r
  for i:=0 to l-1 do begin\r
  write(chr(udi_read_index.pb^));\r
  udi_read_index.i:=udi_read_index.i+1;\r
  end;\r
  writeln('-');\r
  udi_read_index.i:=s;\r
end;\r
(**)\r
procedure reset_file(var s:string;ext:three_char);\r
var exc:word;\r
    i:integer;\r
begin\r
  if ext[1]<>'.' then change_ext(s,ext);\r
  exc:=close_read_file;\r
  assign(udi_read_conn,s);\r
  reset(udi_read_conn,1);\r
  udi_read_index.i:=udi_read_start;\r
  blockread(udi_read_conn,read_buffer^,1024,udi_end_read);\r
  read_buffer^[udi_end_read]:=10; (* lf *)\r
(*b* )  dump_buffer(udi_end_read+1); (**)\r
  end_of_file:=udi_end_read=0;\r
  udi_end_read:=udi_end_read+udi_read_start-1;\r
  read_addr:=0;\r
end;\r
\r
procedure delete_file(var s:string;ext:three_char);\r
var exc:word;\r
    help: file;\r
begin\r
  if ext[1]<>'.' then change_ext(s,ext);\r
    assign(help,s);\r
    erase(help);\r
end;\r
\r
procedure put_2_byte(w:word);\r
begin\r
  udi_write_index.pw^:= w;\r
  if udi_write_index.i>=udi_end_write then\r
  begin\r
    blockwrite(udi_write_conn,write_buffer^,1024);\r
	write_addr:=write_addr+1024;\r
    if udi_write_index.i>udi_end_write then\r
    begin\r
      write_buffer^[0]:=write_buffer^[1024];\r
      udi_write_index.i:=udi_write_start+1;\r
    end else udi_write_index.i:=udi_write_start;\r
  end else udi_write_index.i:=udi_write_index.i+2;\r
end;\r
\r
procedure put_word(w:word);\r
begin\r
  put_2_byte(w);\r
end;\r
\r
procedure put_byte(b:byte);\r
begin\r
    udi_write_index.pb^:= b;\r
    if udi_write_index.i>udi_end_write then\r
    begin\r
        blockwrite(udi_write_conn,write_buffer^,1024);\r
    	write_addr:=write_addr+1024;\r
        udi_write_index.i:=udi_write_start;\r
    end else udi_write_index.i:= succ(udi_write_index.i);\r
end;\r
\r
function get_byte:byte;\r
begin\r
    if udi_read_index.i>udi_end_read then\r
    begin\r
      read_addr:=read_addr+udi_end_read+1-udi_read_start;\r
      blockread(udi_read_conn,read_buffer^,1024,udi_end_read);\r
(*b* )      dump_buffer(udi_end_read); (**)\r
      udi_read_index.i:=udi_read_start;\r
      if udi_end_read=0 then begin\r
        get_byte:=ord(ceos);\r
        end_of_file:=true;\r
      end else begin\r
        get_byte:=udi_read_index.pb^;\r
        udi_read_index.i:=succ(udi_read_index.i);\r
      end;\r
      udi_end_read:= udi_end_read+udi_read_start-1;\r
    end else\r
    begin\r
      get_byte:=udi_read_index.pb^;\r
      udi_read_index.i:=succ(udi_read_index.i);\r
    end;\r
end;\r
\r
function next_byte:byte;\r
begin\r
    if udi_read_index.i>udi_end_read then\r
    begin\r
      read_addr:=read_addr+udi_end_read+1-udi_read_start;\r
      blockread(udi_read_conn,read_buffer^,1024,udi_end_read);\r
(*b* )      dump_buffer(udi_end_read); (**)\r
      udi_read_index.i:=udi_read_start;\r
      if udi_end_read=0 then begin\r
        next_byte:=ord(' ');\r
        end_of_file:=true;\r
      end else next_byte:=udi_read_index.pb^;\r
      udi_end_read:= udi_end_read+udi_read_start-1;\r
    end else next_byte:=udi_read_index.pb^;\r
end;\r
\r
function next_word:word;\r
begin\r
  next_word:=0;\r
end;\r
\r
function get_2_byte:word;\r
var exc:word;\r
     help: record case boolean of\r
            false: ( w: word);\r
            true:  (b0, b1: byte);\r
           end;\r
begin\r
    if udi_read_index.i>=udi_end_read then\r
    begin\r
        help.b0:=get_byte;\r
        help.b1:=get_byte;\r
        get_2_byte:=help.w;\r
    end else\r
    begin\r
        get_2_byte:=udi_read_index.pw^;\r
        udi_read_index.i:=udi_read_index.i+2;\r
    end;\r
end;\r
\r
function get_word: word;\r
begin\r
  get_word:=get_2_byte;\r
end;\r
\r
\r
\r
function get_line(var line:string):integer;\r
var exc:word;\r
    ch:char;\r
    length:integer;\r
    stop:boolean;\r
begin\r
  stop:=false;\r
  length := 0;\r
  repeat\r
   ch := chr(Get_Byte);\r
   if end_of_file THEN stop := true\r
   else\r
   if (ch>' ') and (ch<chr(127)) (* del *) then\r
    begin\r
      if length<254 then begin (* space for space *)\r
        length:=length+1;\r
        line[length]:=ch;\r
      end;\r
     end\r
   ELSE\r
    BEGIN\r
      if ord(ch) = 10 then\r
        stop := true\r
      else\r
      if (ord(ch) <> 13) THEN\r
      BEGIN\r
        if (ord(ch) = 25) or (ord(ch) = 26) THEN\r
          BEGIN\r
            repeat ch:=chr(get_byte); until end_of_file;\r
            stop := true;\r
          END\r
        else\r
          BEGIN\r
            if (length<254) and (length <> 0) then begin (* space for space *)\r
            length:=length+1;\r
            line[length]:=' ';\r
            end\r
          END;\r
      END;\r
\r
    END;\r
\r
\r
\r
\r
  until stop;\r
  length:=length+1;\r
  line[length]:=' ';\r
  get_line:=length;\r
end;\r
\r
procedure files_set_mark;\r
begin\r
  file_mark:=write_addr+udi_write_index.i-udi_write_start;\r
end;\r
\r
procedure files_jump_start;\r
begin\r
  file_mark:=read_addr+udi_read_index.i-udi_read_start;\r
  seek(udi_read_conn,0);\r
  blockread(udi_read_conn,read_buffer^,1024,udi_end_read);\r
(*b* )  dump_buffer(udi_end_read); (**)\r
  read_buffer^[udi_end_read]:=10; (* lf *)\r
  end_of_file:=udi_end_read=0;\r
  udi_end_read:=udi_end_read+udi_read_start-1;\r
  udi_read_index.i:=udi_read_start;\r
  read_addr:=0;\r
end;\r
\r
procedure files_return_to_mark;\r
var\r
    file_mark_rest: integer;\r
begin\r
  file_mark_rest:= file_mark mod 128;\r
  file_mark:= file_mark - file_mark_rest;\r
  seek(udi_read_conn,file_mark);\r
  blockread(udi_read_conn,read_buffer^,1024,udi_end_read);\r
  if file_mark_rest > udi_end_read then file_mark_rest:= udi_end_read;\r
(*b* )  dump_buffer(udi_end_read); (**)\r
  read_buffer^[udi_end_read]:=10; (* lf *)\r
  end_of_file:=udi_end_read=file_mark_rest;\r
  udi_end_read:=udi_end_read+udi_read_start-1;\r
  udi_read_index.i:=udi_read_start+file_mark_rest;\r
  read_addr:=file_mark;\r
end;\r
\r
function files_pos:longint;\r
begin\r
  files_pos:=write_addr+udi_write_index.i-udi_write_start;\r
end;\r
\r
function files_read_pos:longint;\r
begin\r
  files_read_pos:=read_addr+udi_read_index.i-udi_read_start;\r
end;\r
\r
procedure files_skip_to(addr:longint);\r
var\r
    addr_rest: integer;\r
begin\r
  addr_rest:= addr mod 128;\r
  addr:= addr - addr_rest;\r
  seek(udi_read_conn,addr);\r
  blockread(udi_read_conn,read_buffer^,1024,udi_end_read);\r
  if addr_rest>udi_end_read then addr_rest:=udi_end_read;\r
(*b* )  dump_buffer(udi_end_read); (**)\r
  read_buffer^[udi_end_read]:=10; (* lf *)\r
  end_of_file:=udi_end_read=addr_rest;\r
  udi_end_read:=udi_end_read+udi_read_start-1;\r
  udi_read_index.i:=udi_read_start+addr_rest;\r
  read_addr:=addr;\r
end;\r
end.\r
«eof»