mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-12 09:30:08 +02:00
+ First version
This commit is contained in:
carl
parent
fac56c6baf
commit
cd95f7a510
194
rtl/win32/objinc.inc
Normal file
194
rtl/win32/objinc.inc
Normal file
@ -0,0 +1,194 @@
|
||||
{
|
||||
$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
|
||||
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user