1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
{
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2005 by Florian Klaempfl and Pavel Ozerski
member of the Free Pascal development team.
Low level directory functions for MacOS
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.
**********************************************************************}
{*****************************************************************************
Directory Handling
*****************************************************************************}
procedure do_mkdir(const s: rawbytestring);
var
spec: FSSpec;
createdDirID: Longint;
err: OSErr;
res: Integer;
begin
{ TODO: convert PathArgToFSSpec (and the routines it calls) to rawbytestring }
res:= PathArgToFSSpec(s, spec);
if (res = 0) or (res = 2) then
begin
err:= FSpDirCreate(spec, smSystemScript, createdDirID);
OSErr2InOutRes(err);
end
else
InOutRes:=res;
end;
procedure do_rmdir(const s: rawbytestring);
var
spec: FSSpec;
err: OSErr;
res: Integer;
begin
res:= PathArgToFSSpec(s, spec);
if (res = 0) then
begin
if IsDirectory(spec) then
begin
err:= FSpDelete(spec);
OSErr2InOutRes(err);
end
else
InOutRes:= 20;
end
else
InOutRes:=res;
end;
procedure do_chdir(const s: rawbytestring);
var
spec, newDirSpec: FSSpec;
err: OSErr;
res: Integer;
begin
res:= PathArgToFSSpec(s, spec);
if (res = 0) or (res = 2) then
begin
{ The fictive file x is appended to the directory name to make
FSMakeFSSpec return a FSSpec to a file in the directory.
Then by clearing the name, the FSSpec then
points to the directory. It doesn't matter whether x exists or not.}
err:= FSMakeFSSpec (spec.vRefNum, spec.parID, ':'+spec.name+':x', newDirSpec);
if (err = noErr) or (err = fnfErr) then
begin
workingDirectorySpec:= newDirSpec;
workingDirectorySpec.name:='';
InOutRes:= 0;
end
else
begin
{E g if the directory doesn't exist.}
OSErr2InOutRes(err);
end;
end
else
InOutRes:=res;
end;
procedure do_getDir (DriveNr: byte; var Dir: RawByteString);
var
pathHandleSize: Longint;
begin
if FSpGetFullPath(workingDirectorySpec, Dir, false) <> noErr then
Halt(3); {exit code 3 according to MPW}
SetCodePage(Dir,DefaultFileSystemCodePage,false);
end;
|
