home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tp_util / getput.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-03-17  |  5.4 KB  |  230 lines
  1.  
  2. UNIT GETPUT;
  3. { ZUGRIFF AUF UNTYPISIERTE DATEI }
  4. {$F+}
  5.  
  6. INTERFACE
  7.  
  8. USES  DOS;
  9.  
  10. VAR   FILEERR : WORD;
  11.  
  12. PROCEDURE FOPEN (VAR F:FILE;S:STRING);         { OPEN FÜR INPUT UND OUTPUT }
  13. PROCEDURE FOPENI(VAR F:FILE;S:STRING);         { OPEN FÜR INPUT }
  14. FUNCTION  FSIZE (VAR F:FILE):LONGINT;          { FILEGRÖßE IN BYTES }
  15. FUNCTION  FPOS  (VAR F:FILE):LONGINT;          { FILEPOSITION }
  16. PROCEDURE FSEEK (VAR F:FILE;P:LONGINT);        { FILEPOINTER POSITIONIEREN }
  17. PROCEDURE FCLOSE(VAR F:FILE);                  { CLOSE WENN OFFEN }
  18. PROCEDURE FGET  (VAR F:FILE;P:POINTER;S:WORD); { GET ANZAHL BYTES AUS FILE }
  19. PROCEDURE FGETB (VAR F:FILE;VAR B:BYTE);       { GET BYTE }
  20. PROCEDURE FGETC (VAR F:FILE;VAR C:CHAR);       { GET CHAR }
  21. PROCEDURE FGETW (VAR F:FILE;VAR W:WORD);       { GET WORD }
  22. PROCEDURE FGETI (VAR F:FILE;VAR I:INTEGER);    { GET INTEGER }
  23. PROCEDURE FGETH (VAR F:FILE;VAR W:WORD);       { GET WORD HILO- NOTATION }
  24. PROCEDURE FGETR (VAR F:FILE;VAR R:REAL);       { GET REAL }
  25. PROCEDURE FGETP (VAR F:FILE;VAR P:POINTER);    { GET POINTER }
  26. PROCEDURE FGETS (VAR F:FILE;VAR S:STRING);     { GET STRING }
  27. PROCEDURE FGETLN(VAR F:FILE;VAR S:STRING);     { GET LINE }
  28. PROCEDURE FPUT  (VAR F:FILE;P:POINTER;S:WORD); { PUT ANZAHL BYTES IN FILE }
  29. PROCEDURE FPUTB (VAR F:FILE;B:BYTE);           { PUT BYTE }
  30. PROCEDURE FPUTC (VAR F:FILE;C:CHAR);           { PUT CHAR }
  31. PROCEDURE FPUTW (VAR F:FILE;W:WORD);           { PUT WORD }
  32. PROCEDURE FPUTI (VAR F:FILE;I:INTEGER);        { PUT INTEGER }
  33. PROCEDURE FPUTH (VAR F:FILE;W:WORD);           { PUT WORD HILO- NOTATION }
  34. PROCEDURE FPUTR (VAR F:FILE;R:REAL);           { PUT REAL }
  35. PROCEDURE FPUTP (VAR F:FILE;P:POINTER);        { PUT POINTER }
  36. PROCEDURE FPUTS (VAR F:FILE;S:STRING);         { PUT STRING }
  37.  
  38.  
  39. IMPLEMENTATION
  40.  
  41.  
  42. PROCEDURE FOPEN(VAR F:FILE;S:STRING); { OPEN FÜR INPUT UND OUTPUT }
  43. BEGIN
  44.   ASSIGN(F,S);
  45. {$I-}
  46.   RESET(F);
  47.   FILEERR := IORESULT;
  48.   IF FILEERR <> 0 THEN BEGIN
  49.     REWRITE(F);
  50.     RESET(F);
  51.     FILEERR := IORESULT;
  52.   END;
  53. {$I+}
  54. END;
  55.  
  56.  
  57. PROCEDURE FOPENI(VAR F:FILE;S:STRING); { OPEN FÜR INPUT }
  58. BEGIN
  59.   ASSIGN(F,S);
  60. {$I-}
  61.   RESET(F);
  62.   FILEERR := IORESULT;
  63. {$I+}
  64. END;
  65.  
  66.  
  67. FUNCTION FSIZE(VAR F:FILE):LONGINT; { FILEGRÖßE IN BYTES }
  68. BEGIN
  69.   FILEREC(F).RECSIZE := 1;
  70. {$I-}
  71.   FSIZE := FILESIZE(F);
  72.   FILEERR := IORESULT;
  73. {$I+}
  74. END;
  75.  
  76.  
  77. FUNCTION  FPOS  (VAR F:FILE):LONGINT;          { FILEPOSITION }
  78. BEGIN
  79.   FILEREC(F).RECSIZE := 1;
  80. {$I-}
  81.   FPOS := FILEPOS(F);
  82.   FILEERR := IORESULT;
  83. {$I+}
  84. END;
  85.  
  86.  
  87. PROCEDURE FSEEK (VAR F:FILE;P:LONGINT);        { FILEPOINTER POSITIONIEREN }
  88. BEGIN
  89.   FILEREC(F).RECSIZE := 1;
  90. {$I-}
  91.   SEEK(F,P);
  92.   FILEERR := IORESULT;
  93. {$I+}
  94. END;
  95.  
  96.  
  97. PROCEDURE FCLOSE(VAR F:FILE); { CLOSE WENN OFFEN }
  98. BEGIN
  99. {$I-}
  100.   IF (FILEREC(F).MODE = $D7B1) OR
  101.      (FILEREC(F).MODE = $D7B2) OR
  102.      (FILEREC(F).MODE = $D7B3)
  103.         THEN CLOSE(F);
  104. {$I+}
  105.   FILEERR := IORESULT;
  106. END;
  107.  
  108.  
  109. PROCEDURE FGET(VAR F:FILE;P:POINTER;S:WORD); { GET ANZAHL BYTES AUS FILE }
  110. BEGIN
  111.   FILEREC(F).RECSIZE := S;
  112. {$I-}
  113.   BLOCKREAD(F,P^,1);
  114. {$I+}
  115.   FILEERR := IORESULT;
  116. END;
  117.  
  118. PROCEDURE FGETB(VAR F:FILE;VAR B:BYTE); { GET BYTE AUS UNTYPISIERTEM FILE }
  119. BEGIN
  120.   FGET(F,@B,1);
  121. END;
  122.  
  123. PROCEDURE FGETC(VAR F:FILE;VAR C:CHAR); { GET CHAR AUS UNTYPISIERTEM FILE }
  124. BEGIN
  125.   FGET(F,@C,1);
  126. END;
  127.  
  128. PROCEDURE FGETW(VAR F:FILE;VAR W:WORD); { GET WORD AUS UNTYPISIERTEM FILE }
  129. BEGIN
  130.   FGET(F,@W,2);
  131. END;
  132.  
  133. PROCEDURE FGETI(VAR F:FILE;VAR I:INTEGER); { GET INTEGER AUS UNTYPISIERTEM FILE }
  134. BEGIN
  135.   FGET(F,@I,2);
  136. END;
  137.  
  138. PROCEDURE FGETH(VAR F:FILE;VAR W:WORD); { GET WORD HILO- NOTATION }
  139. BEGIN
  140.   FGET(F,@W,2);
  141.   W := SWAP(W);
  142. END;
  143.  
  144. PROCEDURE FGETR(VAR F:FILE;VAR R:REAL); { GET REAL AUS UNTYPISIERTEM FILE }
  145. BEGIN
  146.   FGET(F,@R,6);
  147. END;
  148.  
  149. PROCEDURE FGETP(VAR F:FILE;VAR P:POINTER); { GET POINTER AUS UNTYPISIERTEM FILE }
  150. BEGIN
  151.   FGET(F,@P,8);
  152. END;
  153.  
  154. PROCEDURE FGETS(VAR F:FILE;VAR S:STRING); { GET STRING AUS UNTYPISIERTEM FILE }
  155. BEGIN
  156.   IF EOF(F) THEN S := #0 ELSE BEGIN
  157.     FGET(F,@S[0],1);
  158.     IF S[0] > #0 THEN FGET(F,@S[1],ORD(S[0]));
  159.   END;
  160. END;
  161.  
  162. PROCEDURE FGETLN(VAR F:FILE;VAR S:STRING); { GET LINE AUS UNTYPISIERTEM FILE }
  163. VAR   I  : BYTE;
  164. BEGIN
  165.   I := 0;
  166.   S := #0;
  167.   WHILE (NOT EOF(F)) AND (S[I] <> ^J) DO BEGIN
  168.     INC(I);
  169.     FGET(F,@S[I],1);
  170.   END;
  171.   IF (I > 0) AND (S[I] = ^J) THEN DEC(I);
  172.   IF (I > 0) AND (S[I] = ^M) THEN DEC(I);
  173.   S[0] := CHR(I);
  174. END;
  175.  
  176.  
  177. PROCEDURE FPUT(VAR F:FILE;P:POINTER;S:WORD);
  178. BEGIN
  179.   FILEREC(F).RECSIZE := S;
  180. {$I-}
  181.   BLOCKWRITE(F,P^,1);
  182. {$I+}
  183.   FILEERR := IORESULT;
  184. END;
  185.  
  186. PROCEDURE FPUTB(VAR F:FILE;B:BYTE); { PUT BYTE IN UNTYPISIERTES FILE }
  187. BEGIN
  188.   FPUT(F,@B,1);
  189. END;
  190.  
  191. PROCEDURE FPUTC(VAR F:FILE;C:CHAR); { PUT CHAR IN UNTYPISIERTES FILE }
  192. BEGIN
  193.   FPUT(F,@C,1);
  194. END;
  195.  
  196. PROCEDURE FPUTW(VAR F:FILE;W:WORD); { PUT WORD IN UNTYPISIERTES FILE }
  197. BEGIN
  198.   FPUT(F,@W,2);
  199. END;
  200.  
  201. PROCEDURE FPUTI(VAR F:FILE;I:INTEGER); { PUT INTEGER IN UNTYPISIERTES FILE }
  202. BEGIN
  203.   FPUT(F,@I,2);
  204. END;
  205.  
  206. PROCEDURE FPUTH(VAR F:FILE;W:WORD); { PUT WORD HILO- NOTATION }
  207. BEGIN
  208.   W := SWAP(W);
  209.   FPUT(F,@W,2);
  210. END;
  211.  
  212. PROCEDURE FPUTR(VAR F:FILE;R:REAL); { PUT REAL IN UNTYPISIERTES FILE }
  213. BEGIN
  214.   FPUT(F,@R,6);
  215. END;
  216.  
  217. PROCEDURE FPUTP(VAR F:FILE;P:POINTER); { PUT POINTER IN UNTYPISIERTES FILE }
  218. BEGIN
  219.   FPUT(F,@P,8);
  220. END;
  221.  
  222. PROCEDURE FPUTS(VAR F:FILE;S:STRING); { PUT STRING IN UNTYPISIERTES FILE }
  223. BEGIN
  224.   FPUT(F,@S[0],SUCC(ORD(S[0])));
  225. END;
  226.  
  227. BEGIN
  228. END.
  229.  
  230.