mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-03 09:29:42 +01:00
* stdcall patch
This commit is contained in:
peter
parent
ffaf16733a
commit
33b5eccc3c
@ -2632,13 +2632,13 @@ TYPE
|
||||
{$i wininc/objbase.inc}
|
||||
|
||||
{ redefinitions }
|
||||
function CoCreateGuid(out _para1:TGUID):HRESULT;external 'ole32.dll' name 'CoCreateGuid';
|
||||
function CoCreateGuid(out _para1:TGUID):HRESULT;stdcall;external 'ole32.dll' name 'CoCreateGuid';
|
||||
|
||||
{ additional definitions }
|
||||
|
||||
function IsEqualGUID(const guid1,guid2 : TGUID) : Boolean;external 'ole32.dll' name 'IsEqualGUID';
|
||||
function IsEqualIID(const iid1,iid2 : TIID) : Boolean;external 'ole32.dll' name 'IsEqualGUID';
|
||||
function IsEqualCLSID(const clsid1,clsid2 : TCLSID) : Boolean;external 'ole32.dll' name 'IsEqualGUID';
|
||||
function IsEqualGUID(const guid1,guid2 : TGUID) : Boolean;stdcall;external 'ole32.dll' name 'IsEqualGUID';
|
||||
function IsEqualIID(const iid1,iid2 : TIID) : Boolean;stdcall;external 'ole32.dll' name 'IsEqualGUID';
|
||||
function IsEqualCLSID(const clsid1,clsid2 : TCLSID) : Boolean;stdcall;external 'ole32.dll' name 'IsEqualGUID';
|
||||
|
||||
{$ENDIF HASINTF}
|
||||
|
||||
@ -2650,7 +2650,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.8 2002-12-12 17:52:35 peter
|
||||
Revision 1.9 2003-09-17 15:06:36 peter
|
||||
* stdcall patch
|
||||
|
||||
Revision 1.8 2002/12/12 17:52:35 peter
|
||||
* INT renamed to WINT
|
||||
|
||||
Revision 1.7 2002/10/10 16:10:45 florian
|
||||
|
||||
@ -206,15 +206,15 @@ var
|
||||
******************************************************************************}
|
||||
|
||||
function GetLastError : DWORD;
|
||||
external 'kernel32' name 'GetLastError';
|
||||
stdcall; external 'kernel32' name 'GetLastError';
|
||||
function FileTimeToDosDateTime(const ft :TWin32FileTime;var data,time : word) : longbool;
|
||||
external 'kernel32' name 'FileTimeToDosDateTime';
|
||||
stdcall; external 'kernel32' name 'FileTimeToDosDateTime';
|
||||
function DosDateTimeToFileTime(date,time : word;var ft :TWin32FileTime) : longbool;
|
||||
external 'kernel32' name 'DosDateTimeToFileTime';
|
||||
stdcall; external 'kernel32' name 'DosDateTimeToFileTime';
|
||||
function FileTimeToLocalFileTime(const ft : TWin32FileTime;var lft : TWin32FileTime) : longbool;
|
||||
external 'kernel32' name 'FileTimeToLocalFileTime';
|
||||
stdcall; external 'kernel32' name 'FileTimeToLocalFileTime';
|
||||
function LocalFileTimeToFileTime(const lft : TWin32FileTime;var ft : TWin32FileTime) : longbool;
|
||||
external 'kernel32' name 'LocalFileTimeToFileTime';
|
||||
stdcall; external 'kernel32' name 'LocalFileTimeToFileTime';
|
||||
|
||||
type
|
||||
Longrec=packed record
|
||||
@ -294,11 +294,11 @@ type
|
||||
end;
|
||||
|
||||
function GetVersion : longint;
|
||||
external 'kernel32' name 'GetVersion';
|
||||
stdcall; external 'kernel32' name 'GetVersion';
|
||||
procedure GetLocalTime(var t : TSystemTime);
|
||||
external 'kernel32' name 'GetLocalTime';
|
||||
stdcall; external 'kernel32' name 'GetLocalTime';
|
||||
function SetLocalTime(const t : TSystemTime) : longbool;
|
||||
external 'kernel32' name 'SetLocalTime';
|
||||
stdcall; external 'kernel32' name 'SetLocalTime';
|
||||
|
||||
function dosversion : word;
|
||||
begin
|
||||
@ -400,13 +400,13 @@ type
|
||||
bInheritHandles: Longbool; dwCreationFlags: DWORD; lpEnvironment: Pointer;
|
||||
lpCurrentDirectory: PChar; const lpStartupInfo: TStartupInfo;
|
||||
var lpProcessInformation: TProcessInformation): longbool;
|
||||
external 'kernel32' name 'CreateProcessA';
|
||||
stdcall; external 'kernel32' name 'CreateProcessA';
|
||||
function getExitCodeProcess(h:TWin32Handle;var code:longint):longbool;
|
||||
external 'kernel32' name 'GetExitCodeProcess';
|
||||
stdcall; external 'kernel32' name 'GetExitCodeProcess';
|
||||
function WaitForSingleObject(hHandle: TWin32Handle; dwMilliseconds: DWORD): DWORD;
|
||||
external 'kernel32' name 'WaitForSingleObject';
|
||||
stdcall; external 'kernel32' name 'WaitForSingleObject';
|
||||
function CloseHandle(h : TWin32Handle) : longint;
|
||||
external 'kernel32' name 'CloseHandle';
|
||||
stdcall; external 'kernel32' name 'CloseHandle';
|
||||
|
||||
var
|
||||
lastdosexitcode : longint;
|
||||
@ -497,7 +497,7 @@ end;
|
||||
|
||||
function GetDiskFreeSpace(drive:pchar;var sector_cluster,bytes_sector,
|
||||
freeclusters,totalclusters:longint):longbool;
|
||||
external 'kernel32' name 'GetDiskFreeSpaceA';
|
||||
stdcall; external 'kernel32' name 'GetDiskFreeSpaceA';
|
||||
type
|
||||
TGetDiskFreeSpaceEx = function(drive:pchar;var availableforcaller,
|
||||
total,free):longbool;stdcall;
|
||||
@ -587,11 +587,11 @@ end;
|
||||
{ Needed kernel calls }
|
||||
|
||||
function FindFirstFile (lpFileName: PChar; var lpFindFileData: TWIN32FindData): TWin32Handle;
|
||||
external 'kernel32' name 'FindFirstFileA';
|
||||
stdcall; external 'kernel32' name 'FindFirstFileA';
|
||||
function FindNextFile (hFindFile: TWin32Handle; var lpFindFileData: TWIN32FindData): LongBool;
|
||||
external 'kernel32' name 'FindNextFileA';
|
||||
stdcall; external 'kernel32' name 'FindNextFileA';
|
||||
function FindCloseFile (hFindFile: TWin32Handle): LongBool;
|
||||
external 'kernel32' name 'FindClose';
|
||||
stdcall; external 'kernel32' name 'FindClose';
|
||||
|
||||
Procedure StringToPchar (Var S : String);
|
||||
Var L : Longint;
|
||||
@ -686,13 +686,13 @@ end;
|
||||
******************************************************************************}
|
||||
|
||||
function GeTWin32FileTime(h : longint;creation,lastaccess,lastwrite : PWin32FileTime) : longbool;
|
||||
external 'kernel32' name 'GetFileTime';
|
||||
stdcall; external 'kernel32' name 'GetFileTime';
|
||||
function SeTWin32FileTime(h : longint;creation,lastaccess,lastwrite : PWin32FileTime) : longbool;
|
||||
external 'kernel32' name 'SetFileTime';
|
||||
stdcall; external 'kernel32' name 'SetFileTime';
|
||||
function SetFileAttributes(lpFileName : pchar;dwFileAttributes : longint) : longbool;
|
||||
external 'kernel32' name 'SetFileAttributesA';
|
||||
stdcall; external 'kernel32' name 'SetFileAttributesA';
|
||||
function GetFileAttributes(lpFileName : pchar) : longint;
|
||||
external 'kernel32' name 'GetFileAttributesA';
|
||||
stdcall; external 'kernel32' name 'GetFileAttributesA';
|
||||
|
||||
procedure fsplit(path : pathstr;var dir : dirstr;var name : namestr;var ext : extstr);
|
||||
var
|
||||
@ -740,10 +740,10 @@ end;
|
||||
{ <immobilizer> }
|
||||
|
||||
function GetFullPathName(lpFileName: PChar; nBufferLength: Longint; lpBuffer: PChar; var lpFilePart : PChar):DWORD;
|
||||
external 'kernel32' name 'GetFullPathNameA';
|
||||
stdcall; external 'kernel32' name 'GetFullPathNameA';
|
||||
|
||||
function GetShortPathName(lpszLongPath:pchar; lpszShortPath:pchar; cchBuffer:DWORD):DWORD;
|
||||
external 'kernel32' name 'GetShortPathNameA';
|
||||
stdcall; external 'kernel32' name 'GetShortPathNameA';
|
||||
|
||||
|
||||
(*
|
||||
@ -761,7 +761,7 @@ function FExpand (const Path: PathStr): PathStr;
|
||||
|
||||
|
||||
function SearchPath(lpPath : PChar; lpFileName : PChar; lpExtension : PChar; nBufferLength : Longint; lpBuffer : PChar;
|
||||
var lpFilePart : PChar) : Longint; external 'kernel32' name 'SearchPathA';
|
||||
var lpFilePart : PChar) : Longint; stdcall; external 'kernel32' name 'SearchPathA';
|
||||
|
||||
Function FSearch(path: pathstr; dirlist: string): pathstr;
|
||||
var temp : PChar;
|
||||
@ -957,9 +957,9 @@ end;
|
||||
}
|
||||
|
||||
function GetEnvironmentStrings : pchar;
|
||||
external 'kernel32' name 'GetEnvironmentStringsA';
|
||||
stdcall; external 'kernel32' name 'GetEnvironmentStringsA';
|
||||
function FreeEnvironmentStrings(p : pchar) : longbool;
|
||||
external 'kernel32' name 'FreeEnvironmentStringsA';
|
||||
stdcall; external 'kernel32' name 'FreeEnvironmentStringsA';
|
||||
|
||||
function envcount : longint;
|
||||
var
|
||||
@ -1048,13 +1048,13 @@ Begin
|
||||
End;
|
||||
|
||||
function FreeLibrary(hLibModule : TWin32Handle) : longbool;
|
||||
external 'kernel32' name 'FreeLibrary';
|
||||
stdcall; external 'kernel32' name 'FreeLibrary';
|
||||
function GetVersionEx(var VersionInformation:OSVERSIONINFO) : longbool;
|
||||
external 'kernel32' name 'GetVersionExA';
|
||||
stdcall; external 'kernel32' name 'GetVersionExA';
|
||||
function LoadLibrary(lpLibFileName : pchar):TWin32Handle;
|
||||
external 'kernel32' name 'LoadLibraryA';
|
||||
stdcall; external 'kernel32' name 'LoadLibraryA';
|
||||
function GetProcAddress(hModule : TWin32Handle;lpProcName : pchar) : pointer;
|
||||
external 'kernel32' name 'GetProcAddress';
|
||||
stdcall; external 'kernel32' name 'GetProcAddress';
|
||||
|
||||
var
|
||||
oldexitproc : pointer;
|
||||
@ -1085,7 +1085,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.19 2003-06-10 11:16:15 jonas
|
||||
Revision 1.20 2003-09-17 15:06:36 peter
|
||||
* stdcall patch
|
||||
|
||||
Revision 1.19 2003/06/10 11:16:15 jonas
|
||||
* fix from Peter
|
||||
|
||||
Revision 1.18 2002/12/24 15:35:15 peter
|
||||
|
||||
@ -43,31 +43,31 @@ CONST
|
||||
|
||||
{ misc. functions }
|
||||
function GetLastError : DWORD;
|
||||
external 'kernel32' name 'GetLastError';
|
||||
stdcall;external 'kernel32' name 'GetLastError';
|
||||
|
||||
function WriteFile(fh:longint;buf:pointer;len:longint;var loaded:longint;
|
||||
overlap:pointer):longint;
|
||||
external 'kernel32' name 'WriteFile';
|
||||
stdcall;external 'kernel32' name 'WriteFile';
|
||||
function ReadFile(fh:longint;buf:pointer;len:longint;var loaded:longint;
|
||||
overlap:pointer):longint;
|
||||
external 'kernel32' name 'ReadFile';
|
||||
stdcall;external 'kernel32' name 'ReadFile';
|
||||
function CloseHandle(h : longint) : longint;
|
||||
external 'kernel32' name 'CloseHandle';
|
||||
stdcall;external 'kernel32' name 'CloseHandle';
|
||||
function DeleteFile(p : pchar) : longint;
|
||||
external 'kernel32' name 'DeleteFileA';
|
||||
stdcall;external 'kernel32' name 'DeleteFileA';
|
||||
function MoveFile(old,_new : pchar) : longint;
|
||||
external 'kernel32' name 'MoveFileA';
|
||||
stdcall;external 'kernel32' name 'MoveFileA';
|
||||
function SetFilePointer(l1,l2 : longint;l3 : pointer;l4 : longint) : longint;
|
||||
external 'kernel32' name 'SetFilePointer';
|
||||
stdcall;external 'kernel32' name 'SetFilePointer';
|
||||
function GetFileSize(h:longint;p:pointer) : longint;
|
||||
external 'kernel32' name 'GetFileSize';
|
||||
stdcall;external 'kernel32' name 'GetFileSize';
|
||||
function CreateFile(name : pointer;access,sharing : longint;
|
||||
security : pointer;how,attr,template : longint) : longint;
|
||||
external 'kernel32' name 'CreateFileA';
|
||||
stdcall;external 'kernel32' name 'CreateFileA';
|
||||
function SetEndOfFile(h : longint) : boolean;
|
||||
external 'kernel32' name 'SetEndOfFile';
|
||||
stdcall;external 'kernel32' name 'SetEndOfFile';
|
||||
function GetFileType(Handle:DWORD):DWord;
|
||||
external 'kernel32' name 'GetFileType';
|
||||
stdcall;external 'kernel32' name 'GetFileType';
|
||||
|
||||
|
||||
{---------------------------------------------------------------------------}
|
||||
@ -185,7 +185,10 @@ END;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 2002-09-07 21:28:10 carl
|
||||
Revision 1.7 2003-09-17 15:06:36 peter
|
||||
* stdcall patch
|
||||
|
||||
Revision 1.6 2002/09/07 21:28:10 carl
|
||||
- removed os_types
|
||||
* fix range check errors
|
||||
|
||||
|
||||
@ -31,6 +31,7 @@ Unit ShellApi;
|
||||
|
||||
Interface
|
||||
{$PACKRECORDS C}
|
||||
{$calling stdcall}
|
||||
{$mode Delphi}
|
||||
|
||||
Uses Windows;
|
||||
|
||||
@ -37,7 +37,7 @@ interface
|
||||
|
||||
type
|
||||
|
||||
SignalHandler = function (v : longint) : longint;
|
||||
SignalHandler = function (v : longint) : longint;cdecl;
|
||||
|
||||
PSignalHandler = ^SignalHandler; { to be compatible with linux.pp }
|
||||
|
||||
@ -151,7 +151,7 @@ const
|
||||
|
||||
function SetUnhandledExceptionFilter(lpTopLevelExceptionFilter : LPTOP_LEVEL_EXCEPTION_FILTER)
|
||||
: LPTOP_LEVEL_EXCEPTION_FILTER;
|
||||
external 'kernel32' name 'SetUnhandledExceptionFilter';
|
||||
stdcall; external 'kernel32' name 'SetUnhandledExceptionFilter';
|
||||
|
||||
var
|
||||
signal_list : Array[SIGABRT..SIGMAX] of SignalHandler;
|
||||
|
||||
@ -206,6 +206,47 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
{$ifdef unix}
|
||||
{ mimic the linux fpWrite/fpRead calls for the file/text socket wrapper }
|
||||
function fpWrite(handle : longint;Const bufptr;size : dword) : dword;
|
||||
begin
|
||||
fpWrite := dword(WinSock.send(handle, bufptr, size, 0));
|
||||
if fpWrite = dword(SOCKET_ERROR) then
|
||||
begin
|
||||
SocketError := WSAGetLastError;
|
||||
fpWrite := 0;
|
||||
end
|
||||
else
|
||||
SocketError := 0;
|
||||
end;
|
||||
|
||||
function fpRead(handle : longint;var bufptr;size : dword) : dword;
|
||||
var
|
||||
d : dword;
|
||||
|
||||
begin
|
||||
if ioctlsocket(handle,FIONREAD,@d) = SOCKET_ERROR then
|
||||
begin
|
||||
SocketError:=WSAGetLastError;
|
||||
fpRead:=0;
|
||||
exit;
|
||||
end;
|
||||
if d>0 then
|
||||
begin
|
||||
if size>d then
|
||||
size:=d;
|
||||
fpRead := dword(WinSock.recv(handle, bufptr, size, 0));
|
||||
if fpRead = dword(SOCKET_ERROR) then
|
||||
begin
|
||||
SocketError:= WSAGetLastError;
|
||||
fpRead := 0;
|
||||
end else
|
||||
SocketError:=0;
|
||||
end
|
||||
else
|
||||
SocketError:=0;
|
||||
end;
|
||||
{$else}
|
||||
{ mimic the linux fdWrite/fdRead calls for the file/text socket wrapper }
|
||||
function fdWrite(handle : longint;Const bufptr;size : dword) : dword;
|
||||
begin
|
||||
@ -245,7 +286,7 @@ function fdRead(handle : longint;var bufptr;size : dword) : dword;
|
||||
else
|
||||
SocketError:=0;
|
||||
end;
|
||||
|
||||
{$endif}
|
||||
|
||||
{$i sockets.inc}
|
||||
|
||||
@ -260,7 +301,10 @@ finalization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.11 2003-03-23 17:47:15 armin
|
||||
Revision 1.12 2003-09-17 15:06:36 peter
|
||||
* stdcall patch
|
||||
|
||||
Revision 1.11 2003/03/23 17:47:15 armin
|
||||
* CloseSocket added
|
||||
|
||||
Revision 1.10 2003/01/01 14:34:22 peter
|
||||
|
||||
@ -176,15 +176,15 @@ var
|
||||
|
||||
{ misc. functions }
|
||||
function GetLastError : DWORD;
|
||||
external 'kernel32' name 'GetLastError';
|
||||
stdcall;external 'kernel32' name 'GetLastError';
|
||||
|
||||
{ time and date functions }
|
||||
function GetTickCount : longint;
|
||||
external 'kernel32' name 'GetTickCount';
|
||||
stdcall;external 'kernel32' name 'GetTickCount';
|
||||
|
||||
{ process functions }
|
||||
procedure ExitProcess(uExitCode : UINT);
|
||||
external 'kernel32' name 'ExitProcess';
|
||||
stdcall;external 'kernel32' name 'ExitProcess';
|
||||
|
||||
|
||||
Procedure Errno2InOutRes;
|
||||
@ -220,9 +220,9 @@ end;
|
||||
|
||||
{ module functions }
|
||||
function GetModuleFileName(l1:longint;p:pointer;l2:longint):longint;
|
||||
external 'kernel32' name 'GetModuleFileNameA';
|
||||
stdcall;external 'kernel32' name 'GetModuleFileNameA';
|
||||
function GetModuleHandle(p : pointer) : longint;
|
||||
external 'kernel32' name 'GetModuleHandleA';
|
||||
stdcall;external 'kernel32' name 'GetModuleHandleA';
|
||||
function GetCommandFile:pchar;forward;
|
||||
|
||||
function paramstr(l : longint) : string;
|
||||
@ -245,12 +245,12 @@ end;
|
||||
*****************************************************************************}
|
||||
{ memory functions }
|
||||
function GetProcessHeap : DWord;
|
||||
external 'kernel32' name 'GetProcessHeap';
|
||||
stdcall;external 'kernel32' name 'GetProcessHeap';
|
||||
function HeapAlloc(hHeap : DWord; dwFlags : DWord; dwBytes : DWord) : Longint;
|
||||
external 'kernel32' name 'HeapAlloc';
|
||||
stdcall;external 'kernel32' name 'HeapAlloc';
|
||||
{$IFDEF SYSTEMDEBUG}
|
||||
function WinAPIHeapSize(hHeap : DWord; dwFlags : DWord; ptr : Pointer) : DWord;
|
||||
external 'kernel32' name 'HeapSize';
|
||||
stdcall;external 'kernel32' name 'HeapSize';
|
||||
{$ENDIF}
|
||||
|
||||
var
|
||||
@ -294,29 +294,29 @@ end;
|
||||
|
||||
function WriteFile(fh:longint;buf:pointer;len:longint;var loaded:longint;
|
||||
overlap:pointer):longint;
|
||||
external 'kernel32' name 'WriteFile';
|
||||
stdcall;external 'kernel32' name 'WriteFile';
|
||||
function ReadFile(fh:longint;buf:pointer;len:longint;var loaded:longint;
|
||||
overlap:pointer):longint;
|
||||
external 'kernel32' name 'ReadFile';
|
||||
stdcall;external 'kernel32' name 'ReadFile';
|
||||
function CloseHandle(h : longint) : longint;
|
||||
external 'kernel32' name 'CloseHandle';
|
||||
stdcall;external 'kernel32' name 'CloseHandle';
|
||||
function DeleteFile(p : pchar) : longint;
|
||||
external 'kernel32' name 'DeleteFileA';
|
||||
stdcall;external 'kernel32' name 'DeleteFileA';
|
||||
function MoveFile(old,_new : pchar) : longint;
|
||||
external 'kernel32' name 'MoveFileA';
|
||||
stdcall;external 'kernel32' name 'MoveFileA';
|
||||
function SetFilePointer(l1,l2 : longint;l3 : pointer;l4 : longint) : longint;
|
||||
external 'kernel32' name 'SetFilePointer';
|
||||
stdcall;external 'kernel32' name 'SetFilePointer';
|
||||
function GetFileSize(h:longint;p:pointer) : longint;
|
||||
external 'kernel32' name 'GetFileSize';
|
||||
stdcall;external 'kernel32' name 'GetFileSize';
|
||||
function CreateFile(name : pointer;access,sharing : longint;
|
||||
security : PSecurityAttributes;how,attr,template : longint) : longint;
|
||||
external 'kernel32' name 'CreateFileA';
|
||||
stdcall;external 'kernel32' name 'CreateFileA';
|
||||
function SetEndOfFile(h : longint) : longbool;
|
||||
external 'kernel32' name 'SetEndOfFile';
|
||||
stdcall;external 'kernel32' name 'SetEndOfFile';
|
||||
function GetFileType(Handle:DWORD):DWord;
|
||||
external 'kernel32' name 'GetFileType';
|
||||
stdcall;external 'kernel32' name 'GetFileType';
|
||||
function GetFileAttributes(p : pchar) : dword;
|
||||
external 'kernel32' name 'GetFileAttributesA';
|
||||
stdcall;external 'kernel32' name 'GetFileAttributesA';
|
||||
|
||||
procedure AllowSlash(p:pchar);
|
||||
var
|
||||
@ -586,13 +586,13 @@ end;
|
||||
*****************************************************************************}
|
||||
|
||||
function CreateDirectory(name : pointer;sec : pointer) : longbool;
|
||||
external 'kernel32' name 'CreateDirectoryA';
|
||||
stdcall;external 'kernel32' name 'CreateDirectoryA';
|
||||
function RemoveDirectory(name:pointer):longbool;
|
||||
external 'kernel32' name 'RemoveDirectoryA';
|
||||
stdcall;external 'kernel32' name 'RemoveDirectoryA';
|
||||
function SetCurrentDirectory(name : pointer) : longbool;
|
||||
external 'kernel32' name 'SetCurrentDirectoryA';
|
||||
stdcall;external 'kernel32' name 'SetCurrentDirectoryA';
|
||||
function GetCurrentDirectory(bufsize : longint;name : pchar) : longbool;
|
||||
external 'kernel32' name 'GetCurrentDirectoryA';
|
||||
stdcall;external 'kernel32' name 'GetCurrentDirectoryA';
|
||||
|
||||
type
|
||||
TDirFnType=function(name:pointer):longbool;
|
||||
@ -676,13 +676,13 @@ end;
|
||||
|
||||
{ Startup }
|
||||
procedure GetStartupInfo(p : pointer);
|
||||
external 'kernel32' name 'GetStartupInfoA';
|
||||
stdcall;external 'kernel32' name 'GetStartupInfoA';
|
||||
function GetStdHandle(nStdHandle:DWORD):THANDLE;
|
||||
external 'kernel32' name 'GetStdHandle';
|
||||
stdcall;external 'kernel32' name 'GetStdHandle';
|
||||
|
||||
{ command line/enviroment functions }
|
||||
function GetCommandLine : pchar;
|
||||
external 'kernel32' name 'GetCommandLineA';
|
||||
stdcall;external 'kernel32' name 'GetCommandLineA';
|
||||
|
||||
|
||||
var
|
||||
@ -887,10 +887,10 @@ end;
|
||||
|
||||
procedure install_exception_handlers;forward;
|
||||
procedure remove_exception_handlers;forward;
|
||||
procedure PascalMain;external name 'PASCALMAIN';
|
||||
procedure fpc_do_exit;external name 'FPC_DO_EXIT';
|
||||
procedure PascalMain;stdcall;external name 'PASCALMAIN';
|
||||
procedure fpc_do_exit;stdcall;external name 'FPC_DO_EXIT';
|
||||
Procedure ExitDLL(Exitcode : longint); forward;
|
||||
procedure asm_exit; external name 'asm_exit';
|
||||
procedure asm_exit; stdcall;external name 'asm_exit';
|
||||
|
||||
Procedure system_exit;
|
||||
begin
|
||||
@ -1201,7 +1201,7 @@ type
|
||||
TTopLevelExceptionFilter = function (excep : PExceptionPointers) : Longint;stdcall;
|
||||
|
||||
function SetUnhandledExceptionFilter(lpTopLevelExceptionFilter : TTopLevelExceptionFilter) : TTopLevelExceptionFilter;
|
||||
external 'kernel32' name 'SetUnhandledExceptionFilter';
|
||||
stdcall;external 'kernel32' name 'SetUnhandledExceptionFilter';
|
||||
|
||||
const
|
||||
MaxExceptionLevel = 16;
|
||||
@ -1335,12 +1335,12 @@ begin
|
||||
res := SysHandleErrorFrame(217, frame, true);
|
||||
STATUS_PRIVILEGED_INSTRUCTION:
|
||||
res := SysHandleErrorFrame(218, frame, false);
|
||||
else
|
||||
else
|
||||
begin
|
||||
if ((excep^.ExceptionRecord^.ExceptionCode and SEVERITY_ERROR) = SEVERITY_ERROR) then
|
||||
res := SysHandleErrorFrame(217, frame, true)
|
||||
else
|
||||
res := SysHandleErrorFrame(255, frame, true);
|
||||
res := SysHandleErrorFrame(255, frame, true);
|
||||
end;
|
||||
end;
|
||||
syswin32_i386_exception_handler := res;
|
||||
@ -1397,7 +1397,7 @@ end;
|
||||
****************************************************************************}
|
||||
|
||||
function MessageBox(w1:longint;l1,l2:pointer;w2:longint):longint;
|
||||
external 'user32' name 'MessageBoxA';
|
||||
stdcall;external 'user32' name 'MessageBoxA';
|
||||
|
||||
const
|
||||
ErrorBufferLength = 1024;
|
||||
@ -1530,7 +1530,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.41 2003-09-12 12:33:43 olle
|
||||
Revision 1.42 2003-09-17 15:06:36 peter
|
||||
* stdcall patch
|
||||
|
||||
Revision 1.41 2003/09/12 12:33:43 olle
|
||||
* nice-ified
|
||||
|
||||
Revision 1.40 2003/01/01 20:56:57 florian
|
||||
|
||||
@ -57,31 +57,31 @@ const
|
||||
GMEM_ZEROINIT = 64;
|
||||
|
||||
function TlsAlloc : DWord;
|
||||
external 'kernel32' name 'TlsAlloc';
|
||||
stdcall;external 'kernel32' name 'TlsAlloc';
|
||||
function TlsGetValue(dwTlsIndex : DWord) : pointer;
|
||||
external 'kernel32' name 'TlsGetValue';
|
||||
stdcall;external 'kernel32' name 'TlsGetValue';
|
||||
function TlsSetValue(dwTlsIndex : DWord;lpTlsValue : pointer) : LongBool;
|
||||
external 'kernel32' name 'TlsSetValue';
|
||||
stdcall;external 'kernel32' name 'TlsSetValue';
|
||||
function TlsFree(dwTlsIndex : DWord) : LongBool;
|
||||
external 'kernel32' name 'TlsFree';
|
||||
stdcall;external 'kernel32' name 'TlsFree';
|
||||
function CreateThread(lpThreadAttributes : pointer;
|
||||
dwStackSize : DWord; lpStartAddress : pointer;lpParameter : pointer;
|
||||
dwCreationFlags : DWord;var lpThreadId : DWord) : Dword;
|
||||
external 'kernel32' name 'CreateThread';
|
||||
stdcall;external 'kernel32' name 'CreateThread';
|
||||
procedure ExitThread(dwExitCode : DWord);
|
||||
external 'kernel32' name 'ExitThread';
|
||||
stdcall;external 'kernel32' name 'ExitThread';
|
||||
function GlobalAlloc(uFlags:DWord; dwBytes:DWORD):Pointer;
|
||||
external 'kernel32' name 'GlobalAlloc';
|
||||
function GlobalFree(hMem : Pointer):Pointer; external 'kernel32' name 'GlobalFree';
|
||||
procedure Sleep(dwMilliseconds: DWord); external 'kernel32' name 'Sleep';
|
||||
function SuspendThread (threadHandle : dword) : dword; external 'kernel32' name 'SuspendThread';
|
||||
function ResumeThread (threadHandle : dword) : dword; external 'kernel32' name 'ResumeThread';
|
||||
function TerminateThread (threadHandle : dword; var exitCode : dword) : boolean; external 'kernel32' name 'TerminateThread';
|
||||
function GetLastError : dword; external 'kernel32' name 'GetLastError';
|
||||
function WaitForSingleObject (hHandle,Milliseconds: dword): dword; external 'kernel32' name 'WaitForSingleObject';
|
||||
function ThreadSetPriority (threadHandle : dword; Prio: longint): boolean; external 'kernel32' name 'SetThreadPriority';
|
||||
function ThreadGetPriority (threadHandle : dword): Integer; external 'kernel32' name 'GetThreadPriority';
|
||||
function GetCurrentThreadHandle : dword; external 'kernel32' name 'GetCurrentThread';
|
||||
stdcall;external 'kernel32' name 'GlobalAlloc';
|
||||
function GlobalFree(hMem : Pointer):Pointer; stdcall;external 'kernel32' name 'GlobalFree';
|
||||
procedure Sleep(dwMilliseconds: DWord); stdcall;external 'kernel32' name 'Sleep';
|
||||
function WinSuspendThread (threadHandle : dword) : dword; stdcall;external 'kernel32' name 'SuspendThread';
|
||||
function WinResumeThread (threadHandle : dword) : dword; stdcall;external 'kernel32' name 'ResumeThread';
|
||||
function TerminateThread (threadHandle : dword; var exitCode : dword) : boolean; stdcall;external 'kernel32' name 'TerminateThread';
|
||||
function GetLastError : dword; stdcall;external 'kernel32' name 'GetLastError';
|
||||
function WaitForSingleObject (hHandle,Milliseconds: dword): dword; stdcall;external 'kernel32' name 'WaitForSingleObject';
|
||||
function WinThreadSetPriority (threadHandle : dword; Prio: longint): boolean; stdcall;external 'kernel32' name 'SetThreadPriority';
|
||||
function WinThreadGetPriority (threadHandle : dword): Integer; stdcall;external 'kernel32' name 'GetThreadPriority';
|
||||
function WinGetCurrentThreadHandle : dword; stdcall;external 'kernel32' name 'GetCurrentThread';
|
||||
|
||||
{*****************************************************************************
|
||||
Threadvar support
|
||||
@ -224,6 +224,18 @@ function GetCurrentThreadHandle : dword; external 'kernel32' name 'GetCurrentTh
|
||||
end;
|
||||
|
||||
|
||||
function SuspendThread (threadHandle : dword) : dword;
|
||||
begin
|
||||
SuspendThread:=WinSuspendThread(threadHandle);
|
||||
end;
|
||||
|
||||
|
||||
function ResumeThread (threadHandle : dword) : dword;
|
||||
begin
|
||||
ResumeThread:=WinResumeThread(threadHandle);
|
||||
end;
|
||||
|
||||
|
||||
function KillThread (threadHandle : dword) : dword;
|
||||
var exitCode : dword;
|
||||
begin
|
||||
@ -240,24 +252,61 @@ function GetCurrentThreadHandle : dword; external 'kernel32' name 'GetCurrentTh
|
||||
end;
|
||||
|
||||
|
||||
function ThreadSetPriority (threadHandle : dword; Prio: longint): boolean; {-15..+15, 0=normal}
|
||||
begin
|
||||
ThreadSetPriority:=WinThreadSetPriority(threadHandle,Prio);
|
||||
end;
|
||||
|
||||
|
||||
function ThreadGetPriority (threadHandle : dword): Integer;
|
||||
begin
|
||||
ThreadGetPriority:=WinThreadGetPriority(threadHandle);
|
||||
end;
|
||||
|
||||
|
||||
function GetCurrentThreadHandle : dword;
|
||||
begin
|
||||
GetCurrentThreadHandle:=WinGetCurrentThreadHandle;
|
||||
end;
|
||||
|
||||
{*****************************************************************************
|
||||
Delphi/Win32 compatibility
|
||||
*****************************************************************************}
|
||||
|
||||
{ we implement these procedures for win32 by importing them }
|
||||
{ directly from windows }
|
||||
procedure WinInitCriticalSection(var cs : TRTLCriticalSection);
|
||||
stdcall;external 'kernel32' name 'InitializeCriticalSection';
|
||||
|
||||
procedure WinDoneCriticalSection(var cs : TRTLCriticalSection);
|
||||
stdcall;external 'kernel32' name 'DeleteCriticalSection';
|
||||
|
||||
procedure WinEnterCriticalSection(var cs : TRTLCriticalSection);
|
||||
stdcall;external 'kernel32' name 'EnterCriticalSection';
|
||||
|
||||
procedure WinLeaveCriticalSection(var cs : TRTLCriticalSection);
|
||||
stdcall;external 'kernel32' name 'LeaveCriticalSection';
|
||||
|
||||
procedure InitCriticalSection(var cs : TRTLCriticalSection);
|
||||
external 'kernel32' name 'InitializeCriticalSection';
|
||||
begin
|
||||
WinInitCriticalSection(cs);
|
||||
end;
|
||||
|
||||
|
||||
procedure DoneCriticalSection(var cs : TRTLCriticalSection);
|
||||
external 'kernel32' name 'DeleteCriticalSection';
|
||||
begin
|
||||
WinDoneCriticalSection(cs);
|
||||
end;
|
||||
|
||||
|
||||
procedure EnterCriticalSection(var cs : TRTLCriticalSection);
|
||||
external 'kernel32' name 'EnterCriticalSection';
|
||||
begin
|
||||
WinEnterCriticalSection(cs);
|
||||
end;
|
||||
|
||||
|
||||
procedure LeaveCriticalSection(var cs : TRTLCriticalSection);
|
||||
external 'kernel32' name 'LeaveCriticalSection';
|
||||
begin
|
||||
WinLeaveCriticalSection(cs);
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
@ -306,7 +355,10 @@ initialization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2003-03-27 17:14:27 armin
|
||||
Revision 1.5 2003-09-17 15:06:36 peter
|
||||
* stdcall patch
|
||||
|
||||
Revision 1.4 2003/03/27 17:14:27 armin
|
||||
* more platform independent thread routines, needs to be implemented for unix
|
||||
|
||||
Revision 1.3 2003/03/24 16:12:01 jonas
|
||||
|
||||
@ -32,7 +32,7 @@ uses
|
||||
{$ENDIF}
|
||||
dos,
|
||||
windows;
|
||||
|
||||
|
||||
|
||||
{ Include platform independent interface part }
|
||||
{$i sysutilh.inc}
|
||||
@ -328,7 +328,7 @@ end;
|
||||
|
||||
function GetDiskFreeSpace(drive:pchar;var sector_cluster,bytes_sector,
|
||||
freeclusters,totalclusters:longint):longbool;
|
||||
external 'kernel32' name 'GetDiskFreeSpaceA';
|
||||
stdcall;external 'kernel32' name 'GetDiskFreeSpaceA';
|
||||
type
|
||||
{$IFDEF VIRTUALPASCAL}
|
||||
{&StdCall+}
|
||||
@ -615,7 +615,7 @@ function FormatMessageA(dwFlags : DWORD;
|
||||
dwLanguageId: DWORD;
|
||||
lpBuffer : PCHAR;
|
||||
nSize : DWORD;
|
||||
Arguments : Pointer): DWORD; external 'kernel32' name 'FormatMessageA';
|
||||
Arguments : Pointer): DWORD; stdcall;external 'kernel32' name 'FormatMessageA';
|
||||
|
||||
function SysErrorMessage(ErrorCode: Integer): String;
|
||||
const
|
||||
@ -675,13 +675,13 @@ var
|
||||
kernel32dll : THandle;
|
||||
|
||||
function FreeLibrary(hLibModule : THANDLE) : longbool;
|
||||
external 'kernel32' name 'FreeLibrary';
|
||||
stdcall;external 'kernel32' name 'FreeLibrary';
|
||||
function GetVersionEx(var VersionInformation:TOSVERSIONINFO) : longbool;
|
||||
external 'kernel32' name 'GetVersionExA';
|
||||
stdcall;external 'kernel32' name 'GetVersionExA';
|
||||
function LoadLibrary(lpLibFileName : pchar):THandle;
|
||||
external 'kernel32' name 'LoadLibraryA';
|
||||
stdcall;external 'kernel32' name 'LoadLibraryA';
|
||||
function GetProcAddress(hModule : THandle;lpProcName : pchar) : pointer;
|
||||
external 'kernel32' name 'GetProcAddress';
|
||||
stdcall;external 'kernel32' name 'GetProcAddress';
|
||||
|
||||
|
||||
Initialization
|
||||
@ -712,7 +712,10 @@ Finalization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.23 2003-09-06 22:23:35 marco
|
||||
Revision 1.24 2003-09-17 15:06:36 peter
|
||||
* stdcall patch
|
||||
|
||||
Revision 1.23 2003/09/06 22:23:35 marco
|
||||
* VP fixes.
|
||||
|
||||
Revision 1.22 2003/04/01 15:57:41 peter
|
||||
|
||||
@ -134,7 +134,7 @@ end;
|
||||
|
||||
{$IFDEF FPC}
|
||||
function WriteConsoleOutput(hConsoleOutput:HANDLE; lpBuffer:pointer; dwBufferSize:COORD; dwBufferCoord:COORD;
|
||||
var lpWriteRegion:SMALL_RECT):WINBOOL; external 'kernel32' name 'WriteConsoleOutputA';
|
||||
var lpWriteRegion:SMALL_RECT):WINBOOL; stdcall;external 'kernel32' name 'WriteConsoleOutputA';
|
||||
{$ENDIF}
|
||||
|
||||
procedure SysUpdateScreen(Force: Boolean);
|
||||
@ -276,7 +276,10 @@ initialization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.10 2002-12-15 20:22:56 peter
|
||||
Revision 1.11 2003-09-17 15:06:36 peter
|
||||
* stdcall patch
|
||||
|
||||
Revision 1.10 2002/12/15 20:22:56 peter
|
||||
* fix updatescreen compare that was wrong when the last char was
|
||||
different
|
||||
|
||||
|
||||
@ -19,6 +19,8 @@ unit windows;
|
||||
{$smartlink on}
|
||||
{$endif}
|
||||
|
||||
{$calling stdcall}
|
||||
|
||||
interface
|
||||
|
||||
{$define read_interface}
|
||||
@ -62,7 +64,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 2002-11-04 12:19:01 marco
|
||||
Revision 1.6 2003-09-17 15:06:36 peter
|
||||
* stdcall patch
|
||||
|
||||
Revision 1.5 2002/11/04 12:19:01 marco
|
||||
* Move tmsg and family to messages.inc. windows.pp needed include sequence patch
|
||||
|
||||
Revision 1.4 2002/10/10 14:58:16 florian
|
||||
|
||||
Loading…
Reference in New Issue
Block a user