mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 21:10:01 +02:00
* unified some win32/win64 code
git-svn-id: trunk@11745 -
This commit is contained in:
florian
parent
6ba813b261
commit
a8804cf2a6
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -6173,6 +6173,7 @@ rtl/win/sysos.inc svneol=native#text/plain
|
|||||||
rtl/win/sysosh.inc svneol=native#text/plain
|
rtl/win/sysosh.inc svneol=native#text/plain
|
||||||
rtl/win/systhrd.inc svneol=native#text/plain
|
rtl/win/systhrd.inc svneol=native#text/plain
|
||||||
rtl/win/sysutils.pp svneol=native#text/plain
|
rtl/win/sysutils.pp svneol=native#text/plain
|
||||||
|
rtl/win/syswin.inc svneol=native#text/plain
|
||||||
rtl/win/tthread.inc svneol=native#text/plain
|
rtl/win/tthread.inc svneol=native#text/plain
|
||||||
rtl/win/varutils.pp svneol=native#text/plain
|
rtl/win/varutils.pp svneol=native#text/plain
|
||||||
rtl/win/video.pp svneol=native#text/plain
|
rtl/win/video.pp svneol=native#text/plain
|
||||||
|
|||||||
188
rtl/win/syswin.inc
Normal file
188
rtl/win/syswin.inc
Normal file
@ -0,0 +1,188 @@
|
|||||||
|
{
|
||||||
|
This file is part of the Free Pascal run time library.
|
||||||
|
Copyright (c) 1999-2008 by Florian Klaempfl and Pavel Ozerski
|
||||||
|
member of the Free Pascal development team.
|
||||||
|
|
||||||
|
FPC Pascal system unit part shared by win32/win64.
|
||||||
|
|
||||||
|
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.
|
||||||
|
|
||||||
|
**********************************************************************}
|
||||||
|
|
||||||
|
{****************************************************************************
|
||||||
|
Error Message writing using messageboxes
|
||||||
|
****************************************************************************}
|
||||||
|
|
||||||
|
function MessageBox(w1:longint;l1,l2:pointer;w2:longint):longint;
|
||||||
|
stdcall;external 'user32' name 'MessageBoxA';
|
||||||
|
|
||||||
|
const
|
||||||
|
ErrorBufferLength = 1024;
|
||||||
|
var
|
||||||
|
ErrorBuf : array[0..ErrorBufferLength] of char;
|
||||||
|
ErrorLen : SizeInt;
|
||||||
|
|
||||||
|
Function ErrorWrite(Var F: TextRec): Integer;
|
||||||
|
{
|
||||||
|
An error message should always end with #13#10#13#10
|
||||||
|
}
|
||||||
|
var
|
||||||
|
i : SizeInt;
|
||||||
|
Begin
|
||||||
|
while F.BufPos>0 do
|
||||||
|
begin
|
||||||
|
begin
|
||||||
|
if F.BufPos+ErrorLen>ErrorBufferLength then
|
||||||
|
i:=ErrorBufferLength-ErrorLen
|
||||||
|
else
|
||||||
|
i:=F.BufPos;
|
||||||
|
Move(F.BufPtr^,ErrorBuf[ErrorLen],i);
|
||||||
|
inc(ErrorLen,i);
|
||||||
|
ErrorBuf[ErrorLen]:=#0;
|
||||||
|
end;
|
||||||
|
if ErrorLen=ErrorBufferLength then
|
||||||
|
begin
|
||||||
|
MessageBox(0,@ErrorBuf,pchar('Error'),0);
|
||||||
|
ErrorLen:=0;
|
||||||
|
end;
|
||||||
|
Dec(F.BufPos,i);
|
||||||
|
end;
|
||||||
|
ErrorWrite:=0;
|
||||||
|
End;
|
||||||
|
|
||||||
|
|
||||||
|
Function ErrorClose(Var F: TextRec): Integer;
|
||||||
|
begin
|
||||||
|
if ErrorLen>0 then
|
||||||
|
begin
|
||||||
|
MessageBox(0,@ErrorBuf,pchar('Error'),0);
|
||||||
|
ErrorLen:=0;
|
||||||
|
end;
|
||||||
|
ErrorLen:=0;
|
||||||
|
ErrorClose:=0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Function ErrorOpen(Var F: TextRec): Integer;
|
||||||
|
Begin
|
||||||
|
TextRec(F).InOutFunc:=@ErrorWrite;
|
||||||
|
TextRec(F).FlushFunc:=@ErrorWrite;
|
||||||
|
TextRec(F).CloseFunc:=@ErrorClose;
|
||||||
|
ErrorLen:=0;
|
||||||
|
ErrorOpen:=0;
|
||||||
|
End;
|
||||||
|
|
||||||
|
|
||||||
|
procedure AssignError(Var T: Text);
|
||||||
|
begin
|
||||||
|
Assign(T,'');
|
||||||
|
TextRec(T).OpenFunc:=@ErrorOpen;
|
||||||
|
Rewrite(T);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure SysInitStdIO;
|
||||||
|
begin
|
||||||
|
{ Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be
|
||||||
|
displayed in a messagebox }
|
||||||
|
StdInputHandle:=longint(GetStdHandle(cardinal(STD_INPUT_HANDLE)));
|
||||||
|
StdOutputHandle:=longint(GetStdHandle(cardinal(STD_OUTPUT_HANDLE)));
|
||||||
|
StdErrorHandle:=longint(GetStdHandle(cardinal(STD_ERROR_HANDLE)));
|
||||||
|
if not IsConsole then
|
||||||
|
begin
|
||||||
|
AssignError(stderr);
|
||||||
|
AssignError(StdOut);
|
||||||
|
Assign(Output,'');
|
||||||
|
Assign(Input,'');
|
||||||
|
Assign(ErrOutput,'');
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
OpenStdIO(Input,fmInput,StdInputHandle);
|
||||||
|
OpenStdIO(Output,fmOutput,StdOutputHandle);
|
||||||
|
OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
|
||||||
|
OpenStdIO(StdOut,fmOutput,StdOutputHandle);
|
||||||
|
OpenStdIO(StdErr,fmOutput,StdErrorHandle);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ ProcessID cached to avoid repeated calls to GetCurrentProcess. }
|
||||||
|
|
||||||
|
var
|
||||||
|
ProcessID: SizeUInt;
|
||||||
|
|
||||||
|
function GetProcessID: SizeUInt;
|
||||||
|
begin
|
||||||
|
GetProcessID := ProcessID;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{******************************************************************************
|
||||||
|
Unicode
|
||||||
|
******************************************************************************}
|
||||||
|
|
||||||
|
procedure Win32Unicode2AnsiMove(source:punicodechar;var dest:ansistring;len:SizeInt);
|
||||||
|
var
|
||||||
|
destlen: SizeInt;
|
||||||
|
begin
|
||||||
|
// retrieve length including trailing #0
|
||||||
|
// not anymore, because this must also be usable for single characters
|
||||||
|
destlen:=WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, nil, 0, nil, nil);
|
||||||
|
// this will null-terminate
|
||||||
|
setlength(dest, destlen);
|
||||||
|
WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, @dest[1], destlen, nil, nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure Win32Ansi2UnicodeMove(source:pchar;var dest:UnicodeString;len:SizeInt);
|
||||||
|
var
|
||||||
|
destlen: SizeInt;
|
||||||
|
begin
|
||||||
|
// retrieve length including trailing #0
|
||||||
|
// not anymore, because this must also be usable for single characters
|
||||||
|
destlen:=MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len, nil, 0);
|
||||||
|
// this will null-terminate
|
||||||
|
setlength(dest, destlen);
|
||||||
|
MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len, @dest[1], destlen);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function Win32UnicodeUpper(const s : UnicodeString) : UnicodeString;
|
||||||
|
begin
|
||||||
|
result:=s;
|
||||||
|
UniqueString(result);
|
||||||
|
if length(result)>0 then
|
||||||
|
CharUpperBuff(LPWSTR(result),length(result));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function Win32UnicodeLower(const s : UnicodeString) : UnicodeString;
|
||||||
|
begin
|
||||||
|
result:=s;
|
||||||
|
UniqueString(result);
|
||||||
|
if length(result)>0 then
|
||||||
|
CharLowerBuff(LPWSTR(result),length(result));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ there is a similiar procedure in sysutils which inits the fields which
|
||||||
|
are only relevant for the sysutils units }
|
||||||
|
procedure InitWin32Widestrings;
|
||||||
|
begin
|
||||||
|
{ Widestring }
|
||||||
|
widestringmanager.Wide2AnsiMoveProc:=@Win32Wide2AnsiMove;
|
||||||
|
widestringmanager.Ansi2WideMoveProc:=@Win32Ansi2WideMove;
|
||||||
|
widestringmanager.UpperWideStringProc:=@Win32WideUpper;
|
||||||
|
widestringmanager.LowerWideStringProc:=@Win32WideLower;
|
||||||
|
{$ifndef VER2_2}
|
||||||
|
{ Unicode }
|
||||||
|
widestringmanager.Unicode2AnsiMoveProc:=@Win32Unicode2AnsiMove;
|
||||||
|
widestringmanager.Ansi2UnicodeMoveProc:=@Win32Ansi2UnicodeMove;
|
||||||
|
widestringmanager.UpperUnicodeStringProc:=@Win32UnicodeUpper;
|
||||||
|
widestringmanager.LowerUnicodeStringProc:=@Win32UnicodeLower;
|
||||||
|
{$endif VER2_2}
|
||||||
|
end;
|
||||||
@ -958,253 +958,81 @@ function Win32WideLower(const s : WideString) : WideString;
|
|||||||
CharLowerBuff(LPWSTR(result),length(result));
|
CharLowerBuff(LPWSTR(result),length(result));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{******************************************************************************
|
{******************************************************************************}
|
||||||
Unicode
|
{ include code common with win64 }
|
||||||
******************************************************************************}
|
|
||||||
|
|
||||||
procedure Win32Unicode2AnsiMove(source:punicodechar;var dest:ansistring;len:SizeInt);
|
{$I syswin.inc}
|
||||||
var
|
{******************************************************************************}
|
||||||
destlen: SizeInt;
|
|
||||||
begin
|
|
||||||
// retrieve length including trailing #0
|
|
||||||
// not anymore, because this must also be usable for single characters
|
|
||||||
destlen:=WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, nil, 0, nil, nil);
|
|
||||||
// this will null-terminate
|
|
||||||
setlength(dest, destlen);
|
|
||||||
WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, @dest[1], destlen, nil, nil);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure Win32Ansi2UnicodeMove(source:pchar;var dest:UnicodeString;len:SizeInt);
|
|
||||||
var
|
|
||||||
destlen: SizeInt;
|
|
||||||
begin
|
|
||||||
// retrieve length including trailing #0
|
|
||||||
// not anymore, because this must also be usable for single characters
|
|
||||||
destlen:=MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len, nil, 0);
|
|
||||||
// this will null-terminate
|
|
||||||
setlength(dest, destlen);
|
|
||||||
MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len, @dest[1], destlen);
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
function Win32UnicodeUpper(const s : UnicodeString) : UnicodeString;
|
|
||||||
begin
|
|
||||||
result:=s;
|
|
||||||
UniqueString(result);
|
|
||||||
if length(result)>0 then
|
|
||||||
CharUpperBuff(LPWSTR(result),length(result));
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
function Win32UnicodeLower(const s : UnicodeString) : UnicodeString;
|
|
||||||
begin
|
|
||||||
result:=s;
|
|
||||||
UniqueString(result);
|
|
||||||
if length(result)>0 then
|
|
||||||
CharLowerBuff(LPWSTR(result),length(result));
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
{ there is a similiar procedure in sysutils which inits the fields which
|
|
||||||
are only relevant for the sysutils units }
|
|
||||||
procedure InitWin32Widestrings;
|
|
||||||
begin
|
|
||||||
{ Widestring }
|
|
||||||
widestringmanager.Wide2AnsiMoveProc:=@Win32Wide2AnsiMove;
|
|
||||||
widestringmanager.Ansi2WideMoveProc:=@Win32Ansi2WideMove;
|
|
||||||
widestringmanager.UpperWideStringProc:=@Win32WideUpper;
|
|
||||||
widestringmanager.LowerWideStringProc:=@Win32WideLower;
|
|
||||||
{$ifndef VER2_2}
|
|
||||||
{ Unicode }
|
|
||||||
widestringmanager.Unicode2AnsiMoveProc:=@Win32Unicode2AnsiMove;
|
|
||||||
widestringmanager.Ansi2UnicodeMoveProc:=@Win32Ansi2UnicodeMove;
|
|
||||||
widestringmanager.UpperUnicodeStringProc:=@Win32UnicodeUpper;
|
|
||||||
widestringmanager.LowerUnicodeStringProc:=@Win32UnicodeLower;
|
|
||||||
{$endif VER2_2}
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
{****************************************************************************
|
|
||||||
Error Message writing using messageboxes
|
|
||||||
****************************************************************************}
|
|
||||||
|
|
||||||
function MessageBox(w1:longint;l1,l2:pointer;w2:longint):longint;
|
|
||||||
stdcall;external 'user32' name 'MessageBoxA';
|
|
||||||
|
|
||||||
const
|
|
||||||
ErrorBufferLength = 1024;
|
|
||||||
var
|
|
||||||
ErrorBuf : array[0..ErrorBufferLength] of char;
|
|
||||||
ErrorLen : longint;
|
|
||||||
|
|
||||||
Function ErrorWrite(Var F: TextRec): Integer;
|
|
||||||
{
|
|
||||||
An error message should always end with #13#10#13#10
|
|
||||||
}
|
|
||||||
var
|
|
||||||
i : longint;
|
|
||||||
Begin
|
|
||||||
while F.BufPos>0 do
|
|
||||||
begin
|
|
||||||
begin
|
|
||||||
if F.BufPos+ErrorLen>ErrorBufferLength then
|
|
||||||
i:=ErrorBufferLength-ErrorLen
|
|
||||||
else
|
|
||||||
i:=F.BufPos;
|
|
||||||
Move(F.BufPtr^,ErrorBuf[ErrorLen],i);
|
|
||||||
inc(ErrorLen,i);
|
|
||||||
ErrorBuf[ErrorLen]:=#0;
|
|
||||||
end;
|
|
||||||
if ErrorLen=ErrorBufferLength then
|
|
||||||
begin
|
|
||||||
MessageBox(0,@ErrorBuf,pchar('Error'),0);
|
|
||||||
ErrorLen:=0;
|
|
||||||
end;
|
|
||||||
Dec(F.BufPos,i);
|
|
||||||
end;
|
|
||||||
ErrorWrite:=0;
|
|
||||||
End;
|
|
||||||
|
|
||||||
|
|
||||||
Function ErrorClose(Var F: TextRec): Integer;
|
|
||||||
begin
|
|
||||||
if ErrorLen>0 then
|
|
||||||
begin
|
|
||||||
MessageBox(0,@ErrorBuf,pchar('Error'),0);
|
|
||||||
ErrorLen:=0;
|
|
||||||
end;
|
|
||||||
ErrorLen:=0;
|
|
||||||
ErrorClose:=0;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
Function ErrorOpen(Var F: TextRec): Integer;
|
|
||||||
Begin
|
|
||||||
TextRec(F).InOutFunc:=@ErrorWrite;
|
|
||||||
TextRec(F).FlushFunc:=@ErrorWrite;
|
|
||||||
TextRec(F).CloseFunc:=@ErrorClose;
|
|
||||||
ErrorLen:=0;
|
|
||||||
ErrorOpen:=0;
|
|
||||||
End;
|
|
||||||
|
|
||||||
|
|
||||||
procedure AssignError(Var T: Text);
|
|
||||||
begin
|
|
||||||
Assign(T,'');
|
|
||||||
TextRec(T).OpenFunc:=@ErrorOpen;
|
|
||||||
Rewrite(T);
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure SysInitStdIO;
|
|
||||||
begin
|
|
||||||
{ Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be
|
|
||||||
displayed in a messagebox }
|
|
||||||
StdInputHandle:=longint(GetStdHandle(cardinal(STD_INPUT_HANDLE)));
|
|
||||||
StdOutputHandle:=longint(GetStdHandle(cardinal(STD_OUTPUT_HANDLE)));
|
|
||||||
StdErrorHandle:=longint(GetStdHandle(cardinal(STD_ERROR_HANDLE)));
|
|
||||||
if not IsConsole then
|
|
||||||
begin
|
|
||||||
AssignError(stderr);
|
|
||||||
AssignError(StdOut);
|
|
||||||
Assign(Output,'');
|
|
||||||
Assign(Input,'');
|
|
||||||
Assign(ErrOutput,'');
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
OpenStdIO(Input,fmInput,StdInputHandle);
|
|
||||||
OpenStdIO(Output,fmOutput,StdOutputHandle);
|
|
||||||
OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
|
|
||||||
OpenStdIO(StdOut,fmOutput,StdOutputHandle);
|
|
||||||
OpenStdIO(StdErr,fmOutput,StdErrorHandle);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
{ ProcessID cached to avoid repeated calls to GetCurrentProcess. }
|
|
||||||
|
|
||||||
var
|
|
||||||
ProcessID: SizeUInt;
|
|
||||||
|
|
||||||
function GetProcessID: SizeUInt;
|
|
||||||
begin
|
|
||||||
GetProcessID := ProcessID;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
|
function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
|
||||||
type
|
type
|
||||||
tdosheader = packed record
|
tdosheader = packed record
|
||||||
e_magic : word;
|
e_magic : word;
|
||||||
e_cblp : word;
|
e_cblp : word;
|
||||||
e_cp : word;
|
e_cp : word;
|
||||||
e_crlc : word;
|
e_crlc : word;
|
||||||
e_cparhdr : word;
|
e_cparhdr : word;
|
||||||
e_minalloc : word;
|
e_minalloc : word;
|
||||||
e_maxalloc : word;
|
e_maxalloc : word;
|
||||||
e_ss : word;
|
e_ss : word;
|
||||||
e_sp : word;
|
e_sp : word;
|
||||||
e_csum : word;
|
e_csum : word;
|
||||||
e_ip : word;
|
e_ip : word;
|
||||||
e_cs : word;
|
e_cs : word;
|
||||||
e_lfarlc : word;
|
e_lfarlc : word;
|
||||||
e_ovno : word;
|
e_ovno : word;
|
||||||
e_res : array[0..3] of word;
|
e_res : array[0..3] of word;
|
||||||
e_oemid : word;
|
e_oemid : word;
|
||||||
e_oeminfo : word;
|
e_oeminfo : word;
|
||||||
e_res2 : array[0..9] of word;
|
e_res2 : array[0..9] of word;
|
||||||
e_lfanew : longint;
|
e_lfanew : longint;
|
||||||
end;
|
end;
|
||||||
tpeheader = packed record
|
tpeheader = packed record
|
||||||
PEMagic : longint;
|
PEMagic : longint;
|
||||||
Machine : word;
|
Machine : word;
|
||||||
NumberOfSections : word;
|
NumberOfSections : word;
|
||||||
TimeDateStamp : longint;
|
TimeDateStamp : longint;
|
||||||
PointerToSymbolTable : longint;
|
PointerToSymbolTable : longint;
|
||||||
NumberOfSymbols : longint;
|
NumberOfSymbols : longint;
|
||||||
SizeOfOptionalHeader : word;
|
SizeOfOptionalHeader : word;
|
||||||
Characteristics : word;
|
Characteristics : word;
|
||||||
Magic : word;
|
Magic : word;
|
||||||
MajorLinkerVersion : byte;
|
MajorLinkerVersion : byte;
|
||||||
MinorLinkerVersion : byte;
|
MinorLinkerVersion : byte;
|
||||||
SizeOfCode : longint;
|
SizeOfCode : longint;
|
||||||
SizeOfInitializedData : longint;
|
SizeOfInitializedData : longint;
|
||||||
SizeOfUninitializedData : longint;
|
SizeOfUninitializedData : longint;
|
||||||
AddressOfEntryPoint : longint;
|
AddressOfEntryPoint : longint;
|
||||||
BaseOfCode : longint;
|
BaseOfCode : longint;
|
||||||
BaseOfData : longint;
|
BaseOfData : longint;
|
||||||
ImageBase : longint;
|
ImageBase : longint;
|
||||||
SectionAlignment : longint;
|
SectionAlignment : longint;
|
||||||
FileAlignment : longint;
|
FileAlignment : longint;
|
||||||
MajorOperatingSystemVersion : word;
|
MajorOperatingSystemVersion : word;
|
||||||
MinorOperatingSystemVersion : word;
|
MinorOperatingSystemVersion : word;
|
||||||
MajorImageVersion : word;
|
MajorImageVersion : word;
|
||||||
MinorImageVersion : word;
|
MinorImageVersion : word;
|
||||||
MajorSubsystemVersion : word;
|
MajorSubsystemVersion : word;
|
||||||
MinorSubsystemVersion : word;
|
MinorSubsystemVersion : word;
|
||||||
Reserved1 : longint;
|
Reserved1 : longint;
|
||||||
SizeOfImage : longint;
|
SizeOfImage : longint;
|
||||||
SizeOfHeaders : longint;
|
SizeOfHeaders : longint;
|
||||||
CheckSum : longint;
|
CheckSum : longint;
|
||||||
Subsystem : word;
|
Subsystem : word;
|
||||||
DllCharacteristics : word;
|
DllCharacteristics : word;
|
||||||
SizeOfStackReserve : longint;
|
SizeOfStackReserve : longint;
|
||||||
SizeOfStackCommit : longint;
|
SizeOfStackCommit : longint;
|
||||||
SizeOfHeapReserve : longint;
|
SizeOfHeapReserve : longint;
|
||||||
SizeOfHeapCommit : longint;
|
SizeOfHeapCommit : longint;
|
||||||
LoaderFlags : longint;
|
LoaderFlags : longint;
|
||||||
NumberOfRvaAndSizes : longint;
|
NumberOfRvaAndSizes : longint;
|
||||||
DataDirectory : array[1..$80] of byte;
|
DataDirectory : array[1..$80] of byte;
|
||||||
end;
|
end;
|
||||||
begin
|
begin
|
||||||
result:=tpeheader((pointer(SysInstance)+(tdosheader(pointer(SysInstance)^).e_lfanew))^).SizeOfStackReserve;
|
result:=tpeheader((pointer(SysInstance)+(tdosheader(pointer(SysInstance)^).e_lfanew))^).SizeOfStackReserve;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{
|
|
||||||
const
|
|
||||||
Exe_entry_code : pointer = @Exe_entry;
|
|
||||||
Dll_entry_code : pointer = @Dll_entry;
|
|
||||||
}
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
{ get some helpful informations }
|
{ get some helpful informations }
|
||||||
|
|||||||
@ -996,127 +996,11 @@ function Win32WideLower(const s : WideString) : WideString;
|
|||||||
CharLowerBuff(LPWSTR(result),length(result));
|
CharLowerBuff(LPWSTR(result),length(result));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{******************************************************************************}
|
||||||
|
{ include code common with win64 }
|
||||||
|
|
||||||
{ there is a similiar procedure in sysutils which inits the fields which
|
{$I syswin.inc}
|
||||||
are only relevant for the sysutils units }
|
{******************************************************************************}
|
||||||
procedure InitWin32Widestrings;
|
|
||||||
begin
|
|
||||||
widestringmanager.Wide2AnsiMoveProc:=@Win32Wide2AnsiMove;
|
|
||||||
widestringmanager.Ansi2WideMoveProc:=@Win32Ansi2WideMove;
|
|
||||||
widestringmanager.UpperWideStringProc:=@Win32WideUpper;
|
|
||||||
widestringmanager.LowerWideStringProc:=@Win32WideLower;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
{****************************************************************************
|
|
||||||
Error Message writing using messageboxes
|
|
||||||
****************************************************************************}
|
|
||||||
|
|
||||||
function MessageBox(w1:longint;l1,l2:pointer;w2:longint):longint;
|
|
||||||
stdcall;external 'user32' name 'MessageBoxA';
|
|
||||||
|
|
||||||
const
|
|
||||||
ErrorBufferLength = 1024;
|
|
||||||
var
|
|
||||||
ErrorBuf : array[0..ErrorBufferLength] of char;
|
|
||||||
ErrorLen : longint;
|
|
||||||
|
|
||||||
Function ErrorWrite(Var F: TextRec): Integer;
|
|
||||||
{
|
|
||||||
An error message should always end with #13#10#13#10
|
|
||||||
}
|
|
||||||
var
|
|
||||||
p : pchar;
|
|
||||||
i : longint;
|
|
||||||
Begin
|
|
||||||
while F.BufPos>0 do
|
|
||||||
begin
|
|
||||||
begin
|
|
||||||
if F.BufPos+ErrorLen>ErrorBufferLength then
|
|
||||||
i:=ErrorBufferLength-ErrorLen
|
|
||||||
else
|
|
||||||
i:=F.BufPos;
|
|
||||||
Move(F.BufPtr^,ErrorBuf[ErrorLen],i);
|
|
||||||
inc(ErrorLen,i);
|
|
||||||
ErrorBuf[ErrorLen]:=#0;
|
|
||||||
end;
|
|
||||||
if ErrorLen=ErrorBufferLength then
|
|
||||||
begin
|
|
||||||
MessageBox(0,@ErrorBuf,pchar('Error'),0);
|
|
||||||
ErrorLen:=0;
|
|
||||||
end;
|
|
||||||
Dec(F.BufPos,i);
|
|
||||||
end;
|
|
||||||
ErrorWrite:=0;
|
|
||||||
End;
|
|
||||||
|
|
||||||
|
|
||||||
Function ErrorClose(Var F: TextRec): Integer;
|
|
||||||
begin
|
|
||||||
if ErrorLen>0 then
|
|
||||||
begin
|
|
||||||
MessageBox(0,@ErrorBuf,pchar('Error'),0);
|
|
||||||
ErrorLen:=0;
|
|
||||||
end;
|
|
||||||
ErrorLen:=0;
|
|
||||||
ErrorClose:=0;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
Function ErrorOpen(Var F: TextRec): Integer;
|
|
||||||
Begin
|
|
||||||
TextRec(F).InOutFunc:=@ErrorWrite;
|
|
||||||
TextRec(F).FlushFunc:=@ErrorWrite;
|
|
||||||
TextRec(F).CloseFunc:=@ErrorClose;
|
|
||||||
ErrorLen:=0;
|
|
||||||
ErrorOpen:=0;
|
|
||||||
End;
|
|
||||||
|
|
||||||
|
|
||||||
procedure AssignError(Var T: Text);
|
|
||||||
begin
|
|
||||||
Assign(T,'');
|
|
||||||
TextRec(T).OpenFunc:=@ErrorOpen;
|
|
||||||
Rewrite(T);
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure SysInitStdIO;
|
|
||||||
begin
|
|
||||||
{ Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be
|
|
||||||
displayed in a messagebox }
|
|
||||||
StdInputHandle:=THandle(GetStdHandle(STD_INPUT_HANDLE));
|
|
||||||
StdOutputHandle:=THandle(GetStdHandle(STD_OUTPUT_HANDLE));
|
|
||||||
StdErrorHandle:=THandle(GetStdHandle(STD_ERROR_HANDLE));
|
|
||||||
if not IsConsole then
|
|
||||||
begin
|
|
||||||
AssignError(stderr);
|
|
||||||
AssignError(StdOut);
|
|
||||||
Assign(Output,'');
|
|
||||||
Assign(Input,'');
|
|
||||||
Assign(ErrOutput,'');
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
OpenStdIO(Input,fmInput,StdInputHandle);
|
|
||||||
OpenStdIO(Output,fmOutput,StdOutputHandle);
|
|
||||||
OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
|
|
||||||
OpenStdIO(StdOut,fmOutput,StdOutputHandle);
|
|
||||||
OpenStdIO(StdErr,fmOutput,StdErrorHandle);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
(* ProcessID cached to avoid repeated calls to GetCurrentProcess. *)
|
|
||||||
|
|
||||||
var
|
|
||||||
ProcessID: SizeUInt;
|
|
||||||
|
|
||||||
function GetProcessID: SizeUInt;
|
|
||||||
begin
|
|
||||||
GetProcessID := ProcessID;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;assembler;
|
function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;assembler;
|
||||||
asm
|
asm
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user