home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 2 / crawlyvol2.bin / program / misc / isam / fixfiles.i < prev    next >
Encoding:
Modula Implementation  |  1991-11-22  |  9.8 KB  |  340 lines
  1. IMPLEMENTATION MODULE FixFiles;
  2.  
  3. (*                             Von Michael H.                               *)
  4. (*  portiert nach M-2 August '91 von Christian Felsch und Peter Oleski.     *)       
  5. (*  Diese ISAM ist Public Domain und darf von jedem für zivile Aufgaben     *)
  6. (*  benutzt werden. Eine Nutzung für militärische Zwecke ist untersagt !    *)
  7. (*                         Diese ISAM ist Peace-Ware !                      *)
  8. (*                         ---------------------------                      *)
  9. (*  Diese ISAM darf verändert und erweitert werden. Bei guten Erweiterungen *)
  10. (*  und Fehlern benachrichtigung bitte an uns senden.                       *)
  11. (*  Die ISAM hat unsere Platte NICHT zerstört aber wir übernehmen keine     *)
  12. (*  Verantwortung für nichts.                                               *)
  13. (*  Wir bitten aber, falls diese ISAM einmal eine Verwendung findet, uns    *)
  14. (*  mit dem Satz ' ISAM by Jau-Team ' zu erwähnen.                          *)
  15. (*  Wird mit dieser Bibliothek ein kommerzielles Programm erstellt, so ist  *)
  16. (*  uns ein kostenloses Exemplar zuzusenden                                 *)
  17. (*  Zu erreichen unter:                                                     *)
  18. (*                                                                          *)
  19. (*      E-Mail: Peter Oleski        oder   Christian Felsch @ HH (MausNet)  *)
  20. (*  gelbe Post: Eißendorfergrenzweg 83a     Bevenser Weg 18                 *)
  21. (*                             2100 Hamburg 90                              *)
  22.  
  23.  
  24.  
  25.  FROM IsamGlobals IMPORT MaxDataRecSize, MinDataRecSize, RecTooSmallError, 
  26.                          RecTooLargeError, RecSizeMismatchError, ErrorCode,
  27.                          FixFile, TaRecBuf, True, False,
  28.                          PutHeader, FileUpdated, CreateHeader,
  29.                          ReadHeader, CloseInternFile, Move;
  30.  FROM Files       IMPORT Create, Open, ReplaceMode, Access, Flush, State, 
  31.                          Close, GetFileName;
  32.  FROM Binary      IMPORT WriteBytes, ReadBytes, Seek, SeekMode;
  33.  FROM SYSTEM      IMPORT LOC, CAST, ADR, TSIZE;
  34.  FROM Storage     IMPORT ALLOCATE, DEALLOCATE;
  35.  FROM MOSGlobals  IMPORT fCRCError, fInvalidHandle;
  36.  FROM Directory   IMPORT Delete, Rename;  
  37.  FROM Block       IMPORT Clear;
  38.  
  39.  
  40.  TYPE FileStack = POINTER TO FileEntry;
  41.       FileEntry = RECORD 
  42.                    Vorg    : FileStack;
  43.                    DateiPtr: POINTER TO FixFile;
  44.                   END(*RECORD*);
  45.                   
  46.  
  47.  VAR  DateiStapel: FileStack;
  48.  
  49.  
  50.  PROCEDURE FixFlush(VAR Datei: FixFile);
  51.  
  52.   BEGIN 
  53.    Datei.Integritaet := True;
  54.    PutHeader(Datei);
  55.    IF (ErrorCode = 0) THEN 
  56.     Flush(Datei.DosDatei);
  57.    END(*IF*); 
  58.   END FixFlush;
  59.  
  60.  
  61.  PROCEDURE FixGet(VAR Datei : FixFile;      SatzNr  : LONGINT;
  62.                   VAR Buffer: ARRAY OF LOC; Anz     : CARDINAL);
  63.   VAR d : LONGCARD;
  64.        
  65.   BEGIN
  66.    Seek(Datei.DosDatei, LONGINT(LONG(Datei.ItemSize)) * SatzNr,fromBegin);
  67.    ErrorCode := State(Datei.DosDatei);
  68.    IF (ErrorCode = 0) THEN 
  69.     ReadBytes(Datei.DosDatei, ADR(Buffer), Anz * Datei.ItemSize,d);
  70.     ErrorCode := State(Datei.DosDatei);
  71.    END(*IF*);
  72.   END FixGet;
  73.  
  74.  
  75.  PROCEDURE FixPut(VAR Datei : FixFile; SatzNr   : LONGINT;
  76.                   VAR Buffer: ARRAY OF LOC);
  77.  
  78.   BEGIN 
  79.    Seek(Datei.DosDatei,LONGINT(LONG(Datei.ItemSize)) * SatzNr,fromBegin);
  80.    ErrorCode := State(Datei.DosDatei);
  81.    IF ErrorCode = 0 THEN 
  82.     WriteBytes(Datei.DosDatei,ADR( Buffer), Datei.ItemSize);
  83.     ErrorCode:= State(Datei.DosDatei) ; 
  84.     IF ErrorCode = 0 THEN 
  85.      FileUpdated(Datei);
  86.     END(*IF*);
  87.    END(*IF*);
  88.   END FixPut; 
  89.  
  90.  
  91.  PROCEDURE FixMake(VAR Datei : FixFile;  FName      : ARRAY OF CHAR;
  92.                        RecLen: CARDINAL; ZaehlStart : CARDINAL);
  93.  
  94.   VAR DateiPtr : FileStack; 
  95.  
  96.   BEGIN 
  97.    ErrorCode := 0;
  98.    IF (RecLen > MaxDataRecSize) THEN 
  99.     ErrorCode := RecTooLargeError;
  100.    END(*IF*);
  101.    IF (RecLen < MinDataRecSize) THEN 
  102.     ErrorCode := RecTooSmallError;
  103.    END(*IF*);
  104.    IF (ErrorCode # 0) THEN 
  105.     RETURN;
  106.    END(*IF*);
  107.    Clear(ADR(Datei),SIZE(Datei));
  108.    Create(Datei.DosDatei,FName,readWrite,noReplace);
  109.    ErrorCode := State(Datei.DosDatei);
  110.    IF (ErrorCode # 0) THEN                      
  111.     RETURN;
  112.    END(*IF*);
  113.    CreateHeader(Datei, RecLen, ZaehlStart);      (* Datei-Parameter-Satzes *)
  114.    IF (ErrorCode # 0) THEN 
  115.     Close(Datei.DosDatei);
  116.     RETURN;
  117.    END(*IF*);                                  (* Datei in die Datei-Liste *)
  118.    NEW(DateiPtr);
  119.    DateiPtr^.Vorg := DateiStapel;
  120.    DateiPtr^.DateiPtr := ADR(Datei);
  121.    DateiStapel := DateiPtr;
  122.   END FixMake; 
  123.  
  124.  
  125.  PROCEDURE FixRecSize(DateiName : ARRAY OF CHAR) : LONGINT;
  126.   VAR Datei : FixFile;
  127.  
  128.   BEGIN 
  129.    Clear(ADR(Datei),SIZE(Datei));
  130.    Open(Datei.DosDatei,DateiName,readWrite);
  131.    ErrorCode := State(Datei.DosDatei);
  132.    IF (ErrorCode # 0) THEN 
  133.     RETURN -1;
  134.    END(*IF*);
  135.    ReadHeader(Datei, 0);                   (* Einlesen der Datei-Parameter *)
  136.    IF (ErrorCode = 0) THEN 
  137.     RETURN Datei.ItemSize;
  138.    END(*IF*);
  139.    Close(Datei.DosDatei);
  140.   END FixRecSize;
  141.   
  142.  
  143.  PROCEDURE FixOpen(VAR Datei   : FixFile;  FName   : ARRAY OF CHAR;
  144.                        RecLen  : CARDINAL; MaxCount: CARDINAL);
  145.  
  146.   VAR DateiPtr : FileStack; 
  147.  
  148.   BEGIN 
  149.    ErrorCode := 0;
  150.    IF (RecLen > MaxDataRecSize) THEN 
  151.     ErrorCode := RecTooLargeError;
  152.    END(*IF*);
  153.    IF (RecLen < MinDataRecSize) THEN 
  154.     ErrorCode := RecTooSmallError;
  155.    END(*IF*);
  156.    IF (ErrorCode # 0) THEN 
  157.     RETURN;
  158.    END(*IF*);
  159.    Clear(ADR(Datei),SIZE(Datei));
  160.    Open(Datei.DosDatei,FName,readWrite);
  161.    ErrorCode := State(Datei.DosDatei);
  162.    IF (ErrorCode # 0) THEN 
  163.     RETURN;
  164.    END(*IF*);
  165.    ReadHeader(Datei, MaxCount);             (* Einlesen der Datei-Parameter *)
  166.    IF (ErrorCode # 0) THEN
  167.     RETURN;
  168.    END(*IF*);
  169.    IF (RecLen # Datei.ItemSize) THEN 
  170.     Close(Datei.DosDatei);
  171.     ErrorCode := RecSizeMismatchError;
  172.     RETURN;
  173.    END(*IF*);
  174.    IF (Datei.Integritaet # True) THEN         (* Wurde Datei nicht geschlossen? *)
  175.     ErrorCode := fCRCError;
  176.    END(*IF*);
  177.    NEW(DateiPtr);                                (* Datei in die Dateiliste *)
  178.    DateiPtr^.Vorg := DateiStapel;
  179.    DateiPtr^.DateiPtr := ADR(Datei);
  180.    DateiStapel := DateiPtr;
  181.   END FixOpen; 
  182.  
  183.  
  184.  PROCEDURE FixClose(VAR Datei: FixFile);
  185.   VAR NachfPtr, 
  186.       StapelPtr: FileStack;
  187.  
  188.   BEGIN
  189.    NachfPtr := NIL; 
  190.    StapelPtr := DateiStapel;
  191.    WHILE (StapelPtr # NIL) AND (StapelPtr^.DateiPtr # ADR(Datei)) DO 
  192.     NachfPtr := StapelPtr;
  193.     StapelPtr := StapelPtr^.Vorg;
  194.    END;
  195.    IF (StapelPtr # NIL) AND (StapelPtr^.DateiPtr = ADR(Datei)) THEN
  196.     IF (NachfPtr # NIL) THEN 
  197.      NachfPtr^.Vorg := StapelPtr^.Vorg
  198.     ELSE 
  199.      DateiStapel := StapelPtr^.Vorg;
  200.     END(*IF*);
  201.     DEALLOCATE(StapelPtr,0);
  202.     CloseInternFile(Datei);
  203.    ELSE 
  204.     ErrorCode := fInvalidHandle;
  205.     (*Write(CHR(7));*)
  206.    END(*IF*);
  207.   END FixClose;
  208.  
  209.  
  210.  PROCEDURE FixErase(VAR Datei : FixFile);
  211.   VAR name: ARRAY [0..137] OF CHAR;
  212.   
  213.   BEGIN
  214.    GetFileName(Datei.DosDatei,name);           (* Dateiname für Delete merken *)
  215.    FixClose(Datei);
  216.    IF (ErrorCode # 0) THEN 
  217.     RETURN;
  218.    END(*IF*);
  219.    Delete(name,ErrorCode);
  220.   END FixErase; 
  221.  
  222.  
  223.  PROCEDURE FixRename(VAR Datei : FixFile; fNeu: ARRAY OF CHAR);
  224.   VAR name: ARRAY [0..137] OF CHAR;
  225.   
  226.   BEGIN
  227.    GetFileName(Datei.DosDatei,name);           (* Dateiname für Rename merken *)
  228.    FixClose(Datei);
  229.    IF (ErrorCode # 0) THEN 
  230.     RETURN;
  231.    END(*IF*);
  232.    Rename(name, fNeu,ErrorCode);
  233.   END FixRename; 
  234.  
  235.  
  236.  PROCEDURE FixNew(VAR Datei  : FixFile; VAR SatzNr : LONGINT);
  237.   VAR n : LONGCARD;
  238.     
  239.   BEGIN
  240.    ErrorCode := State(Datei.DosDatei);       (* ioIgnore  *)
  241.    ErrorCode := 0;
  242.    IF (Datei.FirstFree = -1) THEN 
  243.     SatzNr := Datei.NumRec;
  244.     TaRecBuf^.I := 0;
  245.     Seek(Datei.DosDatei,LONGINT(LONG(Datei.ItemSize)) * SatzNr,fromBegin);
  246.     WriteBytes(Datei.DosDatei, TaRecBuf, Datei.ItemSize);
  247.     ErrorCode := State(Datei.DosDatei);
  248.     IF (ErrorCode = 0) THEN 
  249.      INC(Datei.NumRec);
  250.     END(*IF*);
  251.    ELSE 
  252.     SatzNr := Datei.FirstFree;
  253.     Seek(Datei.DosDatei,LONGINT(LONG(Datei.ItemSize)) * SatzNr,fromBegin);
  254.     ReadBytes(Datei.DosDatei, TaRecBuf, TSIZE(LONGINT), n );
  255.     ErrorCode := State(Datei.DosDatei);
  256.     IF (ErrorCode = 0) THEN 
  257.      Datei.FirstFree := TaRecBuf^.I;
  258.      DEC(Datei.NumberFree);
  259.     END(*IF*);
  260.    END(*IF*);
  261.   END FixNew; 
  262.  
  263.  
  264.  PROCEDURE FixAdd(VAR Datei : FixFile; VAR SatzNr : LONGINT;
  265.                   VAR Buffer: ARRAY OF LOC);
  266.  
  267.   BEGIN
  268.    FixNew(Datei, SatzNr);
  269.    IF (ErrorCode = 0) THEN 
  270.     FixPut(Datei, SatzNr, Buffer);
  271.    END(*IF*);
  272.   END FixAdd; 
  273.  
  274.  
  275.  PROCEDURE FixDel(VAR Datei  : FixFile; SatzNr : LONGINT);
  276.   
  277.   BEGIN 
  278.    FixGet(Datei, SatzNr, TaRecBuf^, 1);
  279.    TaRecBuf^.I := Datei.FirstFree;
  280.    FixPut(Datei, SatzNr, TaRecBuf^);
  281.    Datei.FirstFree := SatzNr;
  282.    INC(Datei.NumberFree);
  283.    FileUpdated(Datei);
  284.   END FixDel; 
  285.  
  286.  
  287.  PROCEDURE FixTotal(VAR Datei : FixFile): LONGINT;
  288.  
  289.   BEGIN 
  290.     RETURN Datei.NumRec;
  291.   END FixTotal; 
  292.  
  293.  
  294.  PROCEDURE FixSize(VAR Datei: FixFile): LONGINT;
  295.  
  296.   BEGIN 
  297.     RETURN Datei.NumRec * LONGINT(LONG(Datei.ItemSize));
  298.   END FixSize; 
  299.  
  300.  
  301.  PROCEDURE FixUsed(VAR Datei: FixFile) : LONGINT;
  302.  
  303.   BEGIN
  304.    RETURN Datei.NumRec - Datei.NumberFree - 1;
  305.   END FixUsed; 
  306.  
  307.  
  308.  PROCEDURE FixCounter(VAR Datei: FixFile) : CARDINAL;
  309.  
  310.   BEGIN
  311.    RETURN Datei.Zaehler;
  312.   END FixCounter; 
  313.  
  314.  
  315.  PROCEDURE FixflushAll;
  316.   VAR pDatei: FileStack;
  317.  
  318.   BEGIN
  319.    pDatei := DateiStapel;
  320.    WHILE (pDatei # NIL) DO
  321.     FixFlush(pDatei^.DateiPtr^);
  322.     pDatei := pDatei^.Vorg;
  323.    END(*WHILE*);
  324.   END FixflushAll;
  325.  
  326.  
  327. (* PROCEDURE ExitUnit;
  328.  
  329.   BEGIN       
  330.    FixflushAll;
  331.    ExitProc := ExitProcSave;
  332.   END;
  333.   *)
  334.  
  335.  BEGIN
  336.   DateiStapel := NIL;
  337. (*  ExitProcSave := ExitProc;
  338.   ExitProc := ADR(ExitUnit);   *)
  339.  END FixFiles.
  340.