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