0linux/common/uutils.pas

{
********************************************************************************

SPackGui (common files)
Copyright (C) 2008-2013 Geoffray Levasseur <geoffray.levasseurbrandin@numericable.fr>.
Copyright (C) <date> <add your name and mail address here>

Parts inspired from PeaZip souce code:
  Copyright (C) 2006 Giorgio Tani <giorgiotani@interfree.it>
Parts inspired from Lazarus source code:
  Copyright (C) 2001-2010 The Lazarus developpers

http://www.geoffray-levasseur.org/
http://0.tuxfamilly.org/

This software is governed by the CeCILL license under French law and
abiding by the rules of distribution of free software.  You can  use,
modify and/ or redistribute the software under the terms of the CeCILL
license as circulated by CEA, CNRS and INRIA at the following URL
"http://www.cecill.info".

As a counterpart to the access to the source code and  rights to copy,
modify and redistribute granted by the license, users are provided only
with a limited warranty  and the software's author,  the holder of the
economic rights,  and the successive licensors  have only  limited
liability.

In this respect, the user's attention is drawn to the risks associated
with loading,  using,  modifying and/or developing or reproducing the
software by the user in light of its specific status of free software,
that may mean  that it is complicated to manipulate,  and  that  also
therefore means  that it is reserved for developers  and  experienced
professionals having in-depth computer knowledge. Users are therefore
encouraged to load and test the software's suitability as regards their
requirements in conditions enabling the security of their systems and/or
data to be ensured and,  more generally, to use and operate it in the
same conditions as regards security.

The fact that you are presently reading this means that you have had
knowledge of the CeCILL license and that you accept its terms.

********************************************************************************

Description:
  Various utilities and functions

********************************************************************************
}

unit uUtils;

{$include defines.inc}

interface

uses
  Classes, SysUtils, Graphics, StdCtrls;

type
  TOperatingSystem = (osWindows, osWin32, osWin64, osWinCE, osGo32V2, osOS2,
    osGenUnix, osFreeBSD, osNetBSD, osLinux, osBeOS, osQNX, osSun, osDarwin,
    osAmiga, osAtari, osMacOS, osPalmOS, osUnknow);

  TPathType = (ptIsDircetory, ptIsFile, ptIsExecutable, ptNotExists,
    ptInvalid, ptDosPathOnUnix, ptUnixPathOnDos);

  TDesktopEnv = (deUnknow, deGnome, deKDE, deMacOSX, deWindows, deLXDE, deXFCE);
  Str4 = string[4];

  TFileCountOpt = set of (fcIncludeSubDirs, fcIncludeDirs);

const {$warning we should be able to detect more desktop environment}
  ADescEnvDesc: array[TDesktopEnv] of string = ('Unknow', 'Gnome', 'KDE',
    'Mac OS X', 'Microsoft Windows', 'LXDE', 'XFCE');

  AOSDesc: array[TOperatingSystem] of string = ('Microsoft Windows (generic)',
    'Microsoft Windows (32 bits)', 'Microsoft Windows (64 bits)',
    'Microsoft Windows CE', 'Microsoft Windows with Go32 v2', 'IBM OS/2',
    'Generic Unix', 'Free BSD', 'Net BSD', 'Linux', 'BeOS', 'QNX',
    'Sun Solaris', 'Mac OS X (Darwin)', 'Amiga OS', 'Atari OS', 'MacOS',
    'Palm OS', 'Unknow Operating System');

  cpuUnknow = $00;
  cpu32Bit = $10;
  cpu64Bit = $20;
  cpuGenericMoto = $30;
  cpuMiscRisc = $40;
  cpuGenericPPC = $50;
  cpu86 = $11;
  cpu87 = $12;
  cpu386 = $13;
  cpuX86_64 = $21;
  cpu68k = $31;
  cpuM68020 = $32;
  cpu68 = $33;
  cpuAlpha = $41;
  cpuSparc = $42;
  cpuMips = $43;
  cpuPowerPC = $51;
  cpuArm = $60;
  cpuBigEndian = $80;

var //default values and variable declaration for configuration
  DateFormat: string = 'dd/mm/yyyy';
  TwoDigitDateLimit: integer = 30;

//get the user name from personal directory path (multiplatform way)
//note that builtin FPC GetUserName function is for Windows only
//on unix su command is keeping the username as before launching it: find a workarround
function GetUserName: string;

//get computer name
function GetComputerName: string;

//Get the running operating system
function GetCurrentOS: TOperatingSystem;

//get CPU type and endianness (in MSB)
function GetUsedCPU: Word;

//Find the default browser according system configuration
function FindDefaultBrowser(out ABrowser, AParams: String): Boolean;

//Open URL in the default browser
function OpenURL(AURL: String): Boolean;

//convert a 4 char string (maximum) into a Word
function StrToWord(const S: Str4): Word;

//Convert a 3 number date into a string (deprecated)
function DateToStr(Y, M, D: Word): string; deprecated;

//Remove the extention of a file name
function RemoveFileExt(const aFileName: string): string;

//Get the executable path of the program with final /
function GetProgramPath: string;

//Get the active user working directory
function GetHomePath: string;

//Give the number of items present in a listed string for the given separator
function CountItemsInStr(Str: string; Separator: Char): integer;

//Return the item in a listed string at the given index
function GetItemInStr(Str: string; Separator: Char; Index: integer): string;

//find which desktop environment is currently running
function GetDesktopEnv: TDesktopEnv; //0 unknown, 1 Gnome, 2 KDE, 20 MS Windows, 30 OSX

//return the position of a string in a stringlist, -1 if no occurence
function StrExistsInList(const StrList: TStringList; S: string): integer;
function StrExistsInListBox(const StrList: TListBox; S: string): integer;

//remove and change (repectively) a string from a StringList, returning position
//of the change in the SL, -1 if no occurence
function StrRemove(var StrList: TStringList; S: string): integer;
function StrChange(var StrList: TStringList; const sOld, sNew: string): integer;

//check filename before use regarding the environment
function FormatFileName(S: String; out VS: string): Integer;

//check if a directory is empty
function DirectoryIsEmpty(ADir: string): Boolean;

//check for possible problematic chars in a string that could be used as filename
function RemoveSpecialChar(const S: UnicodeString): UnicodeString;

//create a lock file containing the computer name and user name of the locker
function CreateLockFile(const AName: string): Boolean;

//count the number of files in a directory and optionnally its subdirs
function GetNumberOfFiles(const ADir: string;
  const AOpt: TFileCountOpt): LongWord;

//check if we can write in a directory
function DirectoryIsReadOnly(const ADirName: string): Boolean;

//get the host name of an URL/URI
function ExtractHostName(const S: string): string;

//get proxy settings from http_proxy or ftp_proxy environment variables
procedure GetProxyInfo(const S: string; out User, Pass, Address, Port: string);

implementation

uses
  BaseUnix, Forms, FileUtil, UTF8Process, Dialogs, uDebug, uStrings;

function GetUserName: string;
begin
  {$warning Find a workarround to get the good username in case where su or sudo is being used}
  Result := GetEnvironmentVariable(rsEnvUser);
end;

function GetComputerName: String;
var
  AUtsName: UtsName;
begin
  Result := '';
  AUtsName.Nodename[0] := #0; //this is just to avoid the compiler warning
  FillChar(AUtsName, SizeOf(AUtsName), 0);
  if FpUname(AUtsName) <> -1 then
    Result := AUtsName.Nodename;
end;

function GetCurrentOS: TOperatingSystem;
begin
  //unrecognized system, it is overwritten if one of the following conditions is met
  Result := osUnknow;
  // that software is useless and would not work on DOS/Windows type systems so it's bypassed
  // Unix type systems
  {$IFDEF UNIX}
    //generic UNIX, replaced with some following codes
    //if a more specific match is found
    Result := osGenUnix;
  {$ENDIF}
  {$IFDEF FREEBSD}
    Result := osFreeBSD;
  {$ENDIF}
  {$IFDEF NETBSD}
    Result := osNetBSD;
  {$ENDIF}
  {$IFDEF LINUX}
    Result := osLinux;
  {$ENDIF}
  {$IFDEF BEOS}
    Result := osBeOS;
  {$ENDIF}
  {$IFDEF QNX}
    Result := osQNX;
  {$ENDIF}
  {$IFDEF SUNOS}
    Result := osSunOS;
  {$ENDIF}
  //Other systems are also ignored for the same reason as for DOS/Windows
end;

//if cpu type, < $80 (encoded in ls 7 bit);
//0 if unrecognized, replaced if a match is found
function GetUsedCPU: Word; //CPU and endianness (in MSB)
begin
  Result := cpuUnknow; //cpu type, < $80 (encoded in ls 7 bit); 0: unrecognized, replaced if a match is found
  {$IFDEF CPU32}
    //generic 32 bit CPU, replaced if a more specific match is found
    Result := cpu32Bit;
  {$ENDIF}
  {$IFDEF CPU64}
    //generic 64 bit CPU, replaced if a more specific match is found
    Result := cpu64Bit;
  {$ENDIF}
  {$IFDEF CPU86}
    Result := cpu86;
  {$ENDIF}
  {$IFDEF CPU87}
    Result := cpu87;
  {$ENDIF}
  {$IFDEF CPUI386}
    Result := cpu386;
  {$ENDIF}
  {$IFDEF CPUX86_64}
    Result := cpuX86_64;
  {$ENDIF}
  {$IFDEF CPU68k}
    Result := cpu68k;
  {$ENDIF}
  {$IFDEF CPUM68020}
    Result := cpuM68020;
  {$ENDIF}
  {$IFDEF CPU68}
    Result := cpu68;
  {$ENDIF}
  {$IFDEF CPUSPARC}
    Result := cpuSpark;
  {$ENDIF}
  {$IFDEF CPUALPHA}
    Result := cpuAlpha;
  {$ENDIF}
  {$IFDEF CPUMIPS}
    Result := cpuMips;
  {$ENDIF}
  {$IFDEF CPUPOWERPC}
    Result := cpuPowerPC;
  {$ENDIF}
  {$IFDEF CPUARM}
    Result := cpuArm;
  {$ENDIF}
  {$IFDEF ENDIAN_BIG}
    //if processor is declared big endian (some processors don't have a fixed
    //endian setting) the msb is set to 1, otherwise is 0
    Result := Result + cpuBigEndian;
  {$ENDIF}
end;

//This is a somewhat altered version of the Lazarus' source code
//FindDefaultBrowser function
function FindDefaultBrowser(out ABrowser, AParams: String): Boolean;

  function Find(const ShortFilename: String; out ABrowser: String): Boolean; inline;
  begin
    ABrowser := SearchFileInPath(ShortFilename + GetExeExt, '',
      GetEnvironmentVariable(rsEnvPath), PathSeparator,
      [sffDontSearchInBasePath]);
    Result := ABrowser <> '';
  end;

begin
  if ABrowser = '' then
  begin
    AParams := '%s';
    // Then search in path. Firsts are prefered ;)
    if Find('xdg-open', ABrowser)  // Portland OSDL/FreeDesktop standard on Linux
      or Find('htmlview', ABrowser)  // some redhat systems
      or Find('konqueror', ABrowser)
      or Find('firefox', ABrowser)
      or Find('mozilla', ABrowser)
      or Find('midori', ABrowser)
      or Find('rekonq', ABrowser)
      or Find('galeon', ABrowser)
      or Find('safari', ABrowser)
      or Find('netscape', ABrowser)
      or Find('opera', ABrowser) then
      PrintLnDbg(Format(rsInfoFoundBrowser, [ABrowser]), vlHigh);
  end;
  Result := ABrowser <> '';
end;

//each system has a different OpenURL working. this is mainly took from
//Lazarus source code with minor changes
//we suppose here a Unix system... exotic or very old OS not supported.
function OpenURL(AURL: String): Boolean;
var
  ABrowser, AParams: String;
  BrowserProcess: TProcessUTF8;
begin
  Result := FindDefaultBrowser(ABrowser, AParams) and
    FileExists(ABrowser) {and FileIsExecutable(ABrowser)};
  if not Result then
    Exit;
  //run
  BrowserProcess := TProcessUTF8.Create(nil);
  try
    {$warning test if @ exists and add mailto to open it with default mail composer!}
    BrowserProcess.CommandLine := ABrowser + ' ' + Format(AParams, [AURL]);
    BrowserProcess.Execute;
  finally
    BrowserProcess.Free;
  end;
end;

//if your string is more than 4 char you may have a range error
function StrToWord(const S: Str4): Word;
var
  I: Integer;
begin
  Result := 0;
  I := 1;
  while I <= Length(S) do
  begin
    Result := Result * 10 + Ord(S[I]) - Ord('0');
    Inc(I);
  end;
end;

// Deprecated with Lazarus > 0.9.27: use FormatDateTime for further development
function DateToStr(Y, M, D: Word): string; deprecated;
begin
  if Y < TwoDigitDateLimit then
    Inc(Y, 2000);
  if (Y < 100) and (Y > TwoDigitDateLimit) then
    Inc(Y, 1900);
  Result := FormatDateTime(DateFormat, EncodeDate(Y, M, D));
end;

function RemoveFileExt(const aFileName: string): string;
var
  I: integer;
begin
  I := Length(aFileName);
  while aFileName[I] <> '.' do
    Dec(I);
  if I > 1 then
    Result := Copy(aFileName, 1, I - 1)
  else
    Result := aFileName; //on unix this is not an extention but an hidden file
end;

function GetProgramPath: string; //this may work on all platform
begin
  Result := Trim(ExtractFilePath(Application.ExeName));
  if Result[Length(Result)] <> DirectorySeparator then
    Result := Result + DirectorySeparator;
end;

function CountItemsInStr(Str: string; Separator: Char): integer;
var
  I: integer;
begin
  if Str = '' then
  begin
    Result := 0;
    Exit;
  end;
  Result := 1;
  for I := 1 to Length(Str) do
    if Str[I] = Separator then
      Inc(Result);
  if Str[Length(Str)] = Separator then
    Dec(Result);
end;

function GetItemInStr(Str: string; Separator: Char; Index: integer): string;
var
  I, J: integer;
  S: string;
begin
  //note that result = '' is equivalent to an error
  S := '';
  if Str = '' then
    Exit;
  I := 1;
  J := 1;
  while (I < Index) and (J < Length(Str)) do
  begin
    if Str[J] = Separator then
      Inc(I);
    Inc(J);
  end;
  if J >= Length(Str) then //in case of a terminal separator
    Exit;
  if Str[J] = Separator then
    Inc(J);
  repeat
    S := S + Str[J];
    Inc(J);
  until (J > Length(Str)) or (Str[J] = Separator);
  Result := Trim(S);
end;

function GetDesktopEnv: TDesktopEnv;
begin
  Result := deUnknow; //unrecognized desktop environment
  //if this Gnome specific env variable is set, probably the user is running Gnome
  if GetEnvironmentVariable(rsEnvGnomeSession) <> '' then
    Result := deGnome;
  //if this KDE specific env variable is set, probably the user is running KDE
  if GetEnvironmentVariable(rsEnvKDESession) <> '' then
    Result := deKDE;
  //if gnome or kde is explicitely declared in DESKTOP_SESSION env variable,
  //override previously assumed result
  {$warning Complete with other unixes desktop environment}
  if GetEnvironmentVariable(rsEnvDesktopSession) = 'gnome' then
    Result := deGnome
  else
    if getenvironmentvariable(rsEnvDesktopSession) = 'kde' then
      Result := deKDE
    else
      if GetEnvironmentVariable(rsEnvDesktopSession) = 'xfce' then
        Result := deXFCE
      else
        if GetEnvironmentVariable(rsEnvDesktopSession) = 'lxde' then
          Result := deLXDE;
end;

function GetDesktopPath: string;
//superseeded in Windows
begin
  {$IFDEF LINUX}  //this should work on every unixes but have to be tested
    Result := GetEnvironmentVariable(rsEnvUnixHomeDir) + '/Desktop/';
  {$ENDIF}
  {$IFDEF FREEBSD}
    Result := GetEnvironmentVariable(rsEnvUnixHomeDir) + '/Desktop/';
  {$ENDIF}
  {$IFDEF NETBSD}
    Result := GetEnvironmentVariable(rsEnvUnixHomeDir) + '/Desktop/';
  {$ENDIF}
   //generic, superseeded by system specific values, if not empty
  if Result = '' then
    Result := GetCurrentDir;
  if Result[Length(Result)] <> DirectorySeparator then
    Result := Result + DirectorySeparator;
end;

function GetHomePath: string;
begin
  {$IFDEF LINUX}  //this should work on every unixes but have to be tested
    Result := GetEnvironmentVariable(rsEnvUnixHomeDir);
  {$ENDIF}
  {$IFDEF FREEBSD}
    Result := GetEnvironmentVariable(rsEnvUnixHomeDir);
  {$ENDIF}
  {$IFDEF NETBSD}
    Result := GetEnvironmentVariable(rsEnvUnixHomeDir);
  {$ENDIF}
  //generic, superseeded by system specific values, if not empty
  if Result = '' then
    Result := GetCurrentDir;
  if Result[Length(Result)] <> DirectorySeparator then
    Result := Result + DirectorySeparator;
end;

//return the first occurence index, not usefull if you need multiple ones
function StrExistsInList(const StrList: TStringList; S: string): integer;
var
  I: Integer;
begin
  Result := -1;
  if not Assigned(StrList) then
    Exit;
  I := 0;
  while (I < StrList.Count - 1) and (StrList[I] <> S) do
    Inc(I); //increase until we have an occurence or we get to the end of the string
  if StrList[I] = S then
    Result := I;
end;

function StrExistsInListBox(const StrList: TListBox; S: string): integer;
var
  SL: TStringList;
begin
  SL := TStringList.Create;
  SL.Assign(StrList.Items);
  Result := StrExistsInList(SL, S);
end;

//for both following functions a "repeat [...] until StrXXX(<...>) = -1;"
//will make it happen on every possible occurence if any
function StrRemove(var StrList: TStringList; S: string): integer;
begin
  Result := StrExistsInList(StrList, S);
  StrList.Delete(Result);
end;

function StrChange(var StrList: TStringList; const sOld, sNew: string): integer;
begin
  Result := StrExistsInList(StrList, sOld);
  StrList[Result] := sNew;
end;

////////////////////////////////////////////////////////////////////////////////
//in Linux and BSDs if filename contains delimiter ' change the character in ",
//and checking special cases for Gnome and KDE in Windows delimiter is " and it's
//not a valid character in filenames, so this control returns the input string
//(which doesn't need to be variable) on other systems filenames are not escaped
//
//- convert %XX (where XX is an hexa value) to the equivalent char by code
//- braces management (' on unix and " on Windows) as unneeded with Lazarus.
//- deleting « file:// » if present.
//- Supporting environnement variables (eg. $(USER)\MonProg).
//- deleting double directory separators (eg. \\ or // -> \ or /).
//- automatic separator convertion (eg. with Windows a / would be \)
//- adds terminal \ or / for directories if not exists.
//- detect invalid chars (depending on the OS)
//
//Returns: Negative when errors, positive when Ok where
//Low(Result) is pos of the error when applicable and High(Result) the error code
//
//List of error codes:
//-$01XX: error in %XX convertion (mostly non hexa value)
//-$02XX: "$(" found but no ")" while checking environment (XX pos of "$(")
//-$0300: directory separator in a filename
//-$0400: Comma in a filename
//-$0500: windows only: use of a system reserved file extention
//-$10XX: empty env var (XX pos of "$(")
//-$20XX: invalid char where XX is the invalid char code
//+$0000: valid filename, no such file or directory
//+$1000: valid filename, directory exists
//+$2000: valid filename, file exist
function FormatFileName(S: String; out VS: string): Integer;
{$warning This should be splited in several functions for selective checkings}
var
  Str, TmpS, EnvVar: String;
  I, J: Integer;
  Ch: Char;
const
  FilePrefix = 'file://';

  procedure InvalidChar(C: Char);
  begin
    VS := Str;
    Result := $2000 + Ord(C);
  end;

begin
  Result := $0000;
  Str := Trim(S);
  // Delete ' on Unix or " on Windows as it is not needed when assuming there's
  // one file path per string
  I := 1;
  repeat
     I := Pos('''', Str);
     if I > 0 then
       Delete(Str, I, 1);
  until I = 0;
  //find and delete 'file://' (and any part before) if it is passed as part of
  //filename (it happens sometimes in Gnome, i.e. using "open with" context
  //menu entry) or if it has been entered as is by the user
  I := Pos(FilePrefix, Str);
  if I > 0 then
    Str := Copy(Str, I + Length(FilePrefix), Length(Str) - I - Length(FilePrefix) - 1);
  //replace %xx with the appropriate character used sometimes to pass non
  //available keyboards char or spaces. xx must be 2 hexa char
  repeat
    I := Pos('%', Str);
    if I <> 0 then
    try //if there's synthax error like non hexa char
      Ch := Char(StrToWord(Str[I + 1] + Str[I + 2]));
      Delete(Str, I, 3);
      Insert(Ch, Str, I);
    except
      Result := $0100 + I;
    end;
  //if error leave everything else as is as it's not valid path anyway
  until (I = 0) or (Result <> 0);
  //the application support the use of environment variable in filenames just
  //like Unix command line does, so this extract environment variable when $()
  //symbol is found
  repeat
    I := Pos('$(', Str);
    if I <> 0 then
    try
      J := I;
      while Str[J] <> ')' do
        Inc(J);
      //on windows we use Windows unt that have an incompatible GetEnvironmentVariable
      EnvVar := SysUtils.GetEnvironmentVariable(Copy(Str, I + 2, J - I - 2));
      if EnvVar <> '' then
      begin
        Delete(Str, I, I - J);
        Insert(EnvVar, Str, I);
      end else
        Result := $1000 + I;
    except
      Result := $0200 + I;
    end;
  until (I = 0) or (Result <> 0);
  // remove double / on unix or double \\ on windows
  {$warning This is not working when we have network address}
  repeat
      I := Pos('//', Str);
    if I = 1 then
      I := 0;
    if I <> 0 then
      if Str[I - 1] <> ':' then //it's looking like an URL so don't erase it
        Delete(Str, I, 1);
  until I = 0;
  // check for remaining invalid char
  for I := 0 to 31 do
    if (Pos(Char(I), Str) <> 0) then
      InvalidChar(Char(I));
  if Pos('*', Str) <> 0 then
    InvalidChar('*');
  if Pos('?' , Str) <> 0 then
    InvalidChar('?');
    if Pos('''', Str) <> 0 then
      InvalidChar('''');
  if Pos(':', Str) <> 0 then
    InvalidChar(':');
  if Pos('<', Str) <> 0 then
    InvalidChar('<');
  if Pos('>', Str) <> 0 then
    InvalidChar('>');
  if Pos('|', Str) <> 0 then
    InvalidChar('|');
  TmpS := ExtractFileName(Str);
  //reserved characters, filename only (others are checked for the full name)
  if (Pos('\', TmpS) <> 0) or (Pos('/', TmpS) <> 0) then
    Result := $0300; //we should get the pos for low(result)
  if Pos(':', TmpS) <> 0 then
    Result := $0400; //we should get the pos for low(result)
  //reserved filename extentions (Windows)
  if Result <> $0000 then
    Result := -Result
  else
    if DirectoryExists(Str) then
    begin
      if Str[Length(Str)] <> '/' then
        Str := Str + '/';
      Result := $1000;
    end else
      if FileExists(Str) then
        Result := $2000;
  VS := Str;
end;

function DirectoryIsEmpty(ADir: string): Boolean;
var
  SR: TSearchRec;
  Mask: string;
begin
  Mask := '*';
  if ADir[Length(ADir)] <> DirectorySeparator then
    ADir := ADir + DirectorySeparator;
  Result := FindFirst(ADir + Mask, faAnyFile, SR) <> 0;
  FindClose(SR);
end;

function RemoveSpecialChar(const S: UnicodeString): UnicodeString;
var
  I: Integer;
  Tmp: UnicodeString;
begin
  Tmp := S;
  for I := 1 to Length(S) do
    if not (S[I] in ['0'..'9', '.', '-', '_', 'A'..'Z', 'a'..'z']) then
      Tmp[I] := '_'
    else
      Tmp[I] := S[I];
  Result := Tmp;
end;

function CreateLockFile(const AName: string): Boolean;
var
  AFile: Text;
begin
  Result := True;
  try
    if FileExists(AName) then
      if not DeleteFile(AName) then
      begin
        Result := False;
        Exit;
      end;
    {$I-}
    Assign(AFile, AName);
    Rewrite(AFile);
    if IOResult = 0 then
    begin
      Writeln(AFile, GetUserName + '@' + GetComputerName);
      Writeln(AFile, IntToStr(GetProcessID));
      Close(AFile);
      Result := IOResult = 0;
    end else
      Result := False;
    {$I+}
  except
    Result := False;
  end;
end;

function GetNumberOfFiles(const ADir: string;
  const AOpt: TFileCountOpt): LongWord;
var
  Rec: TSearchRec;
  S: string;
begin
  Result := 0;
  if ADir[Length(ADir)] <> DirectorySeparator then
    S := ADir + DirectorySeparator
  else
    S := ADir;
  if FindFirst(S + '*', faAnyFile, Rec) = 0 then
  begin
    repeat
      if ((Rec.Attr and faDirectory) <> faDirectory) then //file ?
	Inc(Result)
      else //directories:
        if Rec.Name[1] <> '.' then //don't count '.' and '..'
        begin
          if fcIncludeDirs in AOpt then
            Inc(Result);
          if fcIncludeSubDirs in AOpt then
            Result := Result + GetNumberOfFiles(S + '/' + Rec.Name, AOpt);
        end;
    until FindNext(Rec) <> 0;
    FindClose(Rec);
  end;
end;

function DirectoryIsReadOnly(const ADirName: string): Boolean;
begin
  //pure Unix type checking (will not work on anything else)
  Result := fpAccess(PChar(pointer(ADirName)), W_OK) <> 0;
end;

function ExtractHostName(const S: string): string;
var
  Start: integer;
  Delim: Char;
  Tmp: string;
begin
  Result := '';
  Delim := '/';
  Start := Pos('//', S);
  if Start = 0 then
  begin
    Start := Pos('\\', S); //this is for some windows servers
    Delim := '\';
  end;
  if Start = 0 then
    Exit;
  Tmp := Copy(S, Start + 1, Length(S) - Start);
  if Pos(Delim, Tmp) <> 0 then
    Result := Copy(Tmp, 1, Pos(Delim, Tmp))
  else
    Result := Tmp;
end;

procedure GetProxyInfo(const S: string; out User, Pass, Address, Port: string);
var
  Tmp, UsrInfo, AddrInfo: string;
begin
  if Pos(sHttpPrefix, S) = 1 then
    Tmp := Copy(S, Length(sHttpPrefix) + 1, Length(S) - Length(sHttpPrefix))
  else
    if Pos( sFtpPrefix, S) = 1 then
      Tmp := Copy(S, Length(sFtpPrefix) + 1, Length(S) - Length(sFtpPrefix));
  if Pos('@', S) <> 0 then
  begin
    UsrInfo := Copy(Tmp, 1, Pos('@', Tmp) - 1);
    AddrInfo := Copy(Tmp, Pos('@', Tmp) + 1, Length(Tmp) - Pos('@', Tmp));
  end else
  begin
    UsrInfo := '';
    AddrInfo := Tmp;
  end;
  if (AddrInfo <> '') and ((AddrInfo[Length(AddrInfo)] = '/') or
    (AddrInfo[Length(AddrInfo)] = ';')) then
    AddrInfo := Copy(AddrInfo, 1, Length(AddrInfo) - 1);
  if UsrInfo <> '' then
    if Pos(':', UsrInfo) <> 0 then
    begin
      User := Copy(UsrInfo, 1, Pos(':', UsrInfo) - 1);
      Pass := Copy(UsrInfo, Pos(':', UsrInfo) + 1,
        Length(UsrInfo) - Pos(':', UsrInfo));
    end else
    begin
      User := UsrInfo;
      Pass := '';
    end;
  if Pos(':', AddrInfo) <> 0 then
  begin
    Address := Copy(AddrInfo, 1, Pos(':', AddrInfo) - 1);
    Port := Copy(AddrInfo, Pos(':', AddrInfo) + 1,
      Length(AddrInfo) - Pos(':', AddrInfo));
  end else
  begin
    Address := AddrInfo;
    Port := '';
  end;
end;

end.