freepascal.compiler/rtl/win32/objinc.inc

{
    $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

}