mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-27 15:30:26 +02:00
--- Merging r30653 into '.':
U rtl/inc/fexpand.inc --- Recording mergeinfo for merge of r30653 into '.': U . --- Merging r30654 into '.': U tests/test/units/dos/tfexpand.pp --- Recording mergeinfo for merge of r30654 into '.': G . --- Merging r30774 into '.': G tests/test/units/dos/tfexpand.pp --- Recording mergeinfo for merge of r30774 into '.': G . --- Merging r30788 into '.': U rtl/amiga/system.pp --- Recording mergeinfo for merge of r30788 into '.': G . --- Merging r30789 into '.': U rtl/morphos/system.pp --- Recording mergeinfo for merge of r30789 into '.': G . --- Merging r30790 into '.': U packages/fcl-process/fpmake.pp A packages/fcl-process/src/amicommon A packages/fcl-process/src/amicommon/process.inc A packages/fcl-process/src/amicommon/pipes.inc A packages/fcl-process/src/amicommon/simpleipc.inc --- Recording mergeinfo for merge of r30790 into '.': G . --- Merging r30803 into '.': U packages/fcl-process/src/amicommon/simpleipc.inc --- Recording mergeinfo for merge of r30803 into '.': G . --- Merging r30805 into '.': U packages/fcl-process/src/amicommon/process.inc U packages/fcl-process/src/amicommon/pipes.inc --- Recording mergeinfo for merge of r30805 into '.': G . --- Merging r30806 into '.': G packages/fcl-process/src/amicommon/process.inc G packages/fcl-process/src/amicommon/pipes.inc --- Recording mergeinfo for merge of r30806 into '.': G . --- Merging r30812 into '.': U packages/morphunits/src/amigados.pas U packages/amunits/src/coreunits/amigados.pas G packages/fcl-process/src/amicommon/process.inc G packages/fcl-process/src/amicommon/pipes.inc U packages/arosunits/src/amigados.pas --- Recording mergeinfo for merge of r30812 into '.': G . --- Merging r30813 into '.': U rtl/aros/system.pp --- Recording mergeinfo for merge of r30813 into '.': G . # revisions: 30653,30654,30774,30788,30789,30790,30803,30805,30806,30812,30813 git-svn-id: branches/fixes_3_0@31082 -
This commit is contained in:
parent
e58f7faae9
commit
3605c0655a
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -2529,6 +2529,9 @@ packages/fcl-process/Makefile svneol=native#text/plain
|
|||||||
packages/fcl-process/Makefile.fpc svneol=native#text/plain
|
packages/fcl-process/Makefile.fpc svneol=native#text/plain
|
||||||
packages/fcl-process/Makefile.fpc.fpcmake svneol=native#text/plain
|
packages/fcl-process/Makefile.fpc.fpcmake svneol=native#text/plain
|
||||||
packages/fcl-process/fpmake.pp svneol=native#text/plain
|
packages/fcl-process/fpmake.pp svneol=native#text/plain
|
||||||
|
packages/fcl-process/src/amicommon/pipes.inc svneol=native#text/plain
|
||||||
|
packages/fcl-process/src/amicommon/process.inc svneol=native#text/plain
|
||||||
|
packages/fcl-process/src/amicommon/simpleipc.inc svneol=native#text/plain
|
||||||
packages/fcl-process/src/dbugintf.pp svneol=native#text/plain
|
packages/fcl-process/src/dbugintf.pp svneol=native#text/plain
|
||||||
packages/fcl-process/src/dbugmsg.pp svneol=native#text/plain
|
packages/fcl-process/src/dbugmsg.pp svneol=native#text/plain
|
||||||
packages/fcl-process/src/dummy/pipes.inc svneol=native#text/plain
|
packages/fcl-process/src/dummy/pipes.inc svneol=native#text/plain
|
||||||
|
@ -1598,7 +1598,7 @@ FUNCTION CreateProc(const name : pCHAR location 'd1'; pri : LONGINT location 'd2
|
|||||||
FUNCTION CurrentDir(lock : LONGINT location 'd1') : LONGINT; syscall _DOSBase 126;
|
FUNCTION CurrentDir(lock : LONGINT location 'd1') : LONGINT; syscall _DOSBase 126;
|
||||||
PROCEDURE DateStamp(date : pDateStamp location 'd1'); syscall _DOSBase 192;
|
PROCEDURE DateStamp(date : pDateStamp location 'd1'); syscall _DOSBase 192;
|
||||||
FUNCTION DateToStr(datetime : pDateTime location 'd1') : LongBool; syscall _DOSBase 744;
|
FUNCTION DateToStr(datetime : pDateTime location 'd1') : LongBool; syscall _DOSBase 744;
|
||||||
FUNCTION DeleteFile(const name : pCHAR location 'd1') : LongBool; syscall _DOSBase 072;
|
FUNCTION DOSDeleteFile(const name : pCHAR location 'd1') : LongBool; syscall _DOSBase 072;
|
||||||
FUNCTION DeleteVar(const name : pCHAR location 'd1'; flags : ULONG location 'd2') : LongBool; syscall _DOSBase 912;
|
FUNCTION DeleteVar(const name : pCHAR location 'd1'; flags : ULONG location 'd2') : LongBool; syscall _DOSBase 912;
|
||||||
FUNCTION DeviceProc(const name : pCHAR location 'd1') : pMsgPort; syscall _DOSBase 174;
|
FUNCTION DeviceProc(const name : pCHAR location 'd1') : pMsgPort; syscall _DOSBase 174;
|
||||||
FUNCTION DoPkt(port : pMsgPort location 'd1'; action : LONGINT location 'd2'; arg1 : LONGINT location 'd3'; arg2 : LONGINT location 'd4'; arg3 : LONGINT location 'd5'; arg4 : LONGINT location 'd6'; arg5 : LONGINT location 'd7') : LONGINT; syscall _DOSBase 240;
|
FUNCTION DoPkt(port : pMsgPort location 'd1'; action : LONGINT location 'd2'; arg1 : LONGINT location 'd3'; arg2 : LONGINT location 'd4'; arg3 : LONGINT location 'd5'; arg4 : LONGINT location 'd6'; arg5 : LONGINT location 'd7') : LONGINT; syscall _DOSBase 240;
|
||||||
@ -1756,7 +1756,7 @@ FUNCTION AssignPath(const name : pCHAR;const path : string) : BOOLEAN;
|
|||||||
FUNCTION AssignPath(const name : string;const path : string) : BOOLEAN;
|
FUNCTION AssignPath(const name : string;const path : string) : BOOLEAN;
|
||||||
FUNCTION CreateDir(const name : string) : LONGINT;
|
FUNCTION CreateDir(const name : string) : LONGINT;
|
||||||
FUNCTION CreateProc(const name : string; pri : LONGINT; segList : LONGINT; stackSize : LONGINT) : pMsgPort;
|
FUNCTION CreateProc(const name : string; pri : LONGINT; segList : LONGINT; stackSize : LONGINT) : pMsgPort;
|
||||||
FUNCTION DeleteFile(const name : string) : BOOLEAN;
|
FUNCTION DOSDeleteFile(const name : string) : BOOLEAN;
|
||||||
FUNCTION DeleteVar(const name : string; flags : ULONG) : BOOLEAN;
|
FUNCTION DeleteVar(const name : string; flags : ULONG) : BOOLEAN;
|
||||||
FUNCTION DeviceProc(const name : string) : pMsgPort;
|
FUNCTION DeviceProc(const name : string) : pMsgPort;
|
||||||
FUNCTION DOSOpen(const name : string; accessMode : LONGINT) : LONGINT;
|
FUNCTION DOSOpen(const name : string; accessMode : LONGINT) : LONGINT;
|
||||||
@ -1904,9 +1904,9 @@ begin
|
|||||||
CreateProc := CreateProc(pas2c(name),pri,segList,stackSize);
|
CreateProc := CreateProc(pas2c(name),pri,segList,stackSize);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
FUNCTION DeleteFile(const name : string) : BOOLEAN;
|
FUNCTION DOSDeleteFile(const name : string) : BOOLEAN;
|
||||||
begin
|
begin
|
||||||
DeleteFile := DeleteFile(pas2c(name));
|
DOSDeleteFile := DOSDeleteFile(pas2c(name));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
FUNCTION DeleteVar(const name : string; flags : ULONG) : BOOLEAN;
|
FUNCTION DeleteVar(const name : string; flags : ULONG) : BOOLEAN;
|
||||||
|
@ -2265,14 +2265,14 @@ function Cli: PCommandLineInterface; syscall AOS_DOSBase 82;
|
|||||||
function CliInitNewcli(Dp: PDosPacket): IPTR; syscall AOS_DOSBase 155;
|
function CliInitNewcli(Dp: PDosPacket): IPTR; syscall AOS_DOSBase 155;
|
||||||
function CliInitRun(Dp: PDosPacket): IPTR; syscall AOS_DOSBase 156;
|
function CliInitRun(Dp: PDosPacket): IPTR; syscall AOS_DOSBase 156;
|
||||||
function CompareDates(const Date1: PDateStamp; const Date2: PDateStamp): LongInt; syscall AOS_DOSBase 123;
|
function CompareDates(const Date1: PDateStamp; const Date2: PDateStamp): LongInt; syscall AOS_DOSBase 123;
|
||||||
function CreateDir(const Name: STRPTR): BPTR; syscall AOS_DOSBase 20;
|
function DOSCreateDir(const Name: STRPTR): BPTR; syscall AOS_DOSBase 20;
|
||||||
function CreateNewProc(const Tags: PTagItem): PProcess; syscall AOS_DOSBase 83;
|
function CreateNewProc(const Tags: PTagItem): PProcess; syscall AOS_DOSBase 83;
|
||||||
//function CreateNewProcTagList(const Tags : PTagItem) : pProcess;
|
//function CreateNewProcTagList(const Tags : PTagItem) : pProcess;
|
||||||
function CreateProc(const Name: STRPTR; Pri: LongInt; SegList: BPTR; StackSize: LongInt): PMsgPort; syscall AOS_DOSBase 23;
|
function CreateProc(const Name: STRPTR; Pri: LongInt; SegList: BPTR; StackSize: LongInt): PMsgPort; syscall AOS_DOSBase 23;
|
||||||
function CurrentDir(Lock: BPTR): BPTR; syscall AOS_DOSBase 21;
|
function CurrentDir(Lock: BPTR): BPTR; syscall AOS_DOSBase 21;
|
||||||
function DateStamp(Date: PDateStamp): PDateStamp; syscall AOS_DOSBase 32;
|
function DateStamp(Date: PDateStamp): PDateStamp; syscall AOS_DOSBase 32;
|
||||||
function DateToStr(Datetime: PDateTime): LongBool; syscall AOS_DOSBase 124;
|
function DateToStr(Datetime: PDateTime): LongBool; syscall AOS_DOSBase 124;
|
||||||
function DeleteFile(const Name: STRPTR): LongBool; syscall AOS_DOSBase 12;
|
function DOSDeleteFile(const Name: STRPTR): LongBool; syscall AOS_DOSBase 12;
|
||||||
function DeleteVar(const Name: STRPTR; Flags: LongWord): LongInt; syscall AOS_DOSBase 152;
|
function DeleteVar(const Name: STRPTR; Flags: LongWord): LongInt; syscall AOS_DOSBase 152;
|
||||||
function DeviceProc(const Name: STRPTR): PMsgPort; syscall AOS_DOSBase 29;
|
function DeviceProc(const Name: STRPTR): PMsgPort; syscall AOS_DOSBase 29;
|
||||||
function DisplayError(FormstStr: STRPTR; Flags: LongWord; Args: APTR): LongInt; syscall AOS_DOSBase 81;
|
function DisplayError(FormstStr: STRPTR; Flags: LongWord; Args: APTR): LongInt; syscall AOS_DOSBase 81;
|
||||||
|
@ -30,8 +30,13 @@ begin
|
|||||||
P.SourcePath.Add('src');
|
P.SourcePath.Add('src');
|
||||||
P.IncludePath.Add('src/unix',AllUnixOSes);
|
P.IncludePath.Add('src/unix',AllUnixOSes);
|
||||||
P.IncludePath.Add('src/win',[win32,win64]);
|
P.IncludePath.Add('src/win',[win32,win64]);
|
||||||
P.IncludePath.Add('src/$(OS)',AllOSes-[win32,win64]-AllUnixOSes);
|
P.IncludePath.Add('src/amicommon',AllAmigaLikeOSes);
|
||||||
P.IncludePath.Add('src/dummy',AllOSes-[win32,win64]-AllUnixOSes);
|
P.IncludePath.Add('src/$(OS)',AllOSes-[win32,win64]-AllUnixOSes-AllAmigaLikeOSes);
|
||||||
|
P.IncludePath.Add('src/dummy',AllOSes-[win32,win64]-AllUnixOSes-AllAmigaLikeOSes);
|
||||||
|
|
||||||
|
P.Dependencies.add('morphunits',[morphos]);
|
||||||
|
P.Dependencies.add('arosunits',[aros]);
|
||||||
|
P.Dependencies.add('amunits',[amiga]);
|
||||||
|
|
||||||
T:=P.Targets.AddUnit('pipes.pp');
|
T:=P.Targets.AddUnit('pipes.pp');
|
||||||
T.Dependencies.AddInclude('pipes.inc');
|
T.Dependencies.AddInclude('pipes.inc');
|
||||||
|
57
packages/fcl-process/src/amicommon/pipes.inc
Normal file
57
packages/fcl-process/src/amicommon/pipes.inc
Normal file
@ -0,0 +1,57 @@
|
|||||||
|
{
|
||||||
|
This file is part of the Free Pascal run time library.
|
||||||
|
Copyright (c) 1999-2000 by Michael Van Canneyt
|
||||||
|
|
||||||
|
DOS/go32v2 specific part of pipe stream.
|
||||||
|
|
||||||
|
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.
|
||||||
|
|
||||||
|
**********************************************************************}
|
||||||
|
|
||||||
|
uses
|
||||||
|
exec, AmigaDos;
|
||||||
|
|
||||||
|
// No pipes under dos, sorry...
|
||||||
|
|
||||||
|
Function CreatePipeHandles (Var Inhandle,OutHandle : THandle; APipeBufferSize : Cardinal = 1024) : Boolean;
|
||||||
|
begin
|
||||||
|
InHandle := THandle (UnusedHandle);
|
||||||
|
OutHandle := THandle (UnusedHandle);
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Function TInputPipeStream.GetNumBytesAvailable: DWord;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TInputPipeStream.GetPosition: Int64;
|
||||||
|
begin
|
||||||
|
Result:=FPos;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TInputPipeStream.InvalidSeek;
|
||||||
|
begin
|
||||||
|
Raise EPipeSeek.Create (ENoSeekMsg);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure PipeClose (const FHandle: THandle);
|
||||||
|
var
|
||||||
|
Filename: array[0..255] of Char;
|
||||||
|
DeleteIt: Boolean;
|
||||||
|
begin
|
||||||
|
if (FHandle <> UnusedHandle) and (FHandle <> 0) then
|
||||||
|
begin
|
||||||
|
DeleteIt := NameFromFH(BPTR(FHandle), @(Filename[0]), 255);
|
||||||
|
FileClose(FHandle);
|
||||||
|
if DeleteIt then
|
||||||
|
AmigaDos.dosDeleteFile(@(Filename[0]));
|
||||||
|
end;
|
||||||
|
end;
|
165
packages/fcl-process/src/amicommon/process.inc
Normal file
165
packages/fcl-process/src/amicommon/process.inc
Normal file
@ -0,0 +1,165 @@
|
|||||||
|
{
|
||||||
|
Dummy process.inc - the simplest version based on SysUtils.ExecuteProcess
|
||||||
|
}
|
||||||
|
|
||||||
|
uses
|
||||||
|
Exec, AmigaDos, Utility;
|
||||||
|
|
||||||
|
Resourcestring
|
||||||
|
SNoCommandLine = 'Cannot execute empty command-line';
|
||||||
|
SErrCannotExecute = 'Failed to execute %s : %d';
|
||||||
|
SErrNoSuchProgram = 'Executable not found: "%s"';
|
||||||
|
|
||||||
|
|
||||||
|
procedure TProcess.CloseProcessHandles;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function TProcess.PeekExitStatus : Boolean;
|
||||||
|
begin
|
||||||
|
Result := true; (* Dummy version assumes always synchronous execution *)
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetNextWordPos (const S: string): integer;
|
||||||
|
const
|
||||||
|
WhiteSpace = [' ', #9, #10, #13];
|
||||||
|
Literals = ['"', ''''];
|
||||||
|
var
|
||||||
|
WStart: integer;
|
||||||
|
InLiteral: boolean;
|
||||||
|
LastLiteral: char;
|
||||||
|
begin
|
||||||
|
WStart := 1;
|
||||||
|
(* Skip whitespaces at the beginning *)
|
||||||
|
while (WStart <= Length (S)) and (S [WStart] in WhiteSpace) do
|
||||||
|
Inc (WStart);
|
||||||
|
InLiteral := false;
|
||||||
|
LastLiteral := #0;
|
||||||
|
while (WStart <= Length (S)) and
|
||||||
|
(not (S [WStart] in WhiteSpace) or InLiteral) do
|
||||||
|
begin
|
||||||
|
if S [WStart] in Literals then
|
||||||
|
if InLiteral then
|
||||||
|
InLiteral := not (S [WStart] = LastLiteral)
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
InLiteral := true;
|
||||||
|
LastLiteral := S [WStart];
|
||||||
|
end;
|
||||||
|
Inc (WStart);
|
||||||
|
end;
|
||||||
|
(* Skip whitespaces at the end *)
|
||||||
|
while (WStart <= Length (S)) and (S [WStart] in WhiteSpace) do
|
||||||
|
Inc (WStart);
|
||||||
|
Result := WStart;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function MaybeQuote (const S: string): string;
|
||||||
|
begin
|
||||||
|
if (Pos (' ', S) <> 0) then
|
||||||
|
Result := '"' + S + '"'
|
||||||
|
else
|
||||||
|
Result := S;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
UID: Integer = 0;
|
||||||
|
|
||||||
|
Procedure TProcess.Execute;
|
||||||
|
var
|
||||||
|
I: integer;
|
||||||
|
ExecName, FoundName: string;
|
||||||
|
E2: EProcess;
|
||||||
|
OrigDir: string;
|
||||||
|
Params: string;
|
||||||
|
TempName: string;
|
||||||
|
cos: BPTR;
|
||||||
|
begin
|
||||||
|
if (ApplicationName = '') and (CommandLine = '') and (Executable = '') then
|
||||||
|
raise EProcess.Create (SNoCommandline);
|
||||||
|
if (FApplicationName <> '') then
|
||||||
|
ExecName := FApplicationName;
|
||||||
|
if (FCommandLine <> '') then
|
||||||
|
begin
|
||||||
|
Params := FCommandLine;
|
||||||
|
if ExecName = '' then
|
||||||
|
begin
|
||||||
|
I := GetNextWordPos (Params);
|
||||||
|
ExecName := Copy (Params, 1, Pred (I));
|
||||||
|
Trim (ExecName);
|
||||||
|
Delete (Params, 1, Pred (I));
|
||||||
|
end
|
||||||
|
else if Copy (FCommandLine, 1, Length (ExecName)) = ExecName then
|
||||||
|
Delete (Params, 1, Succ (Length (ExecName)))
|
||||||
|
else
|
||||||
|
Delete (Params, 1, Pred (GetNextWordPos (Params)));
|
||||||
|
Trim (Params);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
for I := 0 to Pred (Parameters.Count) do
|
||||||
|
Params := Params + ' ' + MaybeQuote (Parameters [I]);
|
||||||
|
if (FExecutable <> '') and (ExecName = '') then
|
||||||
|
ExecName := Executable;
|
||||||
|
if not FileExists (ExecName) then
|
||||||
|
begin
|
||||||
|
FoundName := ExeSearch (ExecName, '');
|
||||||
|
if FoundName <> '' then
|
||||||
|
ExecName := FoundName
|
||||||
|
else
|
||||||
|
raise EProcess.CreateFmt (SErrNoSuchProgram, [ExecName]);
|
||||||
|
end;
|
||||||
|
if (FCurrentDirectory <> '') then
|
||||||
|
begin
|
||||||
|
GetDir (0, OrigDir);
|
||||||
|
ChDir (FCurrentDirectory);
|
||||||
|
end;
|
||||||
|
try
|
||||||
|
cos := BPTR(0);
|
||||||
|
repeat
|
||||||
|
Inc(UID);
|
||||||
|
TempName := 'T:'+HexStr(FindTask(nil)) + '_' + HexStr(Self) + '_'+ IntToStr(UID) + '_Starter.tmp';
|
||||||
|
until not FileExists(TempName);
|
||||||
|
//sysdebugln('TProcess start: "' + ExecName + ' ' + Params+'" >' + TempName);
|
||||||
|
cos := AmigaDos.DosOpen(PChar(TempName), MODE_READWRITE);
|
||||||
|
FExitCode := LongInt(amigados.Execute(PChar(ExecName + ' ' + Params), BPTR(0), cos));
|
||||||
|
DosSeek(cos, 0, OFFSET_BEGINNING);
|
||||||
|
CreateStreams(0, THandle(cos),0);
|
||||||
|
//FExitCode := ExecuteProcess (ExecName, Params);
|
||||||
|
except
|
||||||
|
(* Normalize the raised exception so that it is aligned to other platforms. *)
|
||||||
|
On E: EOSError do
|
||||||
|
begin
|
||||||
|
raise EProcess.CreateFmt (SErrCannotExecute, [FCommandLine, E.ErrorCode]);
|
||||||
|
if (FCurrentDirectory <> '') then
|
||||||
|
ChDir (OrigDir);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if (FCurrentDirectory <> '') then
|
||||||
|
ChDir (OrigDir);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function TProcess.WaitOnExit : Boolean;
|
||||||
|
begin
|
||||||
|
Result:=True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function TProcess.Suspend : Longint;
|
||||||
|
begin
|
||||||
|
Result:=0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function TProcess.Resume : LongInt;
|
||||||
|
begin
|
||||||
|
Result:=0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function TProcess.Terminate(AExitCode : Integer) : Boolean;
|
||||||
|
begin
|
||||||
|
Result:=False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TProcess.SetShowWindow (Value : TShowWindowOptions);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
258
packages/fcl-process/src/amicommon/simpleipc.inc
Normal file
258
packages/fcl-process/src/amicommon/simpleipc.inc
Normal file
@ -0,0 +1,258 @@
|
|||||||
|
{
|
||||||
|
Amiga style simpleipc.inc
|
||||||
|
}
|
||||||
|
|
||||||
|
{$DEFINE OSNEEDIPCINITDONE}
|
||||||
|
|
||||||
|
uses
|
||||||
|
Exec, dos;
|
||||||
|
|
||||||
|
ResourceString
|
||||||
|
SErrMsgPortExists = 'MsgPort already exists: %s';
|
||||||
|
|
||||||
|
const
|
||||||
|
PORTNAMESTART = 'fpc_';
|
||||||
|
|
||||||
|
Var
|
||||||
|
MsgPorts: Classes.TList;
|
||||||
|
|
||||||
|
procedure AddMsgPort(AMsgPort: PMsgPort);
|
||||||
|
begin
|
||||||
|
if Assigned(MsgPorts) then
|
||||||
|
begin
|
||||||
|
MsgPorts.Add(AMsgPort);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RemoveMsgPort(AMsgPort: PMsgPort);
|
||||||
|
var
|
||||||
|
Idx: Integer;
|
||||||
|
begin
|
||||||
|
if Assigned(MsgPorts) then
|
||||||
|
begin
|
||||||
|
Idx := MsgPorts.IndexOf(AMsgPort);
|
||||||
|
if Idx >= 0 then
|
||||||
|
begin
|
||||||
|
MsgPorts.Delete(Idx);
|
||||||
|
if Assigned(AMsgPort^.mp_Node.ln_Name) and (string(AMsgPort^.mp_Node.ln_Name) <> '') and Assigned(FindPort(AMsgPort^.mp_Node.ln_Name)) then
|
||||||
|
RemPort(AMsgPort);
|
||||||
|
DeleteMsgPort(AMsgPort);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure IPCInit;
|
||||||
|
begin
|
||||||
|
MsgPorts := Classes.TList.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure IPCDone;
|
||||||
|
var
|
||||||
|
I: integer;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
for i := 0 to MsgPorts.Count - 1 do
|
||||||
|
RemoveMsgPort(PMsgPort(MsgPorts[i]));
|
||||||
|
finally
|
||||||
|
FreeAndNil(MsgPorts);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Type
|
||||||
|
TAmigaClientComm = Class(TIPCClientComm)
|
||||||
|
Private
|
||||||
|
FMsgPort: PMsgPort;
|
||||||
|
FPortName: String;
|
||||||
|
Public
|
||||||
|
Constructor Create(AOwner: TSimpleIPCClient); override;
|
||||||
|
Procedure Connect; override;
|
||||||
|
Procedure Disconnect; override;
|
||||||
|
Procedure SendMessage(MsgType : TMessageType; AStream : TStream); override;
|
||||||
|
//Function ServerRunning : Boolean; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TAmigaServerComm = Class(TIPCServerComm)
|
||||||
|
Private
|
||||||
|
FMsgPort: PMsgPort;
|
||||||
|
FPortName: String;
|
||||||
|
MsgBody: PMessage;
|
||||||
|
Public
|
||||||
|
Constructor Create(AOwner: TSimpleIPCServer); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
Procedure StartServer; override;
|
||||||
|
Procedure StopServer; override;
|
||||||
|
Function PeekMessage(TimeOut : Integer) : Boolean; override;
|
||||||
|
Procedure ReadMessage ; override;
|
||||||
|
Function GetInstanceID : String;override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// ####### CLIENT
|
||||||
|
|
||||||
|
function SafePutToPort(Msg: PMessage; Portname: string): Integer;
|
||||||
|
var
|
||||||
|
Port: PMsgPort;
|
||||||
|
PName: PChar;
|
||||||
|
begin
|
||||||
|
Result := -1;
|
||||||
|
PName := PChar(Portname + #0);
|
||||||
|
Forbid();
|
||||||
|
Port := FindPort(PName);
|
||||||
|
if Assigned(Port) then
|
||||||
|
begin
|
||||||
|
PutMsg(Port, Msg);
|
||||||
|
Result := 0;
|
||||||
|
end;
|
||||||
|
Permit();
|
||||||
|
end;
|
||||||
|
|
||||||
|
Constructor TAmigaClientComm.Create(AOwner: TSimpleIPCClient);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TAmigaClientComm.Connect;
|
||||||
|
begin
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TAmigaClientComm.Disconnect;
|
||||||
|
begin
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TAmigaClientComm.SendMessage(MsgType : TMessageType; AStream : TStream);
|
||||||
|
var
|
||||||
|
Size: Integer;
|
||||||
|
FullSize: Integer;
|
||||||
|
Memory: Pointer;
|
||||||
|
Temp: PByte;
|
||||||
|
MsgHead: Exec.PMessage;
|
||||||
|
MP: PMsgPort;
|
||||||
|
PortName: string;
|
||||||
|
begin
|
||||||
|
Size := AStream.Size - AStream.Position;
|
||||||
|
FullSize := Size + Sizeof(Exec.TMessage);
|
||||||
|
PortName := PORTNAMESTART + Owner.ServerID;
|
||||||
|
Memory := System.AllocMem(FullSize);
|
||||||
|
MP := CreateMsgPort;
|
||||||
|
try
|
||||||
|
MsgHead := Memory;
|
||||||
|
MsgHead^.mn_ReplyPort := MP;
|
||||||
|
MsgHead^.mn_Length := Size;
|
||||||
|
Temp := Memory;
|
||||||
|
Inc(Temp, SizeOf(Exec.TMessage));
|
||||||
|
AStream.Read(Temp^, Size);
|
||||||
|
if SafePutToPort(MsgHead, PortName) = 0 then
|
||||||
|
WaitPort(MP);
|
||||||
|
finally
|
||||||
|
System.FreeMem(Memory);
|
||||||
|
DeleteMsgPort(MP);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// ###### SERVER
|
||||||
|
|
||||||
|
Constructor TAmigaServerComm.Create(AOwner: TSimpleIPCServer);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
FMsgPort := CreateMsgPort;
|
||||||
|
AddMsgPort(FMsgPort);
|
||||||
|
MsgBody := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TAmigaServerComm.Destroy;
|
||||||
|
begin
|
||||||
|
if Assigned(MsgBody) then
|
||||||
|
System.FreeMem(MsgBody);
|
||||||
|
RemoveMsgPort(FMsgPort);
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TAmigaServerComm.StartServer;
|
||||||
|
begin
|
||||||
|
FPortName := PORTNAMESTART + Owner.ServerID + #0;
|
||||||
|
if Assigned(FindPort(PChar(FPortName))) then
|
||||||
|
begin
|
||||||
|
DoError(SErrMsgPortExists,[FPortName]);
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
FMsgPort^.mp_Node.ln_Name := PChar(FPortName);
|
||||||
|
FMsgPort^.mp_Node.ln_Pri := 0;
|
||||||
|
AddPort(FMsgPort);
|
||||||
|
if Assigned(MsgBody) then
|
||||||
|
System.FreeMem(MsgBody);
|
||||||
|
MsgBody := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TAmigaServerComm.StopServer;
|
||||||
|
begin
|
||||||
|
RemPort(FMsgPort);
|
||||||
|
if Assigned(MsgBody) then
|
||||||
|
System.FreeMem(MsgBody);
|
||||||
|
MsgBody := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function TAmigaServerComm.PeekMessage(TimeOut : Integer) : Boolean;
|
||||||
|
var
|
||||||
|
Msg: PMessage;
|
||||||
|
Temp: PByte;
|
||||||
|
StartTime: Int64;
|
||||||
|
begin
|
||||||
|
StartTime := GetMsCount;
|
||||||
|
Result := False;
|
||||||
|
if TimeOut < 0 then
|
||||||
|
TimeOut := MaxInt;
|
||||||
|
repeat
|
||||||
|
Msg := GetMsg(FMsgPort);
|
||||||
|
if Assigned(Msg) then
|
||||||
|
begin
|
||||||
|
Result := True;
|
||||||
|
Temp := PByte(Msg);
|
||||||
|
Inc(Temp, SizeOf(Exec.TMessage));
|
||||||
|
if Assigned(MsgBody) then
|
||||||
|
System.FreeMem(MsgBody);
|
||||||
|
MsgBody := System.AllocMem(SizeOf(Exec.TMessage) + Msg^.mn_Length);
|
||||||
|
Move(Msg^, MsgBody^, SizeOf(Exec.TMessage) + Msg^.mn_Length);
|
||||||
|
ReplyMsg(Msg);
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
Sleep(25);
|
||||||
|
until GetMsCount - StartTime >= TimeOut;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TAmigaServerComm.ReadMessage;
|
||||||
|
var
|
||||||
|
Temp: PByte;
|
||||||
|
begin
|
||||||
|
if Assigned(MsgBody) then
|
||||||
|
begin
|
||||||
|
Temp := Pointer(MsgBody);
|
||||||
|
Inc(Temp, SizeOf(Exec.TMessage));
|
||||||
|
Owner.FMsgType := mtString;
|
||||||
|
Owner.FMsgData.Size := 0;
|
||||||
|
Owner.FMsgData.Seek(0, soFrombeginning);
|
||||||
|
Owner.FMsgData.WriteBuffer(temp^, MsgBody^.mn_Length);
|
||||||
|
System.FreeMem(MsgBody);
|
||||||
|
MsgBody := nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function TAmigaServerComm.GetInstanceID: String;
|
||||||
|
begin
|
||||||
|
Result := HexStr(FindTask(nil));
|
||||||
|
end;
|
||||||
|
|
||||||
|
// ###### Register
|
||||||
|
|
||||||
|
Function TSimpleIPCServer.CommClass : TIPCServerCommClass;
|
||||||
|
begin
|
||||||
|
Result:=TAmigaServerComm;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TSimpleIPCClient.CommClass: TIPCClientCommClass;
|
||||||
|
begin
|
||||||
|
Result:=TAmigaClientComm;
|
||||||
|
end;
|
||||||
|
|
@ -1392,7 +1392,7 @@ type
|
|||||||
|
|
||||||
{ dos.library functions }
|
{ dos.library functions }
|
||||||
|
|
||||||
function Open(fname : PChar location 'd1';
|
function dosOpen(fname : PChar location 'd1';
|
||||||
accessMode: LongInt location 'd2'): LongInt;
|
accessMode: LongInt location 'd2'): LongInt;
|
||||||
SysCall MOS_DOSBase 30;
|
SysCall MOS_DOSBase 30;
|
||||||
|
|
||||||
|
@ -360,11 +360,13 @@ begin
|
|||||||
if AOS_wbMsg=nil then begin
|
if AOS_wbMsg=nil then begin
|
||||||
StdInputHandle:=dosInput;
|
StdInputHandle:=dosInput;
|
||||||
StdOutputHandle:=dosOutput;
|
StdOutputHandle:=dosOutput;
|
||||||
|
StdErrorHandle:=StdOutputHandle;
|
||||||
end else begin
|
end else begin
|
||||||
AOS_ConHandle:=Open(AOS_ConName,MODE_OLDFILE);
|
AOS_ConHandle:=Open(AOS_ConName,MODE_OLDFILE);
|
||||||
if AOS_ConHandle<>0 then begin
|
if AOS_ConHandle<>0 then begin
|
||||||
StdInputHandle:=AOS_ConHandle;
|
StdInputHandle:=AOS_ConHandle;
|
||||||
StdOutputHandle:=AOS_ConHandle;
|
StdOutputHandle:=AOS_ConHandle;
|
||||||
|
StdErrorHandle:=AOS_ConHandle;
|
||||||
end else
|
end else
|
||||||
Halt(1);
|
Halt(1);
|
||||||
end;
|
end;
|
||||||
@ -377,11 +379,8 @@ begin
|
|||||||
OpenStdIO(Output,fmOutput,StdOutputHandle);
|
OpenStdIO(Output,fmOutput,StdOutputHandle);
|
||||||
OpenStdIO(StdOut,fmOutput,StdOutputHandle);
|
OpenStdIO(StdOut,fmOutput,StdOutputHandle);
|
||||||
|
|
||||||
{ * AmigaOS doesn't have a separate stderr * }
|
OpenStdIO(StdErr,fmOutput,StdErrorHandle);
|
||||||
|
OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
|
||||||
StdErrorHandle:=StdOutputHandle;
|
|
||||||
//OpenStdIO(StdErr,fmOutput,StdErrorHandle);
|
|
||||||
//OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function GetProcessID: SizeUInt;
|
function GetProcessID: SizeUInt;
|
||||||
|
@ -121,9 +121,6 @@ begin
|
|||||||
Killed := True;
|
Killed := True;
|
||||||
{ Closing opened files }
|
{ Closing opened files }
|
||||||
CloseList(ASYS_fileList);
|
CloseList(ASYS_fileList);
|
||||||
//
|
|
||||||
if AOS_wbMsg <> nil then
|
|
||||||
ReplyMsg(AOS_wbMsg);
|
|
||||||
{ Changing back to original directory if changed }
|
{ Changing back to original directory if changed }
|
||||||
if ASYS_OrigDir <> 0 then begin
|
if ASYS_OrigDir <> 0 then begin
|
||||||
oldDirLock:=CurrentDir(ASYS_origDir);
|
oldDirLock:=CurrentDir(ASYS_origDir);
|
||||||
@ -142,6 +139,14 @@ begin
|
|||||||
CloseLibrary(AOS_DOSBase);
|
CloseLibrary(AOS_DOSBase);
|
||||||
AOS_DOSBase := nil;
|
AOS_DOSBase := nil;
|
||||||
//
|
//
|
||||||
|
if AOS_wbMsg <> nil then
|
||||||
|
begin
|
||||||
|
// forbid -> Amiga RKM Libraries Manual
|
||||||
|
Forbid();
|
||||||
|
// Reply WBStartupMessage
|
||||||
|
ReplyMsg(AOS_wbMsg);
|
||||||
|
end;
|
||||||
|
//
|
||||||
HaltProc(ExitCode);
|
HaltProc(ExitCode);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
@ -479,7 +479,7 @@ begin
|
|||||||
{$ENDIF FPC_FEXPAND_NO_DOTS_UPDIR}
|
{$ENDIF FPC_FEXPAND_NO_DOTS_UPDIR}
|
||||||
|
|
||||||
{$IFDEF FPC_FEXPAND_UPDIR_HELPER}
|
{$IFDEF FPC_FEXPAND_UPDIR_HELPER}
|
||||||
(* Now remove all references to '//' plus previous directories... *)
|
{ Now remove all references to '//' or '::' plus previous directories... }
|
||||||
I := Pos (DirectorySeparator + DirectorySeparator, Dirs);
|
I := Pos (DirectorySeparator + DirectorySeparator, Dirs);
|
||||||
while I <> 0 do
|
while I <> 0 do
|
||||||
begin
|
begin
|
||||||
@ -507,22 +507,6 @@ begin
|
|||||||
end;
|
end;
|
||||||
{$ENDIF FPC_FEXPAND_NO_DOTS_UPDIR}
|
{$ENDIF FPC_FEXPAND_NO_DOTS_UPDIR}
|
||||||
|
|
||||||
{$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
|
|
||||||
(* Remove a possible reference to '/' at the *)
|
|
||||||
(* end of line plus the previous directory. *)
|
|
||||||
I := Length (Dirs);
|
|
||||||
if (I > 0) and (Dirs [I] = DirectorySeparator) then
|
|
||||||
begin
|
|
||||||
J := Pred (I);
|
|
||||||
while (J > 0) and (Dirs [J] <> DirectorySeparator) do
|
|
||||||
Dec (J);
|
|
||||||
if (J = 0) then
|
|
||||||
Dirs := ''
|
|
||||||
else
|
|
||||||
Delete (Dirs, J, Succ (I - J));
|
|
||||||
end;
|
|
||||||
{$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
|
|
||||||
|
|
||||||
{$IFNDEF FPC_FEXPAND_NO_CURDIR}
|
{$IFNDEF FPC_FEXPAND_NO_CURDIR}
|
||||||
{$IFNDEF FPC_FEXPAND_DIRSEP_IS_CURDIR}
|
{$IFNDEF FPC_FEXPAND_DIRSEP_IS_CURDIR}
|
||||||
{...and also a possible reference to '\.'}
|
{...and also a possible reference to '\.'}
|
||||||
@ -666,7 +650,7 @@ end;
|
|||||||
parent directory and so on (Amiga). Please, note that you can decide
|
parent directory and so on (Amiga). Please, note that you can decide
|
||||||
to support both '..' and DirectorySeparator as references to the parent
|
to support both '..' and DirectorySeparator as references to the parent
|
||||||
directory at the same time for compatibility reasons - however this
|
directory at the same time for compatibility reasons - however this
|
||||||
support makes it impossible to use anotherwise possibly valid name
|
support makes it impossible to use otherwise possibly valid name
|
||||||
of '..'.
|
of '..'.
|
||||||
|
|
||||||
FPC_FEXPAND_DIRSEP_IS_CURDIR - DirectorySeparator at the beginning of
|
FPC_FEXPAND_DIRSEP_IS_CURDIR - DirectorySeparator at the beginning of
|
||||||
|
@ -372,11 +372,13 @@ begin
|
|||||||
MOS_ConHandle:=0;
|
MOS_ConHandle:=0;
|
||||||
StdInputHandle:=dosInput;
|
StdInputHandle:=dosInput;
|
||||||
StdOutputHandle:=dosOutput;
|
StdOutputHandle:=dosOutput;
|
||||||
|
StdErrorHandle:=StdOutputHandle;
|
||||||
end else begin
|
end else begin
|
||||||
MOS_ConHandle:=Open(MOS_ConName,MODE_OLDFILE);
|
MOS_ConHandle:=Open(MOS_ConName,MODE_OLDFILE);
|
||||||
if MOS_ConHandle<>0 then begin
|
if MOS_ConHandle<>0 then begin
|
||||||
StdInputHandle:=MOS_ConHandle;
|
StdInputHandle:=MOS_ConHandle;
|
||||||
StdOutputHandle:=MOS_ConHandle;
|
StdOutputHandle:=MOS_ConHandle;
|
||||||
|
StdErrorHandle:=MOS_ConHandle;
|
||||||
end else
|
end else
|
||||||
Halt(1);
|
Halt(1);
|
||||||
end;
|
end;
|
||||||
@ -389,10 +391,8 @@ begin
|
|||||||
OpenStdIO(Output,fmOutput,StdOutputHandle);
|
OpenStdIO(Output,fmOutput,StdOutputHandle);
|
||||||
OpenStdIO(StdOut,fmOutput,StdOutputHandle);
|
OpenStdIO(StdOut,fmOutput,StdOutputHandle);
|
||||||
|
|
||||||
{ * MorphOS doesn't have a separate stderr, just like AmigaOS (???) * }
|
OpenStdIO(StdErr,fmOutput,StdErrorHandle);
|
||||||
StdErrorHandle:=StdOutputHandle;
|
OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
|
||||||
// OpenStdIO(StdErr,fmOutput,StdErrorHandle);
|
|
||||||
// OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function GetProcessID: SizeUInt;
|
function GetProcessID: SizeUInt;
|
||||||
|
@ -59,9 +59,16 @@ uses
|
|||||||
{$ENDIF LINUX}
|
{$ENDIF LINUX}
|
||||||
|
|
||||||
{$IFDEF AMIGA}
|
{$IFDEF AMIGA}
|
||||||
|
{$IFNDEF HASAMIGA}
|
||||||
|
{$DEFINE HASAMIGA}
|
||||||
|
{$ENDIF HASAMIGA}
|
||||||
|
{$ENDIF AMIGA}
|
||||||
|
|
||||||
|
{$IFDEF HASAMIGA}
|
||||||
{$DEFINE VOLUMES}
|
{$DEFINE VOLUMES}
|
||||||
{$DEFINE NODRIVEC}
|
{$DEFINE NODRIVEC}
|
||||||
{$ENDIF AMIGA}
|
{$DEFINE NODOTS}
|
||||||
|
{$ENDIF HASAMIGA}
|
||||||
|
|
||||||
{$IFDEF NETWARE}
|
{$IFDEF NETWARE}
|
||||||
{$DEFINE VOLUMES}
|
{$DEFINE VOLUMES}
|
||||||
@ -103,13 +110,13 @@ const
|
|||||||
DriveSeparator = '/';
|
DriveSeparator = '/';
|
||||||
FileNameCasePreserving = true;
|
FileNameCasePreserving = true;
|
||||||
{$ELSE UNIX}
|
{$ELSE UNIX}
|
||||||
{$IFDEF AMIGA}
|
{$IFDEF HASAMIGA}
|
||||||
DirectorySeparator = ':';
|
DirectorySeparator = '/';
|
||||||
FileNameCasePreserving = true;
|
FileNameCasePreserving = true;
|
||||||
{$ELSE AMIGA}
|
{$ELSE HASAMIGA}
|
||||||
DirectorySeparator = '\';
|
DirectorySeparator = '\';
|
||||||
FileNameCasePreserving = false;
|
FileNameCasePreserving = false;
|
||||||
{$ENDIF AMIGA}
|
{$ENDIF HASAMIGA}
|
||||||
{$ENDIF UNIX}
|
{$ENDIF UNIX}
|
||||||
{$ENDIF MACOS}
|
{$ENDIF MACOS}
|
||||||
{$ENDIF DIRECT}
|
{$ENDIF DIRECT}
|
||||||
@ -117,11 +124,7 @@ const
|
|||||||
{$IFDEF MACOS}
|
{$IFDEF MACOS}
|
||||||
DriveSep = '';
|
DriveSep = '';
|
||||||
{$ELSE MACOS}
|
{$ELSE MACOS}
|
||||||
{$IFDEF AMIGA}
|
|
||||||
DriveSep = '';
|
|
||||||
{$ELSE AMIGA}
|
|
||||||
DriveSep = DriveSeparator;
|
DriveSep = DriveSeparator;
|
||||||
{$ENDIF AMIGA}
|
|
||||||
{$ENDIF MACOS}
|
{$ENDIF MACOS}
|
||||||
{$IFDEF UNIX}
|
{$IFDEF UNIX}
|
||||||
CDrive = '';
|
CDrive = '';
|
||||||
@ -129,11 +132,11 @@ const
|
|||||||
{$IFDEF MACOS}
|
{$IFDEF MACOS}
|
||||||
CDrive = 'C';
|
CDrive = 'C';
|
||||||
{$ELSE MACOS}
|
{$ELSE MACOS}
|
||||||
{$IFDEF AMIGA}
|
{$IFDEF HASAMIGA}
|
||||||
CDrive = 'C';
|
CDrive = 'C';
|
||||||
{$ELSE AMIGA}
|
{$ELSE HASAMIGA}
|
||||||
CDrive = 'C:';
|
CDrive = 'C:';
|
||||||
{$ENDIF AMIGA}
|
{$ENDIF HASAMIGA}
|
||||||
{$ENDIF MACOS}
|
{$ENDIF MACOS}
|
||||||
{$ENDIF UNIX}
|
{$ENDIF UNIX}
|
||||||
{$ENDIF FPC}
|
{$ENDIF FPC}
|
||||||
@ -289,11 +292,11 @@ begin
|
|||||||
GetDir (3, CDir);
|
GetDir (3, CDir);
|
||||||
{$ENDIF NODRIVEC}
|
{$ENDIF NODRIVEC}
|
||||||
Check (' ', CurDir + DirSep + ' ');
|
Check (' ', CurDir + DirSep + ' ');
|
||||||
{$IFDEF AMIGA}
|
{$IFDEF HASAMIGA}
|
||||||
Check ('', CurDir);
|
Check ('', CurDir);
|
||||||
{$ELSE AMIGA}
|
{$ELSE HASAMIGA}
|
||||||
Check ('', CurDir + DirSep);
|
Check ('', CurDir + DirSep);
|
||||||
{$ENDIF AMIGA}
|
{$ENDIF HASAMIGA}
|
||||||
{$IFDEF MACOS}
|
{$IFDEF MACOS}
|
||||||
Check (':', CurDir + DirSep);
|
Check (':', CurDir + DirSep);
|
||||||
{$ELSE MACOS}
|
{$ELSE MACOS}
|
||||||
@ -304,26 +307,26 @@ begin
|
|||||||
if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
|
if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
|
||||||
else Check ('c:anything', CDir + DirSep + 'anything');
|
else Check ('c:anything', CDir + DirSep + 'anything');
|
||||||
Check (CC + DirSep, CDrive + DirSep);
|
Check (CC + DirSep, CDrive + DirSep);
|
||||||
{$IFDEF NODOTS}
|
{$IFDEF NODOTS}
|
||||||
Check ('C:.', 'C:.');
|
Check ('C:.', 'C:.');
|
||||||
Check (CC + DirSep + '.', CDrive + DirSep + '.');
|
Check (CC + DirSep + '.', CDrive + DirSep + '.');
|
||||||
Check (CC + DirSep + '..', CDrive + DirSep + '..');
|
Check (CC + DirSep + '..', CDrive + DirSep + '..');
|
||||||
{$ELSE NODOTS}
|
{$ELSE NODOTS}
|
||||||
Check ('C:.', CDir);
|
Check ('C:.', CDir);
|
||||||
Check (CC + DirSep + '.', CDrive + DirSep);
|
Check (CC + DirSep + '.', CDrive + DirSep);
|
||||||
Check (CC + DirSep + '..', CDrive + DirSep);
|
Check (CC + DirSep + '..', CDrive + DirSep);
|
||||||
{$ENDIF NODOTS}
|
{$ENDIF NODOTS}
|
||||||
Check (CC + DirSep + 'DOS', CDrive + DirSep + 'DOS');
|
Check (CC + DirSep + 'DOS', CDrive + DirSep + 'DOS');
|
||||||
{$IFNDEF NODOTS}
|
{$IFNDEF NODOTS}
|
||||||
Check (CC + DirSep + '..' + DirSep + 'DOS', CDrive + DirSep + 'DOS');
|
Check (CC + DirSep + '..' + DirSep + 'DOS', CDrive + DirSep + 'DOS');
|
||||||
{$ENDIF NODOTS}
|
{$ENDIF NODOTS}
|
||||||
Check (CC + DirSep + 'DOS.', CDrive + DirSep + 'DOS.');
|
Check (CC + DirSep + 'DOS.', CDrive + DirSep + 'DOS.');
|
||||||
{$IFDEF AMIGA}
|
{$IFDEF HASAMIGA} (* This has no effect - AMIGA has NODRIVEC defined... *)
|
||||||
Check (CC + DirSep + 'DOS' + DirSep, CDrive + DirSep);
|
Check (CC + DirSep + 'DOS' + DirSep, CDrive + DirSep);
|
||||||
{$ELSE AMIGA}
|
{$ELSE HASAMIGA}
|
||||||
Check (CC + DirSep + 'DOS' + DirSep, CDrive + DirSep + 'DOS' + DirSep);
|
Check (CC + DirSep + 'DOS' + DirSep, CDrive + DirSep + 'DOS' + DirSep);
|
||||||
{$ENDIF AMIGA}
|
{$ENDIF HASAMIGA}
|
||||||
{$IFNDEF NODOTS}
|
{$IFNDEF NODOTS}
|
||||||
Check (CC + DirSep + 'DOS' + DirSep + '.', CDrive + DirSep + 'DOS');
|
Check (CC + DirSep + 'DOS' + DirSep + '.', CDrive + DirSep + 'DOS');
|
||||||
Check (CC + DirSep + 'DOS' + DirSep + '..', CDrive + DirSep);
|
Check (CC + DirSep + 'DOS' + DirSep + '..', CDrive + DirSep);
|
||||||
Check (CC + DirSep + 'DOS' + DirSep + '..' + DirSep, CDrive + DirSep);
|
Check (CC + DirSep + 'DOS' + DirSep + '..' + DirSep, CDrive + DirSep);
|
||||||
@ -331,14 +334,20 @@ if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
|
|||||||
DirSep + 'DOS');
|
DirSep + 'DOS');
|
||||||
Check ('C:' + DirSep + 'DOS' + DirSep + 'TEST' + DirSep + '..' + DirSep,
|
Check ('C:' + DirSep + 'DOS' + DirSep + 'TEST' + DirSep + '..' + DirSep,
|
||||||
CDrive + DirSep + 'DOS' + DirSep);
|
CDrive + DirSep + 'DOS' + DirSep);
|
||||||
{$ENDIF NODOTS}
|
{$ENDIF NODOTS}
|
||||||
{$ENDIF NODRIVEC}
|
{$ENDIF NODRIVEC}
|
||||||
|
|
||||||
{$IFNDEF MACOS}
|
{$IFNDEF MACOS}
|
||||||
|
{$IFDEF HASAMIGA}
|
||||||
|
Check (DirSep, TestDir + TestDir1Name);
|
||||||
|
Check (DirSep + DirSep + TestFileName, TestDir + TestFileName);
|
||||||
|
Check (DirSep + 'DOS', TestDir + TestDir1Name + DirSep + 'DOS');
|
||||||
|
{$ELSE HASAMIGA}
|
||||||
Check (DirSep, TestDrive + DirSep);
|
Check (DirSep, TestDrive + DirSep);
|
||||||
Check (DirSep + '.', TestDrive + DirSep);
|
Check (DirSep + '.', TestDrive + DirSep);
|
||||||
Check (DirSep + '..', TestDrive + DirSep);
|
Check (DirSep + '..', TestDrive + DirSep);
|
||||||
Check (DirSep + 'DOS', TestDrive + DirSep + 'DOS');
|
Check (DirSep + 'DOS', TestDrive + DirSep + 'DOS');
|
||||||
|
{$ENDIF HASAMIGA}
|
||||||
{$ENDIF MACOS}
|
{$ENDIF MACOS}
|
||||||
Check ('d', CurDir + DirSep + 'd');
|
Check ('d', CurDir + DirSep + 'd');
|
||||||
{$IFDEF MACOS}
|
{$IFDEF MACOS}
|
||||||
@ -367,15 +376,15 @@ if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
|
|||||||
Check ('.special', CurDir + DirSep + '.special');
|
Check ('.special', CurDir + DirSep + '.special');
|
||||||
Check ('..special', CurDir + DirSep + '..special');
|
Check ('..special', CurDir + DirSep + '..special');
|
||||||
Check ('special..', CurDir + DirSep + 'special..');
|
Check ('special..', CurDir + DirSep + 'special..');
|
||||||
{$IFDEF AMIGA}
|
{$IFDEF HASAMIGA}
|
||||||
Check ('special.' + DirSep, CurDir);
|
Check ('special.' + DirSep, CurDir + DirSep + 'special.' + DirSep);
|
||||||
{$ELSE AMIGA}
|
{$ELSE HASAMIGA}
|
||||||
{$IFDEF MACOS}
|
{$IFDEF MACOS}
|
||||||
Check ('special.' + DirSep, 'special.' + DirSep);
|
Check ('special.' + DirSep, 'special.' + DirSep);
|
||||||
{$ELSE MACOS}
|
{$ELSE MACOS}
|
||||||
Check ('special.' + DirSep, CurDir + DirSep + 'special.' + DirSep);
|
Check ('special.' + DirSep, CurDir + DirSep + 'special.' + DirSep);
|
||||||
{$ENDIF MACOS}
|
{$ENDIF MACOS}
|
||||||
{$ENDIF AMIGA}
|
{$ENDIF HASAMIGA}
|
||||||
{$IFDEF MACOS}
|
{$IFDEF MACOS}
|
||||||
Check (DirSep + DirSep, TestDir + TestDir1Name + DirSep);
|
Check (DirSep + DirSep, TestDir + TestDir1Name + DirSep);
|
||||||
Check (DirSep + DirSep + TestFileName, TestDir + TestDir1Name + DirSep
|
Check (DirSep + DirSep + TestFileName, TestDir + TestDir1Name + DirSep
|
||||||
@ -481,7 +490,11 @@ if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
|
|||||||
{$ENDIF NODRIVEC}
|
{$ENDIF NODRIVEC}
|
||||||
{$ENDIF UNIX}
|
{$ENDIF UNIX}
|
||||||
{$IFDEF VOLUMES}
|
{$IFDEF VOLUMES}
|
||||||
|
{$IFDEF HASAMIGA}
|
||||||
|
Check ('VolName' + DriveSep + 'DIR1', 'VolName' + DriveSep + 'DIR1');
|
||||||
|
{$ELSE HASAMIGA}
|
||||||
Check ('VolName' + DriveSep + DirSep + 'DIR1', 'VolName' + DriveSep + DirSep + 'DIR1');
|
Check ('VolName' + DriveSep + DirSep + 'DIR1', 'VolName' + DriveSep + DirSep + 'DIR1');
|
||||||
|
{$ENDIF HASAMIGA}
|
||||||
{$IFNDEF NODOTS}
|
{$IFNDEF NODOTS}
|
||||||
Check ('VolName' + DriveSep + DirSep + 'DIR1' + DirSep + '..', 'VolName' + DriveSep + DirSep);
|
Check ('VolName' + DriveSep + DirSep + 'DIR1' + DirSep + '..', 'VolName' + DriveSep + DirSep);
|
||||||
Check ('VolName' + DriveSep + DirSep + 'DIR1' + DirSep + '..' + DirSep + '..',
|
Check ('VolName' + DriveSep + DirSep + 'DIR1' + DirSep + '..' + DirSep + '..',
|
||||||
@ -496,13 +509,13 @@ if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
|
|||||||
Check ('SrvName/VolName' + DriveSep + DirSep + 'TEST', 'SrvName' + DirSep + 'VolName' +
|
Check ('SrvName/VolName' + DriveSep + DirSep + 'TEST', 'SrvName' + DirSep + 'VolName' +
|
||||||
DriveSep + DirSep + 'TEST');
|
DriveSep + DirSep + 'TEST');
|
||||||
{$ENDIF NETWARE}
|
{$ENDIF NETWARE}
|
||||||
{$IFDEF AMIGA}
|
{$IFDEF HASAMIGA}
|
||||||
{$IFDEF NODOTS}
|
{$IFDEF NODOTS}
|
||||||
Check ('.', CurDir + DirSep + '.');
|
Check ('.', CurDir + DirSep + '.');
|
||||||
{$ELSE NODOTS}
|
{$ELSE NODOTS}
|
||||||
Check ('.', CurDir);
|
Check ('.', CurDir);
|
||||||
{$ENDIF NODOTS}
|
{$ENDIF NODOTS}
|
||||||
{$ENDIF AMIGA}
|
{$ENDIF HASAMIGA}
|
||||||
{$ENDIF VOLUMES}
|
{$ENDIF VOLUMES}
|
||||||
Erase (F);
|
Erase (F);
|
||||||
{$IFNDEF NODRIVEC}
|
{$IFNDEF NODRIVEC}
|
||||||
|
Loading…
Reference in New Issue
Block a user