Monster Media 1994 #1/monster.zip/monster/PROG_PAS/XLIB_TP5.ZIP/UNITS/X_FILEIO.PAS

Pascal/Delphi Source File | 1994-01-14 | 10KB | 377 lines

Unit X_FileIO;

(*
    File procedures.

    ****** XLIB - Mode X graphics library                ****************
    ******                                               ****************
    ****** Converted By Christian Harms in TP            ****************

    Harms   : [e-mail]


    These function are uses by all file load/save-functions of XLib.

    If you have many files ( for example PBM's), you can "copy" all to
    one big file (Masterfile) - ( with help of Make_MF ).

    After Init_Masterfile, all procedures search firstly, if the file
    present in MasterFile. If true, file-variable will set to MasterFile
    and Masterfile-position set to begin of file. If not Masterfile
    activated, this functions are normaly filefunction.

    Because var MasterFile:File, you can only Read with BlockRead !


    MasterFile structure :

    Word    :  Count of Files
    Index_1 :  Filename1 : String : 1. Byte         : length n
                                    2. .. n+1. Byte : Filename
                           Start  : DWord           : absolute Startposition
                                                      of File1 in MasterFile
                           Size   : DWord           : Filesize of File1

       ""
    Index_Count

    File_1     - Data
       ""
    File_Count - Data

    Demo of creating MasterFile - look in Make_MF.pas oder Make_MF.EXE.

*)


interface

(* result = 0, if Name not exist, else Size in Bytes. MasterFile supported.*)
function  F_Size(Name:String):LongInt;

(* Open an File for Read. True,if opens.              MasterFile supported.*)
function  F_Open_Read(var F:File;Name:String):Boolean;

(* Open an File for Write.                                                 *)
procedure F_Open_Write(var F:File;Name:String);

(* Close an File.                                     MasterFile supported.*)
procedure F_Close(var F:File);
procedure Close(var F:File); (* security definition *)

(* Make on every Char of S an Uppercase.                                   *)
function  Upper(S:String):String;

(* Delete and Add, if incorrect or non Ext in FileName S.                  *)
function  Only_one_Ext(S:String;Ext:String):String;

(* Open MasterFile and load Filelist.                                      *)
function  Init_MasterFile(Name:String):Boolean;

(* Close MasterFile, all function are now normal file-functions.           *)
procedure Close_MasterFile;

(* If you dont know, how to read from F:File with BlockRead, use these     *)
(* functions.                                                              *)
function  Read_Byte(var F:File):Byte;          (* Read a Byte              *)
function  Read_Word(var F:File):Word;          (* Read a Word    (2 Bytes) *)
function  Read_LongInt(var F:File):LongInt;    (* Read a LongInt (4 Bytes) *)
function  Read_Line(var F:File):String;        (* Read a String  (S[0]...) *)
function  Read_String(var F:File):String;      (* Read a Line (Textfile)   *)
procedure Write_Text(Var F:File;S:String);     (* Write a String as text   *)
procedure Write_Line(Var F:File;S:String);     (* Write Text with CR       *)

(* Only for creating own Masterfile - demo in Make_MF *)
procedure Init_File_List;
function  Add_File_List(Name:String):Boolean;
procedure Kill_File_List;
function  Get_File_item_count:Word;
procedure Make_MasterFile(Name:String);

implementation

uses crt;

function Read_Byte(var F:File):Byte;
var B:Byte;
begin;
  BlockRead(F,B,1);
  Read_Byte:=B;
end;

function Read_Word(var F:File):Word;
var w:Word;
begin;
  BlockRead(F,w,2);
  Read_Word:=w;
end;

function Read_LongInt(var F:File):LongInt;
var i:LongInt;
begin;
  BlockRead(F,i,4);
  Read_LongInt:=i;
end;

function Read_Line(var F:File):String;
var C:Char;
    S:String;
begin;
  c:=#0;
  S:='';
  while (not eof(F))and(c<>#10) do
  begin;
    BlockRead(F,c,1);
    if not (C in [#10,#13]) then S:=S+c;
  end;
  Read_Line:=S;
end;

function Read_String(var F:File):String;
var S:String;
begin;
  BlockRead(F,S[0],1);
  BlockRead(f,S[1],length(S));
  Read_String:=S;
end;

procedure Write_Text(Var F:File;S:String);
begin;
  BlockWrite(F,s[1],length(s));
end;

procedure Write_Line(Var F:File;S:String);
begin;
  Write_Text(F,S+#13#10);
end;

const MaxIndex  = 1024;
type
     Index      = record
          Name  : ^String;
          Start : LongInt;
          Size  : LongInt;
     end;
     ListP      = Array[0..1024] of Index;
var  Name_Count : Word;
     List       : ^ListP;
     MF_File    : File;

function GetIndex(Name:String):Word;
var I:Word;
begin;
  if (List=NIL)or(List^[0].Size=MaxIndex) then begin;GetIndex:=0;exit;end;
  Name:=Upper(Name);
  i:=1;
  while (i<=Name_Count)and(List^[i].Name^<>Name) do Inc(i);

  if List^[i].Name^=Name then GetIndex:=i
                         else GetIndex:=0;
end;

function F_Size(Name:String):LongInt;
var F:File;
    i:Word;
begin;
  i:=GetIndex(Name);                 (* MasterFile Handling *)
  if i>0 then F_Size:=List^[i].Size
         else begin;
                Assign(F,Name);      (* Normal File Handling *)
                {$I-}
                Reset(F,1);
                {$I+}
                if IOResult=0 then begin;
                                     F_Size:=FileSize(F);
                                     System.Close(F);
                                   end
                              else F_Size:=0;
              end;
end;

function F_Open_Read(var F:File;Name:String):Boolean;
var I:Word;
begin;
  I:=GetIndex(Name);                 (* MasterFile Handling *)
  if i>0 then begin;
                move(MF_File,F,sizeof(F));
                Seek(F,List^[i].Start);
                end
         else begin;                 (* Normal File Handling *)
                Assign(F,Name);
                {$I-}
                Reset(F,1);
                {$I+}
                if IOResult=0 then F_Open_Read:=True
                              else F_Open_Read:=False;
              end;
end;

procedure F_Open_Write(var F:File;Name:String);
begin;
  Assign(F,Name);
  Rewrite(F,1);
end;

procedure F_Close(var F:File);
begin;
  if (List=NIL)or
     (List^[0].Size=MaxIndex) or
     (MEMW[seg(F):ofs(F)]<>MEMW[seg(MF_File):ofs(MF_File)])
        then System.Close(F)
        {else begin;sound(500);delay(100);nosound;end};
end;

procedure Close(var F:File);
begin;
  F_Close(f);
end;

function Upper(S:String):String;
var I:Byte;
begin;
  for i:=1 to Length(S) do S[i]:=Upcase(S[i]);
  Upper:=S;
end;


function Only_one_Ext(S:String;Ext:String):String;
var i:Byte;
begin;
  S:=Upper(S);

  if (pos('.'+Ext,S)<>length(S)-length(Ext)) or
     (pos('.',S)<>length(S)-4)                    then
      while (Pos('.',S)>0) do S:=copy(S,1,pos('.',S)-1);

  S:=S+'.'+Ext;
  Only_one_Ext:=S;
end;

(* Open MasterFile and load Filelist.                                      *)
function Init_MasterFile(Name:String):Boolean;
var I,J : LongInt;
    S   : String;
begin;
  Assign(MF_File,Name);
  {$I-}Reset(MF_File,1);{$I+}
  if (IOResult<>0)or(List<>NIL) then begin;Init_MasterFile:=False;exit;end;

  Name_Count:=Read_Word(MF_File);
  if Name_Count>=MaxIndex then Name_Count:=MaxIndex-1;

  GetMEM(List,(Name_Count+1)*SizeOf(Index));

  (* 0. Index.Size<1024 - init here, =1024 - init by Init_File_List *)
  List^[0].Size:=Name_Count;

  for i:=1 to Name_Count do
  begin;
    S:=Read_String(MF_File);
    GetMEM(List^[i].Name,length(s)+1);
    List^[i].Name^:=Upper(S);
    List^[i].Start:=Read_LongInt(MF_File);
    List^[i].Size :=Read_LongInt(MF_File);
  end;
end;


(* Close MasterFile, all function are now normal file-functions.           *)
procedure Close_MasterFile;
var I:Word;
begin;
  if Name_Count>0 then
  begin;
    for i:=1 to Name_Count do FreeMEM(List^[i].Name,length(List^[i].Name^)+1);
    FreeMEM(List,(Name_Count+1)*SizeOf(Index));
    List:=NIL;
    System.Close(MF_File);
  end;
  Name_Count:=0;
end;

procedure Init_File_List;
begin;
  New(List);
  List^[0].Size:=MaxIndex;
  Name_Count:=0;
end;

(* false, if init by Init_MastFile and not by Init_FileList *)
function Add_File_List(Name:String):Boolean;
var i:LongInt;
begin;
  i:=F_Size(Name);
  if (i=0)or(Name_Count=MaxIndex-1) then begin;Add_File_List:=false;exit;end;

  Inc(Name_Count);
  GetMEM(List^[Name_Count].Name,length(Name)+1);
  List^[Name_Count].Name^:=Name;
  List^[Name_Count].Start:=0;
  List^[Name_Count].Size :=i;
end;

procedure Kill_File_List;
var i:Word;
begin;
  for i:=1 to Name_Count do FreeMEM(List^[i].Name,sizeof(List^[i].Name^)+1);
  Dispose(List);
end;

function Get_File_item_count:Word;
begin;
  Get_File_item_count:=Name_Count;
end;

procedure Make_MasterFile(Name:String);
var i:Word;
    Count:LongInt;
    F,F1:File;
    Buffer:Array[0..1023] of Byte;
    T1,T2:LongInt;
begin;
  F_Open_Write(F,Name);

  Count:=2;                                 (* Name_Count *)

  for i:=1 to Name_Count do
      Inc(Count,length(List^[i].Name^)+1);  (* + length(All_Names) *)

  Count:=Count+8*Name_Count;                (* + All_Starts + All_Size *)

  BlockWrite(F,Name_Count,2);

  for i:=1 to Name_Count do           (* Write File_List               *)
  begin;
    BlockWrite(F,List^[i].Name^[0],length(List^[i].Name^)+1);
    BlockWrite(F,Count,4);
    BlockWrite(F,List^[i].Size,4);
    Inc(Count,List^[i].Size);
  end;

  for i:=1 to Name_Count do           (* Write Files                   *)
  begin;
    if F_Open_Read(F1,List^[i].Name^) then
    begin;
      T1:=List^[i].Size;
      while T1>1024 do begin;
                         BlockRead(F1,Buffer,1024);
                         BlockWrite(F,Buffer,1024);
                         Dec(T1,1024);
                       end;
      BlockRead(F1,Buffer,T1);
      BlockWrite(F,Buffer,T1);
      Close(F1);
    end;
  end;

  Close(F);
end;





begin;
  Name_Count:=0;
  List:=NIL;
end.