← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to rtl/beos/sysutils.pp

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2004-08-12 16:29:37 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040812162937-moo8ulvysp1ln771
Tags: 1.9.4-5
http://bugs.debian.org/265265
fp-compiler: needs ld, adding dependency on binutils.  (Closes: #265265)

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtl/beos/sysutils.pp
 
1
{
 
2
    $Id: sysutils.pp,v 1.9 2004/02/15 21:26:37 hajny Exp $
 
3
    This file is part of the Free Pascal run time library.
 
4
    Copyright (c) 1999-2000 by Florian Klaempfl
 
5
    member of the Free Pascal development team
 
6
 
 
7
    Sysutils unit for BeOS
 
8
 
 
9
    See the file COPYING.FPC, included in this distribution,
 
10
    for details about the copyright.
 
11
 
 
12
    This program is distributed in the hope that it will be useful,
 
13
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
14
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
15
 
 
16
 **********************************************************************}
 
17
unit sysutils;
 
18
interface
 
19
 
 
20
{$MODE objfpc}
 
21
{ force ansistrings }
 
22
{$H+}
 
23
 
 
24
uses
 
25
  beos,
 
26
  dos;
 
27
 
 
28
{ Include platform independent interface part }
 
29
{$i sysutilh.inc}
 
30
 
 
31
 
 
32
implementation
 
33
 
 
34
  uses
 
35
    sysconst;
 
36
 
 
37
{ Include platform independent implementation part }
 
38
{$i sysutils.inc}
 
39
 
 
40
 
 
41
{****************************************************************************
 
42
                              File Functions
 
43
****************************************************************************}
 
44
 
 
45
Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
 
46
BEGIN
 
47
end;
 
48
 
 
49
 
 
50
Function FileCreate (Const FileName : String) : longint;
 
51
begin
 
52
end;
 
53
 
 
54
Function FileCreate (Const FileName : String;Mode:longint) : longint;
 
55
begin
 
56
end;
 
57
 
 
58
 
 
59
Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
 
60
begin
 
61
end;
 
62
 
 
63
 
 
64
Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
 
65
begin
 
66
end;
 
67
 
 
68
 
 
69
Function FileSeek (Handle,FOffset,Origin : longint) : longint;
 
70
begin
 
71
end;
 
72
 
 
73
Function FileSeek (Handle:longint;FOffset,Origin : int64) : int64;
 
74
begin
 
75
end;
 
76
 
 
77
 
 
78
Procedure FileClose (Handle : Longint);
 
79
begin
 
80
end;
 
81
 
 
82
 
 
83
Function FileTruncate (Handle,Size: Longint) : boolean;
 
84
begin
 
85
end;
 
86
 
 
87
 
 
88
Function FileAge (Const FileName : String): Longint;
 
89
begin
 
90
end;
 
91
 
 
92
 
 
93
Function FileExists (Const FileName : String) : Boolean;
 
94
begin
 
95
end;
 
96
 
 
97
 
 
98
Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint;
 
99
begin
 
100
end;
 
101
 
 
102
 
 
103
Function FindNext (Var Rslt : TSearchRec) : Longint;
 
104
begin
 
105
end;
 
106
 
 
107
 
 
108
Procedure FindClose (Var F : TSearchrec);
 
109
begin
 
110
end;
 
111
 
 
112
 
 
113
Function FileGetDate (Handle : Longint) : Longint;
 
114
begin
 
115
end;
 
116
 
 
117
 
 
118
Function FileSetDate (Handle,Age : Longint) : Longint;
 
119
begin
 
120
end;
 
121
 
 
122
 
 
123
Function FileGetAttr (Const FileName : String) : Longint;
 
124
begin
 
125
end;
 
126
 
 
127
 
 
128
Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
 
129
begin
 
130
end;
 
131
 
 
132
 
 
133
Function DeleteFile (Const FileName : String) : Boolean;
 
134
begin
 
135
end;
 
136
 
 
137
 
 
138
Function RenameFile (Const OldName, NewName : String) : Boolean;
 
139
begin
 
140
end;
 
141
 
 
142
{****************************************************************************
 
143
                              Disk Functions
 
144
****************************************************************************}
 
145
 
 
146
Function DiskFree(Drive: Byte): int64;
 
147
Begin
 
148
End;
 
149
 
 
150
 
 
151
 
 
152
Function DiskSize(Drive: Byte): int64;
 
153
Begin
 
154
End;
 
155
 
 
156
 
 
157
Function GetCurrentDir : String;
 
158
begin
 
159
  GetDir(0,Result);
 
160
end;
 
161
 
 
162
 
 
163
Function SetCurrentDir (Const NewDir : String) : Boolean;
 
164
begin
 
165
  {$I-}
 
166
   ChDir(NewDir);
 
167
  {$I+}
 
168
  result := (IOResult = 0);
 
169
end;
 
170
 
 
171
 
 
172
Function CreateDir (Const NewDir : String) : Boolean;
 
173
begin
 
174
  {$I-}
 
175
   MkDir(NewDir);
 
176
  {$I+}
 
177
  result := (IOResult = 0);
 
178
end;
 
179
 
 
180
 
 
181
Function RemoveDir (Const Dir : String) : Boolean;
 
182
begin
 
183
  {$I-}
 
184
   RmDir(Dir);
 
185
  {$I+}
 
186
  result := (IOResult = 0);
 
187
end;
 
188
 
 
189
 
 
190
function DirectoryExists (const Directory: string): boolean;
 
191
begin
 
192
end;
 
193
 
 
194
 
 
195
{****************************************************************************
 
196
                              Misc Functions
 
197
****************************************************************************}
 
198
 
 
199
procedure Beep;
 
200
begin
 
201
end;
 
202
 
 
203
 
 
204
{****************************************************************************
 
205
                              Locale Functions
 
206
****************************************************************************}
 
207
 
 
208
Procedure GetLocalTime(var SystemTime: TSystemTime);
 
209
begin
 
210
end ;
 
211
 
 
212
 
 
213
Procedure InitAnsi;
 
214
Var
 
215
  i : longint;
 
216
begin
 
217
  {  Fill table entries 0 to 127  }
 
218
  for i := 0 to 96 do
 
219
    UpperCaseTable[i] := chr(i);
 
220
  for i := 97 to 122 do
 
221
    UpperCaseTable[i] := chr(i - 32);
 
222
  for i := 123 to 191 do
 
223
    UpperCaseTable[i] := chr(i);
 
224
  Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
 
225
 
 
226
  for i := 0 to 64 do
 
227
    LowerCaseTable[i] := chr(i);
 
228
  for i := 65 to 90 do
 
229
    LowerCaseTable[i] := chr(i + 32);
 
230
  for i := 91 to 191 do
 
231
    LowerCaseTable[i] := chr(i);
 
232
  Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
 
233
end;
 
234
 
 
235
 
 
236
Procedure InitInternational;
 
237
begin
 
238
  InitAnsi;
 
239
end;
 
240
 
 
241
function SysErrorMessage(ErrorCode: Integer): String;
 
242
 
 
243
begin
 
244
  Str(Errorcode,Result);
 
245
  Result:='Error '+Result;
 
246
end;
 
247
 
 
248
{****************************************************************************
 
249
                              OS utility functions
 
250
****************************************************************************}
 
251
 
 
252
Function GetEnvironmentVariable(Const EnvVar : String) : String;
 
253
 
 
254
begin
 
255
  Result:=StrPas(beos.Getenv(PChar(EnvVar)));
 
256
end;
 
257
 
 
258
 
 
259
function ExecuteProcess (const Path: AnsiString; const ComLine: AnsiString):
 
260
                                                                       integer;
 
261
 
 
262
var
 
263
  CommandLine: AnsiString;
 
264
 
 
265
begin
 
266
  { always surround the name of the application by quotes
 
267
    so that long filenames will always be accepted. But don't
 
268
    do it if there are already double quotes!
 
269
  }
 
270
  if pos('"',path)=0 then
 
271
    CommandLine:='"'+path+'"'
 
272
  else
 
273
    CommandLine:=path;
 
274
  if ComLine <> '' then
 
275
   CommandLine := Commandline + ' ' + ComLine;
 
276
  ExecuteProcess := beos.shell (CommandLine);
 
277
end;
 
278
 
 
279
 
 
280
function ExecuteProcess (const Path: AnsiString;
 
281
                                  const ComLine: array of AnsiString): integer;
 
282
 
 
283
{$WARNING Should be probably changed according to the Unix version}
 
284
var 
 
285
  CommandLine: AnsiString;
 
286
  I: integer;
 
287
 
 
288
begin
 
289
  Commandline := '';
 
290
  for I := 0 to High (ComLine) do
 
291
   if Pos (' ', ComLine [I]) <> 0 then
 
292
    CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
 
293
   else
 
294
    CommandLine := CommandLine + ' ' + Comline [I];
 
295
  ExecuteProcess := ExecuteProcess (Path, CommandLine);
 
296
end;
 
297
 
 
298
 
 
299
 
 
300
{****************************************************************************
 
301
                              Initialization code
 
302
****************************************************************************}
 
303
 
 
304
Initialization
 
305
  InitExceptions;       { Initialize exceptions. OS independent }
 
306
  InitInternational;    { Initialize internationalization settings }
 
307
Finalization
 
308
  DoneExceptions;
 
309
end.
 
310
{
 
311
  $Log: sysutils.pp,v $
 
312
  Revision 1.9  2004/02/15 21:26:37  hajny
 
313
    * overloaded ExecuteProcess added, EnvStr param changed to longint
 
314
 
 
315
  Revision 1.8  2004/01/20 23:09:14  hajny
 
316
    * ExecuteProcess fixes, ProcessID and ThreadID added
 
317
 
 
318
  Revision 1.7  2003/11/26 20:00:19  florian
 
319
    * error handling for Variants improved
 
320
 
 
321
  Revision 1.5  2003/03/29 15:16:26  hajny
 
322
    * dummy DirectoryExists added
 
323
 
 
324
  Revision 1.4  2003/01/08 21:56:54  marco
 
325
   * small fixes to prototypes to compile it
 
326
 
 
327
  Revision 1.3  2002/09/07 16:01:17  peter
 
328
    * old logs removed and tabs fixed
 
329
 
 
330
}
 
 
b'\\ No newline at end of file'