{$IFDEF global_declare} type DWORD = LongWord; PDWORD = ^DWORD; PPoint = ^TPoint; TPoint = packed record X: Longint; Y: Longint; end; PRect = ^TRect; TRect = packed record case Integer of 0: (Left, Top, Right, Bottom: Longint); 1: (TopLeft, BottomRight: TPoint); end; const INVALID_HANDLE_VALUE = Cardinal(-1); MAX_PATH = 4095; // From /usr/include/linux/limits.h PATH_MAX const { File attribute constants } FILE_ATTRIBUTE_READONLY = $00000001; FILE_ATTRIBUTE_HIDDEN = $00000002; FILE_ATTRIBUTE_SYSTEM = $00000004; FILE_ATTRIBUTE_VOLUME = $00000008; FILE_ATTRIBUTE_DIRECTORY = $00000010; FILE_ATTRIBUTE_ARCHIVE = $00000020; FILE_ATTRIBUTE_SYMLINK = $00000040; FILE_ATTRIBUTE_ANYFILE = $0000003F; FILE_ATTRIBUTE_NORMAL = FILE_ATTRIBUTE_ARCHIVE; type TFilename = type string; PFileTime = ^TFileTime; TFileTime = __time_t; PFindFileData = ^TFindFileData; TFindFileData = packed record // from TWin32FindData: ------------- dwFileAttributes: DWORD; ftCreationTime: TFileTime; ftLastAccessTime: TFileTime; ftLastWriteTime: TFileTime; nFileSizeHigh: DWORD; nFileSizeLow: DWORD; //dwReserved0: DWORD; //dwReserved1: DWORD; cFileName: array[0..MAX_PATH - 1] of Char; //cAlternateFileName: array[0..13] of KOLChar; - no in Linux //-------- + handle: FindHandle: Pointer; ExcludeAttr: Integer; Mode: mode_t; PathOnly: String; Pattern: String; end; const ExeBaseAddress = Pointer($8048000); // Kylix only? function GetModuleFileName(Module: HMODULE; Buffer: PChar; BufLen: Integer): Integer; function DeleteFile(lpFileName: PChar): Boolean; {$ENDIF global_declare} {$IFDEF implementation} //------------------ Unicode strings function WAnsiUpperCase(const S: WideString): WideString; var I: Integer; P: PWideChar; begin SetLength(Result, Length(S)); P := @Result[1]; for I := 1 to Length(S) do P[I-1] := WideChar(towupper(UCS4Char(S[I]))); end; function WAnsiLowerCase(const S: WideString): WideString; var I: Integer; P: PWideChar; begin SetLength(Result, Length(S)); P := @Result[1]; for I := 1 to Length(S) do P[I-1] := WideChar(towlower(UCS4Char(S[I]))); end; //------------------ Ansi strings function AnsiUpperCase(const S: string): string; begin Result := WAnsiUpperCase( S ); end; function AnsiLowerCase(const S: string): string; begin Result := WAnsiLowerCase( S ); end; function AnsiCompareStr(const S1, S2: string): Integer; begin // glibc 2.1.2 / 2.1.3 implementations of strcoll() and strxfrm() // have severe capacity limits. Comparing two 100k strings may // exhaust the stack and kill the process. // Fixed in glibc 2.1.91 and later. Result := strcoll(PChar(S1), PChar(S2)); end; function _AnsiCompareStr(S1, S2: PChar): Integer; begin // glibc 2.1.2 / 2.1.3 implementations of strcoll() and strxfrm() // have severe capacity limits. Comparing two 100k strings may // exhaust the stack and kill the process. // Fixed in glibc 2.1.91 and later. Result := strcoll(S1, S2); end; function AnsiCompareStrNoCase(const S1, S2: string): Integer; begin // glibc 2.1.2 / 2.1.3 implementations of strcoll() and strxfrm() // have severe capacity limits. Comparing two 100k strings may // exhaust the stack and kill the process. // Fixed in glibc 2.1.91 and later. Result := AnsiCompareStr( AnsiUpperCase( S1 ), AnsiUpperCase( S2 ) ); end; function _AnsiCompareStrNoCase(S1, S2: PChar): Integer; begin // glibc 2.1.2 / 2.1.3 implementations of strcoll() and strxfrm() // have severe capacity limits. Comparing two 100k strings may // exhaust the stack and kill the process. // Fixed in glibc 2.1.91 and later. Result := AnsiCompareStrNoCase( S1, S2 ); end; //--------------- File functions function FileCreate(const FileName: string; OpenFlags: DWord): THandle; begin Result := open64( PChar( FileName ), OpenFlags ); end; function FileClose(Handle: THandle): boolean; begin Result := FALSE; if Handle = INVALID_HANDLE_VALUE then Exit; __close( Handle ); Result := TRUE; end; function FileExists( const FileName : String ) : Boolean; var st: TStatBuf; begin Result := FALSE; if stat(PChar(FileName), st) = 0 then Result := st.st_mtime <> -1; end; function FileSeek( Handle: THandle; MoveTo: integer; MoveMethod: TMoveMethod): DWord; var Temp: Int64; begin Temp := MoveTo; Result := lseek64(Handle, Temp, Integer( MoveMethod )); end; function FileFarSeek(Handle: THandle; MoveTo: Int64; MoveMethod: TMoveMethod): DWord; var Temp: Int64; begin Temp := MoveTo; Result := lseek64(Handle, Temp, Integer( MoveMethod )); end; function FileRead(Handle: THandle; var Buffer; Count: DWord): DWord; begin Result := __read(Handle, Buffer, Count); end; function GetFileSize( Handle: THandle; HiSize: PDWORD ): DWORD; var Pos: Int64; Len: Int64; begin Pos := FileSeek( Handle, 0, spCurrent ); Len := FileSeek( Handle, 0, spEnd ); FileSeek( Handle, Pos, spBegin ); Result := I64( Len ).Lo; if HiSize <> nil then HiSize^ := I64( Len ).Hi; end; function FileWrite( Handle: THandle; const Buffer; Count: DWord): DWord; begin Result := __write(Handle, Buffer, Count); end; // the only way for a file name to be not complete in Unix: // it is located in current working directory (CWD) ?????? function FileFullPath( const FileName: String ) : String; var wd: String; buffer: array[ 0.._POSIX_PATH_MAX+1 ] of Char; begin Result := FileName; wd := ''; if getwd( buffer ) <> nil then wd := buffer; if StrIsStartingFrom( PChar( FileName ), PChar( wd ) ) then Exit; Result := IncludeTrailingPathDelimiter( wd ) + Filename; if not FileExists( Result ) then Result := FileName; end; function Find_Next(var F: TFindFileData): Boolean; var PtrDirEnt: PDirEnt; Scratch: TDirEnt; StatBuf: TStatBuf; LinkStatBuf: TStatBuf; FName: string; Attr: Integer; Mode: mode_t; Sz: Int64; begin Result := FALSE; PtrDirEnt := nil; if readdir_r(F.FindHandle, @Scratch, PtrDirEnt) <> 0 then Exit; while PtrDirEnt <> nil do begin if fnmatch(PChar(F.Pattern), PtrDirEnt.d_name, 0) = 0 then begin // F.PathOnly must include trailing backslash FName := F.PathOnly + string(PtrDirEnt.d_name); if lstat(PChar(FName), StatBuf) = 0 then begin Attr := 0; Mode := StatBuf.st_mode; if S_ISDIR(Mode) then Attr := Attr or FILE_ATTRIBUTE_DIRECTORY else if not S_ISREG(Mode) then // directories shouldn't be treated as system files begin if S_ISLNK(Mode) then begin Attr := Attr or FILE_ATTRIBUTE_SYMLINK; if (stat(PChar(FName), LinkStatBuf) = 0) and S_ISDIR(LinkStatBuf.st_mode) then Attr := Attr or FILE_ATTRIBUTE_DIRECTORY end; Attr := Attr or FILE_ATTRIBUTE_SYSTEM; end; if (PtrDirEnt.d_name[0] = '.') and (PtrDirEnt.d_name[1] <> #0) then begin if not ((PtrDirEnt.d_name[1] = '.') and (PtrDirEnt.d_name[2] = #0)) then Attr := Attr or FILE_ATTRIBUTE_HIDDEN; end; if euidaccess(PChar(FName), W_OK) <> 0 then Attr := Attr or FILE_ATTRIBUTE_READONLY; if Attr and F.ExcludeAttr = 0 then begin Sz := StatBuf.st_size; F.nFileSizeLow := I64(Sz).Lo; F.nFileSizeHigh := I64(Sz).Hi; F.dwFileAttributes := Attr; F.Mode := StatBuf.st_mode; StrCopy( F.cFileName, PtrDirEnt.d_name ); F.ftCreationTime := StatBuf.st_mtime; F.ftLastWriteTime := StatBuf.st_mtime; F.ftLastAccessTime := StatBuf.st_atime; Result := TRUE; Break; end; end; end; Result := FALSE; if readdir_r(F.FindHandle, @Scratch, PtrDirEnt) <> 0 then Break; end // End of While end; procedure Find_Close(var F: TFindFileData); begin if F.FindHandle <> nil then begin closedir(F.FindHandle); F.FindHandle := nil; end; F.PathOnly := ''; // in Kylix this is not done (memory leak bug?) F.Pattern := ''; end; function Find_First( const FilePathName: String; var F: TFindFileData ): Boolean; begin FillChar( F, Sizeof( F ), 0 ); F.ExcludeAttr := FILE_ATTRIBUTE_HIDDEN or FILE_ATTRIBUTE_SYSTEM or FILE_ATTRIBUTE_VOLUME; // or FILE_ATTRIBUTE_DIRECTORY; F.PathOnly := ExtractFilePath(FilePathName); F.Pattern := ExtractFileName(FilePathName); if F.PathOnly = '' then F.PathOnly := GetWorkDir; F.FindHandle := opendir(PChar(F.PathOnly)); if F.FindHandle <> nil then begin if not Find_Next(F) then begin Find_Close(F); Result := FALSE; Exit; end; end; Result:= TRUE; end; function FileSize( const Path : String ) : Int64; var F: TFindFileData; begin Result := 0; if Find_First( Path, F ) then begin Result := PInt64( @ F.nFileSizeLow )^; Find_Close( F ); end; end; function FileTimeCompare( const FT1, FT2 : TFileTime ) : Integer; begin Result := Sgn( FT1 - FT2 ); end; function DirectoryExists(const Name: string): Boolean; var st: TStatBuf; begin if stat(PChar(Name), st) = 0 then Result := S_ISDIR(st.st_mode) else Result := False; end; function GetWorkDir : string; var DirBuf: array[0..MAX_PATH] of Char; begin getcwd(DirBuf, sizeof(DirBuf)); Result := string(DirBuf); end; //[function GetModuleFileName] // grabbed form Kylix/system.pas function GetModuleFileName(Module: HMODULE; Buffer: PChar; BufLen: Integer): Integer; var Addr: Pointer; Info: TDLInfo; FoundInModule: HMODULE; Temp: Integer; begin Result := 0; if BufLen <= 0 then Exit; if (Module = MainInstance) or (Module = 0) then begin // First, try the dlsym approach. // dladdr fails to return the name of the main executable // in glibc prior to 2.1.91 { Look for a dynamic symbol exported from this program. _DYNAMIC is not required in a main program file. If the main program is compiled with Delphi, it will always have a resource section, named @Sysinit@ResSym. If the main program is not compiled with Delphi, dlsym will search the global name space, potentially returning the address of a symbol in some other shared object library loaded by the program. To guard against that, we check that the address of the symbol found is within the main program address range. } dlerror; // clear error state; dlsym doesn't Addr := dlsym(Pointer( Module ), '@Sysinit@ResSym'); if (Addr <> nil) and (dlerror = nil) and (dladdr(Addr, Info) <> 0) and (Info.{FileName}dli_fname <> nil) and (Info.{BaseAddress}dli_fbase = ExeBaseAddress) then begin Result := StrLen(Info.{FileName}dli_fname); if Result >= BufLen then Result := BufLen-1; // dlinfo may not give a full path. Compare to /proc/self/exe, // take longest result. Temp := readlink('/proc/self/exe', Buffer, BufLen); if Temp >= BufLen then Temp := BufLen-1; if Temp > Result then Result := Temp else Move(Info.{FileName}dli_fname^, Buffer^, Result); Buffer[Result] := #0; Exit; end; // Try inspecting the /proc/ virtual file system // to find the program filename in the process info Result := readlink('/proc/self/exe', Buffer, BufLen); if Result <> -1 then begin if Result >= BufLen then Result := BufLen-1; Buffer[Result] := #0; end; {$IFDEF AllowParamStrModuleName} { Using ParamStr(0) to obtain a module name presents a potential security hole. Resource modules are loaded based upon the filename of a given module. We use dlopen() to load resource modules, which means the .init code of the resource module will be executed. Normally, resource modules contain no code at all - they're just carriers of resource data. An unpriviledged user program could launch our trusted, priviledged program with a bogus parameter list, tricking us into loading a module that contains malicious code in its .init section. Without this ParamStr(0) section, GetModuleFilename cannot be misdirected by unpriviledged code (unless the system program loader or the /proc file system or system root directory has been compromised). Resource modules are always loaded from the same directory as the given module. Trusted code (programs, packages, and libraries) should reside in directories that unpriviledged code cannot alter. If you need GetModuleFilename to have a chance of working on systems where glibc < 2.1.91 and /proc is not available, and your program will not run as a priviledged user (or you don't care), you can define AllowParamStrModuleNames and rebuild the System unit and baseCLX package. Note that even with ParamStr(0) support enabled, GetModuleFilename can still fail to find the name of a module. C'est la Unix. } if Result = -1 then // couldn't access the /proc filesystem begin // return less accurate ParamStr(0) { ParamStr(0) returns the name of the link used to launch the app, not the name of the app itself. Also, if this app was launched by some other program, there is no guarantee that the launching program has set up our environment at all. (example: Apache CGI) } if (ArgValues = nil) or (ArgValues^ = nil) or (PCharArray(ArgValues^)[0] = nil) then begin Result := 0; Exit; end; Result := _strlen(PCharArray(ArgValues^)[0]); if Result >= BufLen then Result := BufLen-1; Move(PCharArray(ArgValues^)[0]^, Buffer^, Result); Buffer[Result] := #0; end; {$ENDIF} end else begin { For shared object libraries, we can rely on the dlsym technique. Look for a dynamic symbol in the requested module. Don't assume the module was compiled with Delphi. We look for a dynamic symbol with the name _DYNAMIC. This exists in all ELF shared object libraries that export or import symbols; If someone has a shared object library that contains no imports or exports of any kind, this will probably fail. If dlsym can't find the requested symbol in the given module, it will search the global namespace and could return the address of a symbol from some other module that happens to be loaded into this process. That would be bad, so we double check that the module handle of the symbol found matches the module handle we asked about.} dlerror; // clear error state; dlsym doesn't Addr := dlsym(Pointer( Module ), '_DYNAMIC'); if (Addr <> nil) and (dlerror = nil) and (dladdr(Addr, Info) <> 0) then begin if Info.{BaseAddress}dli_fbase = ExeBaseAddress then Info.{FileName}dli_fname := nil; FoundInModule := HMODULE(dlopen(Info.{FileName}dli_fname, RTLD_LAZY)); if FoundInModule <> 0 then dlclose(Pointer( FoundInModule )); if Module = FoundInModule then begin if Assigned(Info.{FileName}dli_fname) then begin Result := StrLen(Info.{FileName}dli_fname); if Result >= BufLen then Result := BufLen-1; Move(Info.{FileName}dli_fname^, Buffer^, Result); end else Result := 0; Buffer[Result] := #0; end; end; end; if Result < 0 then Result := 0; end; //[END GetModuleFileName] function CreateTempFile( const DirPath, Prefix: String ): String; var i: Integer; begin i := 0; REPEAT Result := DirPath + Prefix + Int2Str( i ); inc( i ); UNTIL not FileExists( Result ); end; function DeleteFile(lpFileName: PChar): Boolean; begin Result := remove( lpFileName ) = 0; end; {--- TTimer ---} (*) procedure TTimer.SetEnabled(const Value: Boolean); begin if FEnabled = Value then Exit; fEnabled := Value; if Value then begin fTV.it_interval.tv_sec := fInterval div 1000; fTV.it_interval.tv_usec := (fInterval mod 1000) * 1000; setitimer( fTimerKind, ) fHandle := SetTimer( {$IFDEF TIMER_APPLETWND} Applet.GetWindowHandle {$ELSE} TimerOwnerWnd.GetWindowHandle {$ENDIF}, Integer( @Self ), fInterval, @TimerProc ); end else begin if fHandle <> 0 then begin KillTimer( TimerOwnerWnd.fHandle, fHandle ); fHandle := 0; end; end; end; (*) {$ENDIF implementation}