blob: 277156ace7e46dcead9e0f1d39342538e7b3e27b (
plain)
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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
{
This file is part of the Free Pascal run time library.
Copyright (c) 2012 by the Free Pascal development team
Disk calls
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.
**********************************************************************}
function GetDriveIDFromLetter(Const ADrive : PathStr) : Byte;
begin
if length(ADrive)=0 then
Result:=0
else
Result := Ord(UpCase(ADrive[1]))-64;
end;
{$push}
{$i-}
Function SetCurrentDir(Const NewDir: PathStr): Boolean;
var
PInOutRes: ^Word;
OrigInOutRes: Word;
begin
{ inoutres is a threadvar -> cache address }
PInOutRes:=@InOutRes;
OrigInOutRes:=PInOutRes^;
PInOutRes^:=0;
ChDir(NewDir);
Result:=PInOutRes^=0;
InOutRes:=OrigInOutRes;
end;
Function CreateDir (Const NewDir: PathStr): Boolean;
var
PInOutRes: ^Word;
OrigInOutRes: Word;
begin
{ inoutres is a threadvar -> cache address }
PInOutRes:=@InOutRes;
OrigInOutRes:=PInOutRes^;
PInOutRes^:=0;
MkDir(NewDir);
Result:=PInOutRes^=0;
InOutRes:=OrigInOutRes;
end;
Function RemoveDir (Const Dir: PathStr): Boolean;
var
PInOutRes: ^Word;
OrigInOutRes: Word;
begin
{ inoutres is a threadvar -> cache address }
PInOutRes:=@InOutRes;
OrigInOutRes:=PInOutRes^;
PInOutRes^:=0;
RmDir(Dir);
Result:=PInOutRes^=0;
InOutRes:=OrigInOutRes;
end;
{$pop}
function ForceDirectories(Const Dir: PathStr): Boolean;
var
E: EInOutError;
ADrv: PathStr;
function DoForceDirectories(Const Dir: PathStr): Boolean;
var
ADir: PathStr;
APath: PathStr;
begin
Result:=True;
ADir:=ExcludeTrailingPathDelimiter(Dir);
if (ADir='') then Exit;
if Not DirectoryExists(ADir) then
begin
APath:=ExtractFilePath(ADir);
//this can happen on Windows if user specifies Dir like \user\name/test/
//and would, if not checked for, cause an infinite recusrsion and a stack overflow
if (APath=ADir) then
Result:=False
else
Result:=DoForceDirectories(APath);
if Result then
Result:=CreateDir(ADir);
end;
end;
function IsUncDrive(const Drv: PathStr): Boolean;
begin
Result:=
(Length(Drv)>2) and
(Drv[1]=PathDelim) and
(Drv[2]=PathDelim);
end;
begin
Result:=False;
ADrv:=ExtractFileDrive(Dir);
if (ADrv<>'') and
(not DirectoryExists(ADrv))
{$IFNDEF FORCEDIR_NO_UNC_SUPPORT} and (not IsUncDrive(ADrv)){$ENDIF} then
Exit;
if Dir='' then
begin
E:=EInOutError.Create(SCannotCreateEmptyDir);
E.ErrorCode:=3;
Raise E;
end;
Result:=DoForceDirectories(SetDirSeparators(Dir));
end;
|
