← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to rtl/morphos/sysutils.pp

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtl/morphos/sysutils.pp
1
1
{
2
 
    $Id: sysutils.pp,v 1.7 2005/02/26 14:38:14 florian Exp $
3
2
 
4
3
    This file is part of the Free Pascal run time library.
5
4
    Copyright (c) 2004 by Karoly Balogh
38
37
 
39
38
uses dos,sysconst;
40
39
 
 
40
{$DEFINE FPC_FEXPAND_VOLUMES} (* Full paths begin with drive specification *)
 
41
{$DEFINE FPC_FEXPAND_DRIVESEP_IS_ROOT}
 
42
{$DEFINE FPC_FEXPAND_NO_DEFAULT_PATHS}
 
43
 
41
44
{ Include platform independent implementation part }
42
45
{$i sysutils.inc}
43
46
 
53
56
{ * Followings are implemented in the system unit! * }
54
57
function PathConv(path: shortstring): shortstring; external name 'PATHCONV';
55
58
procedure AddToList(var l: Pointer; h: LongInt); external name 'ADDTOLIST';
56
 
procedure RemoveFromList(var l: Pointer; h: LongInt); external name 'REMOVEFROMLIST';
 
59
function RemoveFromList(var l: Pointer; h: LongInt): boolean; external name 'REMOVEFROMLIST';
 
60
function CheckInList(var l: Pointer; h: LongInt): pointer; external name 'CHECKINLIST';
57
61
 
58
62
var
59
63
  MOS_fileList: Pointer; external name 'MOS_FILELIST';
243
247
type
244
248
  PDOSSearchRec = ^SearchRec;
245
249
 
246
 
Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint;
 
250
Function FindFirst (Const Path : String; Attr : Longint; Out Rslt : TSearchRec) : Longint;
247
251
Const
248
252
  faSpecial = faHidden or faSysFile or faVolumeID or faDirectory;
249
253
var
427
431
end;
428
432
 
429
433
 
430
 
Function DirectoryExists(const Directory: string): Boolean;
 
434
function DirectoryExists(const Directory: string): Boolean;
431
435
var
432
 
 s: string;
 
436
  tmpStr : array[0..255] of Char;
 
437
  tmpLock: LongInt;
 
438
  FIB    : PFileInfoBlock;
433
439
begin
434
 
  { Get old directory }
435
 
  s:=GetCurrentDir;
436
 
  ChDir(Directory);
437
 
  DirectoryExists := (IOResult = 0);
438
 
  ChDir(s);
 
440
  DirectoryExists:=False;
 
441
  If (Directory='') or (InOutRes<>0) then exit;
 
442
  tmpStr:=PathConv(Directory)+#0;
 
443
  tmpLock:=0;
 
444
 
 
445
  tmpLock:=Lock(@tmpStr,SHARED_LOCK);
 
446
  if tmpLock=0 then exit;
 
447
 
 
448
  FIB:=nil; new(FIB);
 
449
 
 
450
  if (Examine(tmpLock,FIB)=True) and (FIB^.fib_DirEntryType>0) then begin
 
451
    DirectoryExists:=True;
 
452
  end;
 
453
 
 
454
  if tmpLock<>0 then Unlock(tmpLock);
 
455
  if assigned(FIB) then dispose(FIB);
439
456
end;
440
457
 
441
458
 
 
459
 
442
460
{****************************************************************************
443
461
                              Misc Functions
444
462
****************************************************************************}
567
585
Finalization
568
586
  DoneExceptions;
569
587
end.
570
 
{
571
 
    $Log: sysutils.pp,v $
572
 
    Revision 1.7  2005/02/26 14:38:14  florian
573
 
      + SysLocale
574
 
 
575
 
    Revision 1.6  2005/02/14 17:13:30  peter
576
 
      * truncate log
577
 
 
578
 
    Revision 1.5  2005/01/30 02:36:14  karoly
579
 
      * fixed compilation
580
 
 
581
 
    Revision 1.4  2005/01/12 08:03:42  karoly
582
 
      * Few more Sysutils functions implemented
583
 
 
584
 
    Revision 1.3  2005/01/11 17:44:06  karoly
585
 
      * basic file I/O implemented
586
 
 
587
 
}