{ $Id$ This file is part of the Free Pascal run time library. Copyright (c) 1993-98 by the Free Pascal development team. Includefile for objects.pp implementing OS-dependent file routines for WIN32 See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. ********************************************************************** } CONST { REQUIRED TO PUT MANUALLY here, because of name conflicts in win32.inc } { flags for CreateFile } GENERIC_READ=$80000000; GENERIC_WRITE=$40000000; CREATE_NEW = 1; CREATE_ALWAYS = 2; OPEN_EXISTING = 3; OPEN_ALWAYS = 4; TRUNCATE_EXISTING = 5; FILE_ATTRIBUTE_ARCHIVE = 32; FILE_ATTRIBUTE_COMPRESSED = 2048; FILE_ATTRIBUTE_NORMAL = 128; FILE_ATTRIBUTE_DIRECTORY = 16; FILE_ATTRIBUTE_HIDDEN = 2; FILE_ATTRIBUTE_READONLY = 1; FILE_ATTRIBUTE_SYSTEM = 4; FILE_ATTRIBUTE_TEMPORARY = 256; { flags for SetFilePos } FILE_BEGIN = 0; FILE_CURRENT = 1; FILE_END = 2; { misc. functions } function GetLastError : DWORD; external 'kernel32' name 'GetLastError'; function WriteFile(fh:longint;buf:pointer;len:longint;var loaded:longint; overlap:pointer):longint; external 'kernel32' name 'WriteFile'; function ReadFile(fh:longint;buf:pointer;len:longint;var loaded:longint; overlap:pointer):longint; external 'kernel32' name 'ReadFile'; function CloseHandle(h : longint) : longint; external 'kernel32' name 'CloseHandle'; function DeleteFile(p : pchar) : longint; external 'kernel32' name 'DeleteFileA'; function MoveFile(old,_new : pchar) : longint; external 'kernel32' name 'MoveFileA'; function SetFilePointer(l1,l2 : longint;l3 : pointer;l4 : longint) : longint; external 'kernel32' name 'SetFilePointer'; function GetFileSize(h:longint;p:pointer) : longint; external 'kernel32' name 'GetFileSize'; function CreateFile(name : pointer;access,sharing : longint; security : pointer;how,attr,template : longint) : longint; external 'kernel32' name 'CreateFileA'; function SetEndOfFile(h : longint) : boolean; external 'kernel32' name 'SetEndOfFile'; function GetFileType(Handle:DWORD):DWord; external 'kernel32' name 'GetFileType'; {---------------------------------------------------------------------------} { FileClose -> Platforms WIN32 - Not checked } {---------------------------------------------------------------------------} FUNCTION FileClose(Handle: THandle): word; begin closehandle(handle); FileClose := 0; end; {---------------------------------------------------------------------------} { FileOpen -> Platforms WIN32 - Never checked } { Returns 0 on failure } {---------------------------------------------------------------------------} FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle; var oflags,cd: longint; AHandle : THandle; begin { On opening reset error code } DosStreamError := 0; if Mode=stCreate then Begin cd:=CREATE_ALWAYS; oflags:=GENERIC_WRITE or GENERIC_READ; End else Begin cd:=OPEN_EXISTING; { convert filemode to filerec modes } case (Mode and 3) of 0 : oflags:=GENERIC_READ; 1 : oflags:=GENERIC_WRITE; 2 : oflags:=GENERIC_WRITE or GENERIC_READ; end; end; AHandle:=CreateFile(pointer(@FileName),oflags,0,nil,cd,FILE_ATTRIBUTE_NORMAL,0); if AHandle = 0 then DosStreamError:=word(GetLastError); FileOpen := AHandle; end; {***************************************************************************} { DosSetFilePtr -> Platforms WIN32 - Not Checked } {***************************************************************************} FUNCTION SetFilePos (Handle: THandle; Pos: LongInt; MoveType: Word; Var Actual: LongInt): Word; BEGIN { WARNING WIN32 CURRECTLY HAS THE SAME SEEK MODE AS MSDOS } { if this changes don't forget to change and check the flags } { accordingly. } if SetFilePointer(handle,pos,nil,MoveType)=-1 then DosStreamError:=word(GetLastError); Actual := pos; SetFilePos := DosStreamError; { Return any error } END; {---------------------------------------------------------------------------} { FileRead -> Platforms WIN32 - Not checked } {---------------------------------------------------------------------------} FUNCTION FileRead (Handle: THandle; Var Buf; Count: Sw_Word; Var Actual: Sw_Word): Word; BEGIN if readfile(handle,pointer(@buf),count,Actual,nil)=0 then Begin DosStreamError:=word(GetLastError); end; FileRead:=DosStreamError; end; {---------------------------------------------------------------------------} { FileWrite -> Platforms WIN32 - Not Checked } {---------------------------------------------------------------------------} FUNCTION FileWrite (Handle: THandle; Var Buf; Count: Sw_Word; Var Actual: Sw_Word): Word; BEGIN if writefile(handle,pointer(@buf),count,Actual,nil)=0 then Begin DosStreamError:=word(GetLasterror); end; FileWrite:=DosStreamError; end; {---------------------------------------------------------------------------} { SetFileSize -> Platforms DOS - Not Checked } {---------------------------------------------------------------------------} FUNCTION SetFileSize (Handle: THandle; FileSize: LongInt): Word; VAR Actual, Buf: LongInt; BEGIN SetFilePos(Handle,FileSize,0,Actual); If (Actual = FileSize) Then Begin Actual := FileWrite(Handle, Pointer(@Buf), 0,Actual); { Truncate the file } If (Actual <> -1) Then SetFileSize := 0 Else SetFileSize := 103; { File truncate error } End Else SetFileSize := 103; { File truncate error } END; { $Log$ Revision 1.1 1998-07-07 12:38:46 carl + First version Revision 1.4 1998/07/06 12:26:19 carl * Glurbl.... now work perfectly! Do not change :) Revision 1.3 1998/07/02 12:25:27 carl * NOTHING would work, FileOpen is now correct!! Revision 1.2 1998/05/31 14:18:18 peter * force att or direct assembling * cleanup of some files }