Listing: 1 (* Release 3.10 *) 2 (*-------------------------------------------------------------------------* 3 * * 4 * WINFIO.MOD - File i/o with far interface for Windows * 5 * * 6 * COPYRIGHT (C) 1987..1992 Clarion Software Corporation. * 7 * All Rights Reserved * 8 * * 9 *--------------------------------------------------------------------------*) 10 11 (*# call(seg_name => null) *) 12 (*# module(implementation=>off) *) 13 (*# data(seg_name => null, near_ptr=>off) *) 14 (*# call(o_a_copy => off, ds_eq_ss=>off, near_call=>off) *) 15 (*# check(stack=>off, 16 index=>off, 17 range=>off, 18 overflow=>off, 19 nil_ptr=>off) *) 20 21 22 IMPLEMENTATION MODULE WinFIO; 23 24 IMPORT Lib, SYSTEM, CoreIO, CoreFile, CoreSig, CoreMain, Windows; 25 26 VAR 27 (* CoreFile.BufInf : ARRAY[0..MaxHandle] OF FileInf; *) (* NB in CoreFile *) 28 IOR: CARDINAL; 29 30 TYPE 31 Str80 = ARRAY[0..79] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 32 PathStr = ARRAY [0..128] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 33 34 35 PROCEDURE ErrorCheck(Code: CARDINAL; ErrNum: CARDINAL; Msg, Name: ARRAY OF CHAR); ***** ^ not supported yet 36 37 VAR 38 ErrMsg: ARRAY [0..119] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 39 NumStr: ARRAY [0..19] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 40 OK: BOOLEAN; 41 BEGIN 42 IF ErrNum = 0 THEN 43 ErrNum := Lib.SysErrno(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 44 END; 45 IF IOcheck THEN ***** ^ undeclared identifier 46 Str.Copy(ErrMsg, Msg); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 47 Str.Append(ErrMsg, Name); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 48 Str.Append(ErrMsg, '. Dos Error Code '); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 49 Str.CardToStr(LONGCARD(ErrNum), NumStr, 10, OK); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 50 Str.Append(ErrMsg, NumStr); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 51 (* Lib.WrDosError(SHORTCARD(ErrNum)); *) 52 Lib.RunTimeError(CoreSig._FatalErrorPos(), Code+0A0H, ErrMsg); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 53 END; 54 IOR := ErrNum; 55 END ErrorCheck; ***** ^ not supported yet 56 57 PROCEDURE IOresult () : CARDINAL; 58 BEGIN 59 RETURN IOR; 60 END IOresult; ***** ^ not supported yet 61 62 63 PROCEDURE WrBin(F: File; Buf: ARRAY OF BYTE; Count: CARDINAL); ***** ^ undeclared identifier ***** ^ undeclared identifier 64 65 VAR 66 NumWrit : CARDINAL; 67 BEGIN 68 IOR := 0; 69 OK := TRUE; ***** ^ undeclared identifier 70 IF Count = 0 THEN RETURN END; 71 NumWrit := Windows._lwrite(F, Buf, Count); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 72 IF NumWrit # Count THEN 73 ErrorCheck(6, 0, 'WrBin : ', Lib.NilStr); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 74 OK := FALSE; ***** ^ undeclared identifier 75 END; 76 END WrBin; ***** ^ not supported yet 77 78 PROCEDURE RdBin(F: File; VAR Buf: ARRAY OF BYTE; Count: CARDINAL) : CARDINAL; ***** ^ undeclared identifier ***** ^ undeclared identifier 79 VAR 80 NumRead: CARDINAL; 81 BEGIN 82 IOR := 0; 83 OK := TRUE; ***** ^ undeclared identifier 84 EOF := FALSE; ***** ^ undeclared identifier 85 IF Count = 0 THEN RETURN 0 END; 86 NumRead := Windows._lread(F, Buf, Count); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 87 IF NumRead # Count THEN 88 OK := FALSE; ***** ^ undeclared identifier 89 IF NumRead < 0 THEN 90 ErrorCheck(7, 0, 'RbBin : ', Lib.NilStr); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 91 ELSE 92 EOF := TRUE; ***** ^ undeclared identifier 93 END; 94 END; 95 RETURN NumRead; 96 END RdBin; ***** ^ not supported yet 97 98 99 PROCEDURE GetName(name: ARRAY OF CHAR; VAR fn: PathStr); ***** ^ not supported yet 100 (* Makes Null terminated filename, also sets IOR to 0 *) 101 BEGIN 102 Str.Copy(fn,name); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 103 fn[HIGH(fn)] := CHR(0); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 104 IOR := 0; 105 END GetName; ***** ^ not supported yet 106 107 PROCEDURE Open(Name: ARRAY OF CHAR) : File; ***** ^ not supported yet ***** ^ undeclared identifier 108 VAR 109 fn: PathStr; ***** ^ not supported yet 110 H: File; ***** ^ undeclared identifier 111 BEGIN 112 GetName(Name,fn); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 113 H := Windows._lopen(fn, Windows.READ_WRITE + INTEGER(ShareMode)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 114 IF H <> MAX(CARDINAL) THEN ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 115 CoreFile._openfd[H] := (CoreIO.O_RDWR+CoreIO.O_BINARY); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 116 IF CoreIO.isatty(H) # 0 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 117 CoreFile._openfd[H] := CoreFile._openfd[H] + CoreIO.O_DEVICE; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 118 END; 119 ELSE 120 ErrorCheck(2, 0, 'Open : ', fn); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 121 END; 122 RETURN H; ***** ^ not supported yet 123 END Open; ***** ^ not supported yet 124 125 PROCEDURE OpenRead( Name: ARRAY OF CHAR) : File; ***** ^ not supported yet ***** ^ undeclared identifier 126 VAR 127 fn: PathStr; ***** ^ not supported yet 128 H: File; ***** ^ undeclared identifier 129 BEGIN 130 GetName(Name,fn); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 131 H := Windows._lopen(fn, Windows.READ + INTEGER(ShareMode)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 132 IF H <> MAX(CARDINAL) THEN ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 133 CoreFile._openfd[H] := (CoreIO.O_RDONLY+CoreIO.O_BINARY); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 134 IF CoreIO.isatty(H) # 0 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 135 CoreFile._openfd[H] := CoreFile._openfd[H] + CoreIO.O_DEVICE; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 136 END; 137 ELSE 138 ErrorCheck(3, 0, 'OpenRead : ', fn); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 139 END; 140 RETURN H; ***** ^ not supported yet 141 END OpenRead; ***** ^ not supported yet 142 143 PROCEDURE Exists(Name: ARRAY OF CHAR) : BOOLEAN; ***** ^ not supported yet 144 VAR 145 fn : PathStr ; ***** ^ not supported yet 146 BEGIN 147 GetName(Name,fn); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 148 IF CoreIO._exists(fn) # 0 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 149 RETURN TRUE; 150 END; 151 RETURN FALSE; 152 END Exists; ***** ^ not supported yet 153 154 PROCEDURE Create(Name: ARRAY OF CHAR) : File; ***** ^ not supported yet ***** ^ undeclared identifier 155 VAR 156 fn: PathStr; ***** ^ not supported yet 157 H: File; ***** ^ undeclared identifier 158 BEGIN 159 GetName(Name,fn); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 160 H := Windows._lcreat(fn, 0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 161 IF H <> MAX(CARDINAL) THEN ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 162 CoreFile._openfd[H] := (CoreIO.O_RDWR+CoreIO.O_BINARY); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 163 ELSE 164 ErrorCheck(5, 0, 'Create : ', Name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 165 END; 166 RETURN H; ***** ^ not supported yet 167 END Create; ***** ^ not supported yet 168 169 PROCEDURE Close(F: File); ***** ^ undeclared identifier 170 BEGIN 171 IOR := 0; 172 IF F < CoreFile._open_max THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 173 CoreFile._openfd[F] := {}; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 174 END; 175 IF Windows._lclose(F) = -1 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 176 ErrorCheck(0, 0, 'Close : ', Lib.NilStr); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 177 END; 178 RETURN; 179 END Close; ***** ^ not supported yet 180 181 BEGIN 182 IOR := 0; 183 OK := TRUE; ***** ^ undeclared identifier 184 EOF := FALSE; ***** ^ undeclared identifier 185 ShareMode := ShareCompat; ***** ^ undeclared identifier ***** ^ undeclared identifier 186 END WinFIO. ***** ^ not supported yet 187 221 errors