home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TPNET20.ZIP / TPTEST.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-09-19  |  4.2 KB  |  131 lines
  1. Program TPTest;
  2. (*********************************************************************)
  3. (***  Program Name: TPTest                                         ***)
  4. (***  Author:       Julio Monroy                                   ***)
  5. (**   Last Update:  9/18/1991                                      ***)
  6. (***  Purpose:      To demonstrate use of the TPNET.TPU Unit.      ***)
  7. (***  Requirements: TPTEST.DAT must be present in current directory **)
  8. (*********************************************************************)
  9.  
  10. Uses Dos,Crt,TPNet;
  11.  
  12. CONST  TestFile = 'TPTEST.DAT';        {  File to be shared          }
  13.        Recnum   = 3;                   {  Record # to be locked      }
  14.        CrLf     = #10#13;              {  Line feed combo            }
  15.        ShareMode= 66;                  {  File open mode (SHARED)    }
  16.  
  17. TYPE  Item_Rec = Record                {  Structure of disk file to  }
  18.         Model : String;                {  be read/written and        }
  19.         Price : Real;                  {  locked/unlocked            }
  20.       End;
  21.  
  22.       Item_File = File of Item_Rec;    {  Type declarations of data  }
  23.       Item_Record  = Item_Rec;         {  structure for VAR headers  }
  24.  
  25. VAR Errcode  : Word;                   {  Global variable declarations }
  26.     Itemfile : Item_File;
  27.     ItemRec  : Item_Record;
  28.  
  29. Procedure ShowTitle;
  30. { Show program information and author }
  31.  
  32. Begin
  33.   Writeln('TPNET Unit Demonstration by Julio Monroy.');
  34.   Writeln('September 1991.',Crlf)
  35. End;
  36.  
  37. Procedure KeyPause;
  38. { This procedure prompts the user to press a key to continue }
  39. Var
  40.   Ch : Char;
  41.  
  42. Begin
  43.   Writeln('Press any key to continue...',CrLf);
  44.   Ch := Readkey;
  45. End;
  46.  
  47. Procedure ErrorHandle(VAR Error : Word);
  48. { This is a dummy error handler.  Substitute your own error handler to }
  49. { properly handle all critical errors.                                 }
  50. Begin
  51.   Writeln('= Error # ',Error,' =');
  52.   If (Error=33) then Writeln('Lock Violation... it works!');
  53.   KeyPause;
  54. End;
  55.  
  56. Procedure OpenFile;
  57. { Opens files in a share mode. This is where the actual file sharing }
  58. { takes place. }
  59.  
  60. Begin { OpenFiles }
  61.   FileMode := ShareMode;     { <-- This step is VERY IMPORTANT! This tells }
  62.   Assign(ItemFile,TestFile);     { Turbo Pascal to open file in a SHARED   }
  63.   {$I-}                          { mode.  A must for network file sharing! }
  64.   Reset(ItemFile);
  65.   {$I+}
  66.   Errcode := IOResult;
  67.   If Errcode<>0 then
  68.     Begin
  69.       Writeln('Error number ',Errcode,' while opening file ',TestFile);
  70.       Halt(1);
  71.     End
  72.   Else
  73.       Writeln('File opened successfully.');
  74. End; { OpenFiles }
  75.  
  76. Procedure WriteData;
  77. { This procedure shows how to seek, lock, write, and unlock a record }
  78.  
  79. Begin { XchgData }
  80.   Repeat
  81.     {$I-}
  82.     Seek(ItemFile,Recnum);                       { Move pointer to test rec }
  83.     {$I+}
  84.     ErrCode := IoResult;
  85.     If Errcode<>0 then ErrorHandle(Errcode);  { If error occurs, handle it }
  86.   Until Errcode = 0;
  87.   ItemRec.Model := 'Invisible 16-Bit Ethernet';  { Assign data to record }
  88.   ItemRec.Price := 369;
  89.   Repeat
  90.     Lockrec(FileRec(ItemFile).Handle,Sizeof(ItemRec),Recnum,Errcode);  { Lock it! }
  91.     If Errcode<>0 then ErrorHandle(Errcode);
  92.   Until Errcode = 0;
  93.   Writeln('Record is locked.');
  94.   KeyPause;
  95.   Repeat
  96.     {$I-}
  97.     Write(ItemFile,ItemRec);                     { Write record }
  98.     {$I+}
  99.     ErrCode := IoResult;
  100.     If Errcode<>0 then ErrorHandle(Errcode);
  101.   Until Errcode = 0;
  102.   Writeln('Record written.');
  103.   KeyPause;
  104.   Repeat                                         { And ... unlock record }
  105.     UnLockrec(FileRec(ItemFile).Handle,Sizeof(ItemRec),Recnum,Errcode);
  106.     If Errcode<>0 then ErrorHandle(Errcode);
  107.   Until Errcode=0;
  108.   Writeln('Record Unlocked.');
  109. End; { XchgData }
  110.  
  111. Procedure CloseFile;
  112. { Closes file opened with ShareHandle }
  113.  
  114. Begin
  115.   {$I-}
  116.   Close(ItemFile);
  117.   {$I+}
  118. End;
  119.  
  120. (*************************************************************************)
  121. (****************************   M   A   I   N   **************************)
  122. (*************************************************************************)
  123.  
  124. Begin { Main }
  125.   ShowTitle;
  126.   OpenFile;
  127.   WriteData;
  128.   CloseFile;
  129. End.  { Main }
  130.  
  131.