home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / STORAGE.ZIP / STORTEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-02-09  |  4.2 KB  |  136 lines
  1. Program StorageTest;
  2.  
  3. { This program will demonstrate the ability to save and restore text info
  4.   in an indexed file that is also Network aware. This should be interesting
  5.  
  6.   ---------------------------------------------------------------------------
  7.  
  8.   If you have any suggestions or improvments on this file or its usage, or
  9.   would just like to chat, you can reach me at the following:
  10.  
  11.         Marcos R. Della
  12.         5084 Rincon Ave.
  13.         Santa Rosa, CA 95409
  14.  
  15.         CIS: 71675,765
  16.  
  17.   ---------------------------------------------------------------------------}
  18.  
  19. Uses Dos, Crt, Storage, Objects;
  20.  
  21. VAR   T   : TStorage;
  22.       st1 : STRING;      {Kind of a pseudo buffer}
  23.       st2 : STRING;      {Another pseudo buffer}
  24.       st3 : STRING;
  25.       p   : POINTER;    {Pointer to the return character buffer}
  26.  
  27.       idx1   : LONGINT;
  28.       idx2   : LONGINT;
  29.       idx3   : LONGINT;
  30.       loop   : WORD;
  31.       count  : WORD;
  32.       ch     : CHAR;
  33.  
  34. TYPE   charbuf = Array[1..65530] OF char;
  35.  
  36. BEGIN
  37.    CLRSCR;
  38.    st1 := 'Now is the time for all good men to come to the aid of their '
  39.         + 'country before the last of the Mohecians take over the world as '
  40.         + 'we now know it.  This might be a very detrimental accident if '
  41.         + 'it is allowed to happen';
  42.    st2 := 'This is a message that will test the deletion function.';
  43.    st3 := 'This message will survive the compression and deletion!';
  44.  
  45.    T.Init('TESTFILE.DAT',stOpenWrite,512);
  46.    IF T.ErrorInfo = 2 THEN  {File Does Not Exist}
  47.       BEGIN
  48.          T.Done;
  49.          T.Init('TESTFILE.DAT',stCreate,512)
  50.       END;
  51.    WriteLn('Filename:   ',T.SFileName);
  52.    WriteLn('Mode:       ',T.SMode);
  53.  
  54.    idx1 := T.WriteMsg(LENGTH(st1),st1[1]);    {Our actual buffer is from 1..till we hit the NULL}
  55.    IF T.Status <> stOk THEN    {Do your real error checking here if you are}
  56.       T.Reset;                 {really interested}
  57.    WriteLn('1st Index:  ',idx1);
  58.  
  59.    idx2 := T.WriteMsg(LENGTH(st2),st2[1]);
  60.    IF T.Status <> stOk THEN
  61.       T.Reset;
  62.    Writeln('2nd Index:  ',idx2);
  63.  
  64.    idx3 := T.WriteMsg(LENGTH(st3),st3[1]);
  65.    IF T.Status <> stOk THEN
  66.       T.Reset;
  67.    Writeln('3nd Index:  ',idx3);
  68.  
  69.    WriteLn;
  70.    T.DeleteMsg(idx2);
  71.    WriteLn('First Deletion Attempt (Write Only):   ',T.ErrorInfo);
  72.    IF T.Status <> stOk THEN
  73.       T.Reset;
  74.    T.Done;
  75.  
  76.    T.Init('TESTFILE.DAT',stOpen,128);
  77.    T.DeleteMsg(idx2);            {Must be open for read/write!}
  78.    WriteLn('Second Deletion Attempt (Read/Write):  ',T.ErrorInfo);
  79.    IF T.Status <> stOk THEN
  80.       T.Reset;
  81.  
  82.    count := T.ReadMsg(idx2,p);
  83.    WriteLn('Attempt to re-read:                    ',T.ErrorInfo);
  84.    IF T.Status <> stOk THEN
  85.       T.Reset;
  86.    Write('"');
  87.    FOR loop := 1 TO count DO
  88.       Write(CharBuf(p^)[Loop]);
  89.    WriteLn('"');
  90.    Write('Cleaning up the deletion files.   Error returned: ');
  91.    T.CleanUpMsg;
  92.    WriteLn(T.ErrorInfo);
  93.    WriteLn('Re-Index of #1 (Old/New):   ',idx1,'/',T.NewIndex(idx1));
  94.    WriteLn('Re-Index of #2:             ',idx2,'/',T.NewIndex(idx2));
  95.    WriteLn('Re-Index of #3:             ',idx3,'/',T.NewIndex(idx3));
  96.    WriteLn;
  97.    WriteLn('Removing Cleanup stuff and restoring old indexes');
  98.    T.DeleteCleanUp;
  99.    T.Done;
  100.  
  101.    T.Init('TESTFILE.DAT',stOpenRead,128);
  102.    count := T.ReadMsg(idx1,p);
  103.    WriteLn('Test that is being read back from the file:');
  104.    WriteLn('---------------Index 1----------------------------');
  105.    FOR loop := 1 TO count DO
  106.       Write(CharBuf(p^)[Loop]);
  107.    WriteLn;
  108.    WriteLn;
  109.  
  110.    count := T.ReadMsg(idx3,p);
  111.    WriteLn('---------------Index 3----------------------------');
  112.    FOR loop := 1 TO count DO
  113.       Write(charbuf(p^)[Loop]);
  114.    T.Done;
  115.  
  116.    WriteLn;
  117.    WriteLn('-------------------------------------------');
  118.    WriteLn('If you want to see what the compressed text looks like');
  119.    WriteLn('then use a listing utility to list the file ',T.SFilename);
  120.    WriteLn;
  121.    WriteLn('Press a key to read a STANDARD text file');
  122.    ch := READKEY;
  123.    IF ch = #0 THEN
  124.       ch := READKEY;
  125.    CLRSCR;
  126.  
  127.    T.Init('STORTEST.PAS',stOpenRead,1024);
  128.    count := T.ReadMsg(0,p);
  129.    FOR loop := 1 TO count DO
  130.       Write(CharBuf(p^)[Loop]);
  131.    WriteLn;
  132.    T.Done;
  133.  
  134. END.
  135.  
  136.