home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tp6goodi / storage / storage.pas next >
Encoding:
Pascal/Delphi Source File  |  1991-01-14  |  13.4 KB  |  435 lines
  1. Unit Storage;
  2.  
  3. {  STORAGE.PAS - 13 Jan 91
  4.  
  5.    This unit was created to replace the original system storage that was
  6.    created for the DMG.  It is designed to be object oriented and will
  7.    also alow for external compression routines to be designed into the
  8.    system with a registration code for each.
  9.  
  10.    The system will take a buffer pointer and run it through the compressor
  11.    until it reaches a NULL (0) character in the buffer.  This limits you
  12.    to storing only readable messages.  Once the compressor is finished,
  13.    the resulting bitstream is then written to the disk.  An index number
  14.    is returned for where this was written.
  15.  
  16.    The system that reads the messages only needs an index and filename.
  17.    It will create a buffer for the message up to the memory restraints.
  18.  
  19.    You MUST do a .done when you are through with the buffer or the space
  20.    will not be released to the heap.
  21.  
  22.    NOTES:
  23.       The compression algorythm on this system is VERY rudimentary and is
  24.       designed for text only type of material.  It strips all spaces out of
  25.       your text and compresses the next character with 128.  This generally
  26.       saves around 20% storage of a typical text file.  The other change
  27.       is to do the same with the lower case 'e' character.  This is then
  28.       combined with a 64.  Between the two you get around %30 compression
  29.       on your text files... Pretty nifty...
  30.  
  31.       Note that there is no modifications or remaps of any character ranging
  32.       from 000..159.  This is so that you can take a standard FIDO file and
  33.       read it without remapping the soft carriage returns and linefeeds
  34.       (8D and 8A).
  35.  
  36. }
  37.  
  38. {$F+,O+,S-,R-}
  39.  
  40. Interface
  41.  
  42. Uses Dos, Objects;
  43.  
  44. CONST stStoreError      = -120;
  45.       stStoreReadErr    = 197;
  46.       stStoreWriteErr   = 198;
  47.       stStoreUnknownErr = 199;
  48.  
  49. TYPE  PBuffer  = ^BBuffer;
  50.       BBuffer  = ARRAY [0..65530] OF BYTE;
  51.       PCharBuf = ^CharBuf;
  52.       CharBuf  = ARRAY [0..65530] OF CHAR;
  53.  
  54. TYPE  PList    = ^LList;
  55.       LList    = RECORD
  56.                     OldItem : LONGINT;
  57.                     NewItem : LONGINT;
  58.                     Next    : PList;
  59.                  END;
  60.  
  61. TYPE  PStorage = ^TStorage;
  62.       TStorage = OBJECT(TBufStream)
  63.                     SFileName   : FNameStr;
  64.                     SCleanName  : FNameStr;
  65.                     SCleanIndex : PList;
  66.                     SMode       : WORD;
  67.                     SIndex      : LONGINT;
  68.                     SHoldBuf    : POINTER;
  69.                     SHoldBufLen : WORD;
  70.                     CONSTRUCTOR Init(AFileName : FNameStr; AMode, Size : WORD);
  71.                     PROCEDURE WriteMsg(VAR Buf);
  72.                     PROCEDURE ReadMsg(VAR Buf : PCharBuf; Index : LONGINT);
  73.                     PROCEDURE DeleteMsg(Index : LONGINT);
  74.                     PROCEDURE CleanUpMsg;
  75.                     FUNCTION NewIndex(Index : LONGINT) : LONGINT;
  76.                     PROCEDURE DeleteCleanUp;
  77.                     PROCEDURE Compress(VAR Buf); VIRTUAL;
  78.                     PROCEDURE DeCompress(VAR Buf); VIRTUAL;
  79.                     DESTRUCTOR Done; VIRTUAL;
  80.                  END;
  81.  
  82. Implementation
  83.  
  84. CONST MarkerWord   = $93D2;
  85.       RegBasicComp : BYTE = $01;
  86.  
  87. VAR   ExpandSize   : WORD;
  88.       CompressSize : WORD;
  89.       Marker       : WORD;
  90.  
  91. {----------------------------------------------------------------------------}
  92.  
  93. CONSTRUCTOR TStorage.Init;
  94. BEGIN
  95.    TBufStream.Init(AFileName,AMode,Size);
  96.    IF Status <> stOk THEN
  97.       Status := stStoreError
  98.    ELSE
  99.       BEGIN
  100.          SFileName   := FEXPAND(AFileName);
  101.          SCleanName  := '';
  102.          SCleanIndex := NIL;
  103.          SMode       := AMode;
  104.          SIndex      := 0;
  105.          SHoldBuf    := NIL;
  106.          SHoldBufLen := 0
  107.       END
  108. END;
  109.  
  110. {----------------------------------------------------------------------------}
  111.  
  112. PROCEDURE TStorage.WriteMsg;
  113. VAR   WritePosn    : WORD;
  114.       p            : PBuffer;
  115. BEGIN
  116.    p := PBuffer(@Buf);
  117.    SIndex := GetSize;
  118.    TBufStream.Seek(SIndex);
  119.    Marker := MarkerWord;
  120.    TBufStream.Write(Marker,SIZEOF(Marker));
  121.    ExpandSize := 0;
  122.    WHILE (p^[ExpandSize] <> 0) DO
  123.       INC(ExpandSize);
  124.    TBufStream.Write(ExpandSize,SIZEOF(ExpandSize));
  125.    Compress(Buf);
  126.    CompressSize := 0;
  127.    WHILE (p^[CompressSize] <> 0) DO
  128.       INC(CompressSize);
  129.    TBufStream.Write(CompressSize,SIZEOF(CompressSize));
  130.    WritePosn := 0;
  131.    WHILE WritePosn < CompressSize DO
  132.       IF CompressSize - WritePosn > BufSize THEN
  133.          BEGIN
  134.             TBufStream.Write(p^[WritePosn],BufSize);
  135.             INC(WritePosn,BufSize)
  136.          END
  137.       ELSE
  138.          BEGIN
  139.             TBufStream.Write(p^[WritePosn],CompressSize - WritePosn);
  140.             WritePosn := CompressSize
  141.          END;
  142.    Flush;
  143.    IF Status <> stOk THEN
  144.       Status := stStoreError
  145. END;
  146.  
  147. {----------------------------------------------------------------------------}
  148.  
  149. PROCEDURE TStorage.ReadMsg;
  150. VAR   DeleteCheck : BYTE;
  151. BEGIN
  152.    IF (SHoldBuf <> NIL) AND (SHoldBufLen > 0) THEN
  153.       BEGIN
  154.          FREEMEM(SHoldBuf,SHoldBufLen);
  155.          SHoldBuf := NIL;
  156.          SHoldBufLen := 0
  157.       END;
  158.    Seek(Index);
  159.    Read(Marker,SIZEOF(Marker));
  160.    IF Marker = MarkerWord THEN
  161.       BEGIN
  162.          Read(ExpandSize,SIZEOF(ExpandSize));
  163.          Read(CompressSize,SIZEOF(CompressSize));
  164.       END
  165.    ELSE
  166.       BEGIN
  167.          Seek(Index);
  168.          ExpandSize := GetSize - Index;
  169.          IF ExpandSize >= SIZEOF(CharBuf) THEN
  170.             ExpandSize := SIZEOF(CharBuf) - 1;
  171.          CompressSize := ExpandSize
  172.       END;
  173.    Read(DeleteCheck,1);
  174.    IF (DeleteCheck < $FF) OR (Marker <> MarkerWord) THEN
  175.       BEGIN
  176.          SHoldBufLen := ExpandSize + 1;
  177.          GETMEM(SHoldBuf,SHoldBufLen);
  178.          FILLCHAR(SHoldBuf^,SHoldBufLen,0);
  179.          BBuffer(SHoldBuf^)[0] := DeleteCheck;
  180.          Read(BBuffer(SHoldBuf^)[1],CompressSize - 1);
  181.          IF Marker = MarkerWord THEN
  182.             DeCompress(SHoldBuf^);
  183.       END
  184.    ELSE
  185.       BEGIN
  186.          SHoldBufLen := 1;
  187.          GETMEM(SHoldBuf,1);
  188.          BBuffer(SHoldBuf^)[0] := 0;
  189.          Error(stStoreError,stStoreReadErr)     {Disk Read Error}
  190.       END;
  191.    PCharBuf(Buf) := @SholdBuf^;
  192.    IF Status <> stOk THEN
  193.       Status := stStoreError
  194. END;
  195.  
  196. {----------------------------------------------------------------------------}
  197.  
  198. PROCEDURE TStorage.DeleteMsg;
  199. VAR   CompressType : BYTE;
  200. BEGIN
  201.    Seek(Index);
  202.    Read(Marker,SIZEOF(Marker));
  203.    IF Marker = MarkerWord THEN
  204.       BEGIN
  205.          Seek(Index + SIZEOF(Marker) + SIZEOF(ExpandSize) + SIZEOF(CompressSize));
  206.          CompressType := $FF;   {Mark Compression Type as Deleted!}
  207.          Write(CompressType,SIZEOF(CompressType))
  208.       END;
  209.    IF Status <> stOk THEN
  210.       Status := stStoreError
  211. END;
  212.  
  213. {----------------------------------------------------------------------------}
  214.  
  215. PROCEDURE TStorage.CleanUpMsg;
  216. VAR   Dir     : DirStr;
  217.       FName   : NameStr;
  218.       Ext     : ExtStr;
  219.       T       : TBufStream;
  220.       TmpPtr  : POINTER;
  221.       TFile   : FILE;
  222.       OldItem : LONGINT;
  223.       NewItem : LONGINT;
  224.       LinkPtr : PList;
  225. BEGIN
  226.    FSplit(SFileName,Dir,FName,Ext);
  227.    SCleanName := Dir + FName + '.$$$';
  228.    T.Init(SCleanName,stCreate,1024);
  229.    Seek(0);
  230.    OldItem := 0;
  231.    WHILE OldItem < GetSize - 1 DO BEGIN
  232.       Read(Marker,SIZEOF(Marker));
  233.       IF Marker <> MarkerWord THEN
  234.          Error(stStoreError,stStoreUnknownErr);
  235.       Read(ExpandSize,SIZEOF(ExpandSize));
  236.       Read(CompressSize,SIZEOF(CompressSize));
  237.       GETMEM(TmpPtr,CompressSize);
  238.       Read(TmpPtr^,CompressSize);
  239.       IF (Status = stOk) AND (BBuffer(TmpPtr^)[0] < $FF) THEN
  240.          BEGIN
  241.             NewItem := T.GetPos;
  242.             T.Write(Marker,SIZEOF(Marker));
  243.             T.Write(ExpandSize,SIZEOF(ExpandSize));
  244.             T.Write(CompressSize,SIZEOF(CompressSize));
  245.             T.Write(TmpPtr^,CompressSize);
  246.             GETMEM(LinkPtr,SIZEOF(LList));
  247.             LinkPtr^.OldItem := OldItem;
  248.             LinkPtr^.NewItem := NewItem;
  249.             LinkPtr^.Next := SCleanIndex;
  250.             SCleanIndex := LinkPtr
  251.          END;
  252.       FREEMEM(TmpPtr,CompressSize);
  253.       OldItem := GetPos
  254.    END;
  255.    T.Done;
  256.    IF Status <> stOk THEN
  257.       BEGIN
  258.          ASSIGN(TFile,SCleanName);
  259.          ERASE(TFile);
  260.          SCleanName := '';
  261.          Status := stStoreError
  262.       END
  263. END;
  264.  
  265. {----------------------------------------------------------------------------}
  266.  
  267. FUNCTION TStorage.NewIndex;
  268. VAR   PLink : PList;
  269. BEGIN
  270.    PLink := SCleanIndex;
  271.    NewIndex := -1;
  272.    WHILE (PLink <> NIL) AND (PLink^.OldItem <> Index) DO
  273.       PLink := PLink^.Next;
  274.    IF (PLink <> NIL) AND (PLink^.OldItem = Index) THEN
  275.       NewIndex := PLink^.NewItem
  276. END;
  277.  
  278. {----------------------------------------------------------------------------}
  279.  
  280. PROCEDURE TStorage.DeleteCleanUp;
  281. VAR   TFile : FILE;
  282.       PLink : PList;
  283. BEGIN
  284.    IF SCleanName <> '' THEN
  285.       BEGIN
  286.          {$I-} ASSIGN(TFile,SCleanName);
  287.          ERASE(TFile); {$I+}
  288.          ErrorInfo := IOResult;
  289.          IF ErrorInfo <> stOk THEN
  290.             Status := stStoreError;
  291.          SCleanName := '';
  292.          WHILE SCleanIndex <> NIL DO BEGIN
  293.             PLink := SCleanIndex;
  294.             SCleanIndex := PLink^.Next;
  295.             FREEMEM(PLink,SIZEOF(LList))
  296.          END
  297.       END
  298. END;
  299.  
  300. {----------------------------------------------------------------------------}
  301.  
  302. PROCEDURE TStorage.Compress;
  303. VAR   p          : PBuffer;
  304.       ReadPosn   : WORD;
  305.       WritePosn  : WORD;
  306.       SpaceCount : WORD;
  307. BEGIN
  308.    p := PBuffer(@Buf);
  309.    ReadPosn := 0;
  310.    WritePosn := 0;
  311.    WHILE (p^[ReadPosn] <> 0) AND (ReadPosn < 65530) DO BEGIN
  312.       SpaceCount := 0;
  313.       WHILE (p^[ReadPosn + SpaceCount] = 32) DO
  314.          INC(SpaceCount);
  315.       IF SpaceCount > 1 THEN
  316.          BEGIN
  317.             INC(ReadPosn,SpaceCount);
  318.             WHILE SpaceCount > 0 DO
  319.                IF SpaceCount > 255 THEN
  320.                   BEGIN
  321.                      p^[WritePosn] := 255;
  322.                      p^[WritePosn + 1] := 255;
  323.                      INC(WritePosn,2);
  324.                      DEC(SpaceCount,255)
  325.                   END
  326.                ELSE
  327.                   BEGIN
  328.                      p^[WritePosn] := 255;
  329.                      p^[WritePosn + 1] := SpaceCount;
  330.                      INC(WritePosn,2);
  331.                      SpaceCount := 0
  332.                   END;
  333.             SpaceCount := 2
  334.          END;
  335.       IF SpaceCount = 1 THEN
  336.          IF (p^[ReadPosn + 1] >= 64) AND (p^[ReadPosn + 1] <= 127) THEN
  337.             BEGIN
  338.                p^[WritePosn] := p^[ReadPosn + 1] + 128;
  339.                INC(WritePosn);
  340.                INC(ReadPosn,2)
  341.             END
  342.          ELSE
  343.             SpaceCount := 0;
  344.       IF SpaceCount = 0 THEN
  345.          BEGIN
  346.             IF p^[ReadPosn + 1] = 101 THEN
  347.                BEGIN
  348.                   p^[WritePosn] := p^[ReadPosn] + 64;
  349.                   INC(ReadPosn,2)
  350.                END
  351.             ELSE
  352.                BEGIN
  353.                   p^[WritePosn] := p^[ReadPosn];
  354.                   INC(ReadPosn)
  355.                END;
  356.             INC(WritePosn)
  357.          END
  358.    END;
  359.    p^[WritePosn] := 0;
  360.    MOVE(p^[0],p^[1],WritePosn + 1);
  361.    p^[0] := RegBasicComp
  362. END;
  363.  
  364. {----------------------------------------------------------------------------}
  365.  
  366. PROCEDURE TStorage.DeCompress;
  367. VAR   p         : PBuffer;
  368.       ReadPosn  : WORD;
  369.       Count     : WORD;
  370.       Total     : WORD;
  371. BEGIN
  372.    p := PBuffer(@Buf);
  373.    ReadPosn := 0;
  374.    Total := 0;
  375.    WHILE (p^[Total + 1] <> 0) DO
  376.       INC(Total);
  377.    IF p^[0] = RegBasicComp THEN
  378.       BEGIN
  379.          MOVE(p^[1],p^[0],Total);
  380.          p^[Total] := 0;
  381.          WHILE (p^[ReadPosn] <> 0) AND (ReadPosn < SholdBufLen) DO BEGIN
  382.             CASE p^[ReadPosn] OF
  383.                255      : BEGIN
  384.                              Count := p^[ReadPosn + 1];
  385.                              MOVE(p^[ReadPosn + 2],p^[ReadPosn + Count],SHoldBufLen - ReadPosn - 2);
  386.                              FILLCHAR(p^[ReadPosn],Count,32);
  387.                              INC(ReadPosn,Count)
  388.                           END;
  389.                192..254 : BEGIN
  390.                              MOVE(p^[ReadPosn],p^[ReadPosn + 1],SHoldBufLen - ReadPosn);
  391.                              p^[ReadPosn] := 32;
  392.                              DEC(p^[ReadPosn + 1],128);
  393.                              INC(ReadPosn,2)
  394.                           END;
  395.                160..191 : BEGIN
  396.                              MOVE(p^[ReadPosn],p^[ReadPosn + 1],SHoldBufLen - ReadPosn);
  397.                              p^[ReadPosn + 1] := 101;
  398.                              DEC(p^[ReadPosn],64);
  399.                              INC(ReadPosn,2)
  400.                           END;
  401.  
  402.                000..159 : INC(ReadPosn)
  403.             END
  404.          END
  405.       END
  406. END;
  407.  
  408. {----------------------------------------------------------------------------}
  409.  
  410. DESTRUCTOR TStorage.Done;
  411. VAR   TFile : FILE;
  412.       PLink : PList;
  413. BEGIN
  414.    IF (SHoldBuf <> NIL) AND (SHoldBufLen > 0) THEN
  415.       FREEMEM(SHoldBuf,SHoldBufLen);
  416.    TBufStream.Done;
  417.    IF SCleanName <> '' THEN
  418.       BEGIN
  419.          ASSIGN(TFile,SFileName);
  420.          ERASE(TFile);
  421.          ASSIGN(TFile,SCleanName);
  422.          RENAME(TFile,SFileName);
  423.          SCleanName := ''
  424.       END;
  425.    WHILE SCleanIndex <> NIL DO BEGIN
  426.       PLink := SCleanIndex;
  427.       SCleanIndex := PLink^.Next;
  428.       FREEMEM(PLink,SIZEOF(LList))
  429.    END
  430.  
  431. END;
  432.  
  433. {----------------------------------------------------------------------------}
  434.  
  435. END.