root/trunk/ExtraFunctionsLcl.pas

///////////////////////////////////////////////////////////
//                   ExtraFunctionsFcl                   //
//    Модуль с самопальными функциями и прочим общего    //
//                   назначения под LCL.                 //
//                Copyright (C) 2007 Sagrer              //
//              Распространяется на условиях             //
//                      LGPL v2.1                        //
//                                                       //
//                  версия модуля 0.1                    //
//                                                       //
//                  sagrer@yandex.ru                     //
///////////////////////////////////////////////////////////

//К работе над данным файлом приложили руки, ноги.... короче аффтары:
// 1) Sagrer (sagrer@yandex.ru)

////////////////////////////////////////////////////////////////////////

unit ExtraFunctionsLcl;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Windows, Registry, crc;
  
const
  DoDebugOutput = true;            //Выводить ли дебажные мессаги.

  //Типо идентификаторы...
  
  //EnvPathAdd
  EnvPathAdd_User = 0;
  EnvPathAdd_Global = 1;
  
type
  TListOfStringLists = class        //Класс для списка списков строк %).
  private
    //Закрытые переменные
    StringLists : array of TStringList;
  protected
  public
    //Конструкторы-деструкторы...
    constructor Create; virtual;
    destructor Destroy; override;

    //Открытые методы...
    procedure SetCount(const NewCount : Integer);   //Выставляет длину массива списков, если нужно создает, если нужно - удаляет объекты.
    function AddList : Integer;       //Добавляет элемент в конец списка, возвращает его индекс.
    function InsertList(const Index : Integer) : Integer;   //Вставляет элемент в указанную позицию. Возвращает реальный индекс в который добавлен элемент.
    procedure RemoveList(const Index : Integer);   //Удаляет элемент в указанной позиции.
    function Count : Integer;      //Возвращает количество элементов.
    function GetList(const Index : Integer) : TStringList;   //Вернуть элемент с указанным индексом.
  end;

//Глобальные функции.
Function StrRPos(str1,str2 : pchar) : pchar;  //На основе функции из FPC. Ищет первое вхождение str2 в str1, но с конца строки.
Function Parse( var S : AnsiString; const Separators : AnsiString ) : AnsiString;   //Функция для парсинга строк, сделано на основе функции из KOL.
Function ParseTail( var S : AnsiString; const Separators : AnsiString ) : AnsiString;   //Анологично тому что выше, но работает с хвоста.
Function ParseNumericHead(var S : AnsiString) : AnsiString;    //Парсит считая за разделитель первый попавшийся символ не-цифру.
Function IsNumericStr (Str : string) : boolean;      //А эта функа должна определять, состоит ли строка только из цифр.
Function IsVersionStr (Str : string) : boolean;      //Является ли строка номером версии.
Function IsNewVersion(OldVer, NewVer : string) : boolean;     //Функа должна проверять, новее ли версия.
Procedure ParsePathString(const PathString : string; var PathStringList : TStringList);  //Парсит строку с путями и загоняет инфу в TStringList.
Function CombinePathString(const PathStringList : TStringList) : string;  //Генерит из TStringList строку типа Path.
Function EnvPathExists(const PathStr : string; const CheckUser, CheckGlobal : boolean) : boolean;   //Проверяет, существует ли такой path в указанных переменных.
Function EnvPathRemove(const PathStr : string; const CheckUser, CheckGlobal : boolean) : boolean;   //Удаляет строку пути из указанных PATH. Результат - true если чего-то было удалено.
Function EnvPathAdd(const PathStr : string; const Target : integer; const ForceRemoveDoubles : boolean = true; const ForceCreateLocal : boolean = false) : boolean;     //Добавляет путь в указанные PATH.
Function TrimExLeft(const InputStr, TrimChars : string) : string;   //Тримает символы слева.
Function TrimExRight(const InputStr, TrimChars : string) : string;   //Тримает символы справа.
Function TrimEx(const InputStr, TrimChars : string) : string;   //Тримает символы со всех сторон.
Function FileToCRC32(const FileName : string; const ConsoleOutput : boolean = false) : cardinal;   //Вычислить CRC32 для файла, если надо с индикацией процесса в консоль.
Function CheckCharNum(const Ch : char) : boolean;    //Проверить - является ли символ цифрой
Function CheckStrInt(const St : string) : boolean;    //Проверить - является ли строка представлением целочисленного значения
Function CheckStrFloat(const St : string) : boolean;   //Проверить - является ли строка представлением дробного значения
Function IntToBool(const InputInt : Integer) : boolean;   //Превратить Integer в Boolean
Function StrToBool(const InputStr : AnsiString) : boolean;  //Превратить String в Boolean
Function BoolToInt(const InputBool : boolean) : Integer;  //Превратить Boolean в Integer
Function BoolToStr(const InputBool : boolean) : AnsiString;   //Превратить Boolean в String
Function ReadFirstLineFromStr(const InputStr : AnsiString) : AnsiString;  //Элементарно скопировать строку от начала до байта #13 или #10 если #13 не обнаружится.

implementation

uses
  ExtraFileUtilsLCL;
  
/////////////////////////////////////////////
//            TListOfStringLists           //
/////////////////////////////////////////////

//Класс для списка списков строк %).

//-----------------------------------------//
//        Конструкторы-деструкторы...      //
//-----------------------------------------//

constructor TListOfStringLists.Create;
begin
  //Нужно инициализировать массив, точнее определиться что он пустой.
  SetLength(Self.StringLists,0);
end;

destructor TListOfStringLists.Destroy;
var
  I : Integer;
begin
  //Выкидываем мусор
  for I := 0 to Length(Self.StringLists)-1 do begin
    //Чистим массив, разрушая вложенные в него объекты.
    Self.StringLists[i].Free;
  end;
  //И выставляем длину самого массива в нуль.
  SetLength(Self.StringLists,0);

  //Выполнить унаследованный деструктор
  inherited;
end;

//------------------------------------------//
//            Открытые методы...            //
//------------------------------------------//

procedure TListOfStringLists.SetCount(const NewCount : Integer);
//Выставляет длину массива списков, если нужно создает, если нужно - удаляет объекты.
var
  I, J : Integer;
begin
  //Тут смотря как - если нужно уменьшить массив - действуем одним способом, иначе другим.
  if NewCount < Length(Self.StringLists) then begin
    //Нужно уменьшать массив. Удаляем лишние элементы.
    for I := NewCount to Length(Self.StringLists)-1 do begin
      //Чистим массив, разрушая вложенные в него объекты.
      Self.StringLists[I].Free;
    end;
    //И выставляем новую длину массива.
    SetLength(Self.StringLists,NewCount);
  end
  else if NewCount > Length(Self.StringLists) then begin
    //Нужно увеличивать массив. Сначала выставим новую длину.
    J := Length(Self.StringLists);
    SetLength(Self.StringLists,NewCount);
    //Теперь добавим новых элементов.
    for I := J to NewCount-1 do begin
      Self.StringLists[I] := TStringList.Create;
    end;
  end;
  
  //Особо наблюдательные заметят, что тут не обрабатывается вариант когда Length = GetLength(Self.StringLists).
  //Особо понятливые при этом сообразят что делать в таком случае ничего не надо.
end;

function TListOfStringLists.AddList : Integer;
//Добавляет элемент в конец списка, возвращает его индекс.
begin
  //Увеличиваем количество элементов на 1 штука.
  Result := Length(Self.StringLists);      //Это вернет индекс нового элемента.
  SetLength(Self.StringLists,Result+1);
  //Создаем объект.
  Self.StringLists[Result] := TStringList.Create;
end;

function TListOfStringLists.InsertList(const Index : Integer) : Integer;
//Вставляет элемент в указанную позицию. Возвращает реальный индекс в который добавлен элемент.
var
  TempPointer : TStringList;
  I : Integer;
  
begin
  //+1 элемент массива...
  Result := Self.AddList;
  //Смотрим, если Index меньше, чем индекс новосозданного элемента - требуется его переместить в нужную позицию.
  if Index < Result then begin
    //Копируем указатель нового элемента...
    TempPointer := Self.StringLists[Result];
    //В цикле предвигаем элементы так чтобы в Index "освободить" место...
    for I := Result downto Index+1 do begin
      Self.StringLists[I] := Self.StringLists[I-1];
    end;
    //И записываем указатель в "освободившийся" элемент...
    Self.StringLists[Index] := TempPointer;
  end;
end;

procedure TListOfStringLists.RemoveList(const Index : Integer);
//Удаляет элемент в указанной позиции.
var
  I : Integer;
begin
  //Тут несколько проще. Разрушаем указанный объект, затем передвигаем все на его место.
  if Length(Self.StringLists) > Index then begin
    //Если указанный Index-ом объект существует - удаляем.
    Self.StringLists[Index].Free;
    //Если нужно - сдвигаем элементы...
    if Length(Self.StringLists)-1 > Index then begin
      for I := Index to Length(Self.StringLists)-2 do begin
        Self.StringLists[I] := Self.StringLists[I+1];
      end;
    end;
    //И уменьшаем размер массива.
    SetLength(Self.StringLists,Length(Self.StringLists)-1);
  end;
end;

function TListOfStringLists.Count : Integer;
//Возвращает количество элементов.
begin
  Result := Length(Self.StringLists);    //От так вот.
end;

function TListOfStringLists.GetList(const Index : Integer) : TStringList;
//Вернуть элемент с указанным индексом.
begin
  Result := Self.StringLists[Index];
end;
  
/////////////////////////////////////////////
//            Глобальные функции           //
/////////////////////////////////////////////

Function StrRPos(str1,str2 : pchar) : pchar;
//На основе функции из FPC.
//Ищет первое вхождение str2 в str1, но с конца строки.
var
   p : pchar;
   lstr2 : SizeInt;
begin
   StrRPos:=nil;
   if (str1 = nil) or (str2 = nil) then
     exit;
   p:=strrscan(str1,str2^);
   if p=nil then
     exit;
   lstr2:=strlen(str2);
   while p<>nil do
     begin
        if strlcomp(p,str2,lstr2)=0 then
          begin
             StrRPos:=p;
             exit;
          end;
        dec(p);
        p:=strrscan(p,str2^);
     end;
end;

Function Parse( var S : AnsiString; const Separators : AnsiString ) : AnsiString;
//Функция для парсинга строк, сделано на основе функции из KOL.
var Pos : Integer;

begin
  Pos := Longint( StrPos( PChar(S), PChar(Separators) ) - LongInt(S) + 1 ) ;
  if Pos <= 0 then
     Pos := Length( S ) + Length(Separators);
  Result := S;
  S := Copy( Result, Pos + Length(Separators), MaxInt );
  Result := Copy( Result, 1, Pos - 1 );
end;

Function ParseTail( var S : AnsiString; const Separators : AnsiString ) : AnsiString;
//Анологично тому что выше, но работает с хвоста.
var Pos : Integer;

begin
  Pos := Longint( StrRPos( PChar(S), PChar(Separators) ) - LongInt(S) + 1 ) ;
  Result := S;
  S := Copy(Result, 1, Pos-1);
  Result := Copy(Result, Pos+Length(Separators), Length(Result)-(Pos+Length(Separators))+1);
end;

Function ParseNumericHead(var S : AnsiString) : AnsiString;
//Парсит считая за разделитель первый попавшийся символ не-цифру.
var
  Pos : Integer;
  Finded : Boolean;

begin
  //Инициализация.
  Pos := 0;
  Finded := false;
  
  //Ищем первую "не-цифру"
  repeat
    Pos := Pos+1;
    if Pos <= Length(S) then begin
      if IsNumericStr(S[Pos]) = false then begin
        //Нашли.
        Finded := true;
        Pos := Pos-1;
      end;
    end;
  until (Pos = Length(S)) or (Finded = true);
  
  //Ну и, собсно парсенг.
  Result := Copy(S,1,Pos);
  Delete(S,1,Pos);
end;

Function IsNumericStr (Str : string) : boolean;
var
  I, StrLength : integer;
  FindedChar : boolean;
begin
  //А эта функа должна определять, состоит ли строка только из цифр.

  Result := true;  //Умолчальный результат.

  StrLength := Length(Str);
  If StrLength > 0 then begin
    //Если в строке чета есть то можно приступать.
    For I := 1 to StrLength do begin
      FindedChar := true;
      If Str[I] = '1' then FindedChar := false;  //Достаточно выполнится 1 проверке - и чар будет не найден :)
      If Str[I] = '2' then FindedChar := false;
      If Str[I] = '3' then FindedChar := false;
      If Str[I] = '4' then FindedChar := false;
      If Str[I] = '5' then FindedChar := false;
      If Str[I] = '6' then FindedChar := false;
      If Str[I] = '7' then FindedChar := false;
      If Str[I] = '8' then FindedChar := false;
      If Str[I] = '9' then FindedChar := false;
      If Str[I] = '0' then FindedChar := false;

      //И если был обнаружен символ-не цифра - обломить все нафиг.
      If FindedChar = true then Result := false;
    end;
  end
  else begin
    Result := false;  //Типа строка пустая.
  end;
end;

Function IsVersionStr (Str : string) : boolean;
var
  I, StrLength : integer;
  FindedChar, WasPoint : boolean;
begin
  //Является ли строка номером версии.

  Result := true;  //Умолчальный результат.

  StrLength := Length(Str);
  If StrLength > 0 then begin
    //Если в строке чета есть то можно приступать.
    WasPoint := false;
    For I := 1 to StrLength do begin
      FindedChar := true;
      If Str[I] = '1' then begin
        FindedChar := false;
        WasPoint := false;
      end;
      If Str[I] = '2' then begin
        FindedChar := false;
        WasPoint := false;
      end;
      If Str[I] = '3' then begin
        FindedChar := false;
        WasPoint := false;
      end;
      If Str[I] = '4' then begin
        FindedChar := false;
        WasPoint := false;
      end;
      If Str[I] = '5' then begin
        FindedChar := false;
        WasPoint := false;
      end;
      If Str[I] = '6' then begin
        FindedChar := false;
        WasPoint := false;
      end;
      If Str[I] = '7' then begin
        FindedChar := false;
        WasPoint := false;
      end;
      If Str[I] = '8' then begin
        FindedChar := false;
        WasPoint := false;
      end;
      If Str[I] = '9' then begin
        FindedChar := false;
        WasPoint := false;
      end;
      If Str[I] = '0' then begin
        FindedChar := false;
        WasPoint := false;
      end;
      If Str[I] = '.' then begin
        FindedChar := false;
        If WasPoint = true then begin
          //Если до этого уже была точка - то аблооом.
          FindedChar := true;
        end;
        WasPoint := true;
      end;

      //И если был обнаружен символ-не цифра и не точка - обломить все нафиг.
      If FindedChar = true then Result := false;
    end;
  end
  else begin
    Result := false;  //Типа строка пустая.
  end;
end;

Function IsNewVersion(OldVer, NewVer : string) : boolean;
var
  CurrVerLevels, I,
  OldVerLevels, MaxLevel : integer;
  TempStr, TempStr2,
  OldVerTemp, NewVerTemp : string;
begin
  //Функа должна проверять, новее ли версия.

  Result := false;  //Типа умолчальное значение.
  OldVerTemp := OldVer;
  NewVerTemp := NewVer;


  If (IsVersionStr(OldVer) = true) and (IsVersionStr(NewVer) = true) then begin
    //Только если в обоих строках - версии.

    //Для начала - посмотреть сколько уровней версии в старой версии.
    TempStr := NewVerTemp;
    TempStr2 := '';      //Переменная инициализируется чисто чтоб не вылазил хинт при Parse от компилера.
    CurrVerLevels := 1;  //Есть как минимум 1 уровень.
    repeat
      If Pos('.',TempStr) <> 0 then begin
        CurrVerLevels := CurrVerLevels + 1;   //Есть минимум еще 1 уровень.
        TempStr2 := Parse(TempStr,'.');
      end;
    until Pos('.',TempStr) = 0;

    //И в новой.
    TempStr := OldVerTemp;
    OldVerLevels := 1;  //Есть как минимум 1 уровень.
    repeat
      If Pos('.',TempStr) <> 0 then begin
        OldVerLevels := OldVerLevels + 1;   //Есть минимум еще 1 уровень.
        TempStr2 := Parse(TempStr,'.');
      end;
    until Pos('.',TempStr) = 0;

    //Теперь вычислить максимальный уровень.
    If CurrVerLevels > OldVerLevels then begin
      MaxLevel := CurrVerLevels;
    end
    else begin
      MaxLevel := OldVerLevels;
    end;

    //Теперь - к той версии что самая малоуровневая - добавить нулей.
    If CurrVerLevels < MaxLevel then begin
      For I := 1 to MaxLevel - CurrVerLevels do begin
        NewVerTemp := NewVerTemp+'.0';
      end;
    end;
    If OldVerLevels < MaxLevel then begin
      For I := 1 to MaxLevel - OldVerLevels do begin
        OldVerTemp := OldVerTemp+'.0';
      end;
    end;

    //Ну а теперь - собсно сравнение наконецто.
    I := 0;
    repeat
      I := I+1;
      TempStr := Parse(OldVerTemp,'.');
      TempStr2 := Parse(NewVerTemp,'.');
      If StrToInt(TempStr2) > StrToInt(TempStr) then Result := true;
    until (I = MaxLevel) or (Result = true);
  end;
end;



Procedure ParsePathString(const PathString : string; var PathStringList : TStringList);
//Парсит строку с путями и загоняет инфу в TStringList.
begin

  //Чистим список.
  PathStringList.Clear;
  
  //Парсим...
  ExtractStrings([';'], [' '], PChar(PathString), PathStringList);
end;

Function CombinePathString(const PathStringList : TStringList) : string;
//Генерит из TStringList строку типа Path.
var
  I : integer;
begin

  Result := '';
  
  if PathStringList.Count > 0 then begin
    for I := 0 to PathStringList.Count-1 do begin
      //Добавить строку...
      Result := Result+PathStringList.Strings[I];
      //И если надо - разделитель.
      if I < PathStringList.Count-1 then begin
        Result := Result+';';
      end;
    end;
  end;
  
end;

Function EnvPathExists(const PathStr : string; const CheckUser, CheckGlobal : boolean) : boolean;
//Проверяет, существует ли такой path в указанных переменных.
var
  Registr : TRegistry;
  PathVar : string;
  PathVarList : TStringList;
  I : Integer;

  Function SearcherCode : boolean;
  begin
    Result := false;

    //Получаем путь...
    PathVar := Registr.ReadString('PATH');
    //Парсим строчку...
    ParsePathString(PathVar,PathVarList);
    if PathVarList.Count > 0 then begin
      //Ищем там все наши пути. Только если есть где искать ессно.
      I := -1;
      repeat
        I := I+1;
        if UpperCase(DelLastSlash(PathVarList.Strings[I])) = UpperCase(DelLastSlash(PathStr)) then begin
          Result := true;   //Чета нашли % ).
        end;
      until (I >= PathVarList.Count-1) or (Result = true);
    end;
  end;

begin

  //Инициализация..
  Registr := TRegistry.Create;
  PathVarList := TStringList.Create;
  Result := false;

  //Чистим
  //Юзверя...
  If CheckUser = true then begin
    Registr.RootKey := HKEY_CURRENT_USER;
    Registr.OpenKey('\Environment',false);
    Result := SearcherCode();
  end;

  //Глобально...
  If CheckGlobal = true then begin
    Registr.RootKey := HKEY_LOCAL_MACHINE;
    Registr.OpenKey('\SYSTEM\CurrentControlSet\Control\Session Manager\Environment',false);
    Result := Result or SearcherCode();
  end;

  //Чистим мусор...
  Registr.Free;
  PathVarList.Free;

end;

Function EnvPathRemove(const PathStr : string; const CheckUser, CheckGlobal : boolean) : boolean;
//Удаляет строку пути из указанных PATH. Результат - true если чего-то было удалено.
var
  Registr : TRegistry;
  PathVar : string;
  PathVarList : TStringList;
  I : Integer;
  Finded : boolean;
  
  Function RemoverCode : boolean;
  begin
    Result := false;

    //Получаем путь...
    PathVar := Registr.ReadString('PATH');
    //Парсим строчку...
    ParsePathString(PathVar,PathVarList);
    if PathVarList.Count > 0 then begin
      //Ищем там все наши пути и удаляем. Только если есть где искать ессно.
      I := -1;
      Finded := false;    //Нашли ли мы там нужный путь...
      repeat
        I := I+1;
        if UpperCase(DelLastSlash(PathVarList.Strings[I])) = UpperCase(DelLastSlash(PathStr)) then begin
          PathVarList.Delete(I);
          I := I-1;
          Finded := true;   //Чета нашли % ).
        end;
      until I >= PathVarList.Count-1;

      //Вернем строчку обратно в переменную...
      //Ессно это сработает только если в переменной хоть что-то было и тем более если
      //там удалось найти искомое...
      if Finded = true then begin
        //Генерим строчку...
        PathVar := CombinePathString(PathVarList);
        if DoDebugOutput = true then begin
          //Writeln('New path will be: '+PathVar);
        end;
        //И собсно записываем новое значение...
        Registr.WriteString('PATH',PathVar);           //Временно закомменчено - на время отладки.
        //Результат.
        Result := true;
      end;

    end;
  end;
  
begin

  //Инициализация..
  Registr := TRegistry.Create;
  PathVarList := TStringList.Create;
  Result := false;
  
  //Чистим
  //Юзверя...
  If CheckUser = true then begin
    Registr.RootKey := HKEY_CURRENT_USER;
    Registr.OpenKey('\Environment',false);
    Result := RemoverCode();
    Registr.CloseKey;
  end;
  
  //Глобально...
  If CheckGlobal = true then begin
    Registr.RootKey := HKEY_LOCAL_MACHINE;
    Registr.OpenKey('\SYSTEM\CurrentControlSet\Control\Session Manager\Environment',false);
    Result := Result or RemoverCode();
    Registr.CloseKey;
  end;
  
  //Сообщаем другим прогам что щей-то поменялось...
  if Result = true then begin
    SendMessage( HWND_BROADCAST, WM_SETTINGCHANGE, 0, LPARAM(LPCSTR('Environment')) );
  end;
  
  //Чистим мусор...
  Registr.Free;
  PathVarList.Free;

end;

Function EnvPathAdd(const PathStr : string; const Target : integer; const ForceRemoveDoubles : boolean = true; const ForceCreateLocal : boolean = false) : boolean;
//Добавляет путь в указанные PATH.
var
  Registr : TRegistry;
  UserPathVar, GlobalPathVar : string;
  UserPathVarList, GlobalPathVarList : TStringList;
  Finded : boolean;
  
begin
  //Инициализация..
  Registr := TRegistry.Create;
  Result := false;
  
  //Итак, в зависимости от того куда собираемся добавлять...
  if Target = EnvPathAdd_Global then begin
    //В глобалку добавляем
    
    //Ищем есть ли этот путь в локалке. Если есть - удаляем.
    EnvPathRemove(PathStr, true, false);
    
    //Теперь проверим - есть ли в глобалке такой путь уже...
    Finded := EnvPathExists(PathStr, false, true);
    
    //Если нифига не нашли - добавляем переменную. Если нашли - ниче трогать не надо %).
    if Finded = false then begin
      Registr.RootKey := HKEY_LOCAL_MACHINE;
      Registr.OpenKey('\SYSTEM\CurrentControlSet\Control\Session Manager\Environment',true);
      //Получаем путь...
      GlobalPathVar := Registr.ReadString('PATH');
      //Парсим строчку...
      GlobalPathVarList := TStringList.Create;
      ParsePathString(GlobalPathVar,GlobalPathVarList);
      //Добавляем значение...
      GlobalPathVarList.Add(PathStr);
      GlobalPathVar := CombinePathString(GlobalPathVarList);
      //Пишем все обратно.
      if DoDebugOutput = true then begin
        //Writeln('New global path will be: '+GlobalPathVar);
      end;
      //И собсно записываем новое значение...
      Registr.WriteString('PATH',GlobalPathVar);           //Временно закомменчено - на время отладки.
      Registr.CloseKey;
      //Сообщаем другим прогам что щей-то поменялось...
      SendMessage( HWND_BROADCAST, WM_SETTINGCHANGE, 0, LPARAM(LPCSTR('Environment')) );
      //Чистим мусор...
      GlobalPathVarList.Free;
    end;
  end
  else if Target = EnvPathAdd_User then begin
    //В локалку добавляем

    //Проверяем, есть ли в глобалке такой путь (если не форсим добавление в локалку),
    //либо если сказано удалять в глобалке - удаляем.
    Finded := false;
    if ForceRemoveDoubles = true then begin
      //Удаляем глобалку
      EnvPathRemove(PathStr, false, true);
    end
    else if ForceCreateLocal = false then begin
      //Проверяем есть ли что-то в глобалке - если есть то в локалку добавляться не будет.
      Finded := EnvPathExists(PathStr, false, true);
    end;
    
    //Если пока есть причины продолжать - проверяем, есть ли в локалке такой путь...
    if Finded = false then begin
      Finded := EnvPathExists(PathStr, true, false);
    end;
    
    //И теперь, если таки нужно добавить новое значение в переменную - добавляем.
    Registr.RootKey := HKEY_CURRENT_USER;
    Registr.OpenKey('\Environment',true);
    //Получаем путь...
    UserPathVar := Registr.ReadString('PATH');
    //Парсим строчку...
    UserPathVarList := TStringList.Create;
    ParsePathString(UserPathVar,UserPathVarList);
    //Добавляем значение...
    UserPathVarList.Add(PathStr);
    UserPathVar := CombinePathString(UserPathVarList);
    //Пишем все обратно.
    if DoDebugOutput = true then begin
      //Writeln('New user path will be: '+UserPathVar);
    end;
    //И собсно записываем новое значение...
    Registr.WriteString('PATH',UserPathVar);           //Временно закомменчено - на время отладки.
    Registr.CloseKey;
    //Сообщаем другим прогам что щей-то поменялось...
    SendMessage( HWND_BROADCAST, WM_SETTINGCHANGE, 0, LPARAM(LPCSTR('Environment')) );
    //Чистим мусор...
    UserPathVarList.Free;
  end;

  //Чистим мусор...
  Registr.Free;
end;

Function TrimExLeft(const InputStr, TrimChars : string) : string;
//Тримает символы слева.
var
  FindedTrimChar, FindedNoTrimChar : boolean;
  I, J : Integer;
  
begin

  //Умолчальное возвращаемое значение.
  Result := '';
  
  //Есть ли во входной строке хоть что-то....
  if Length(InputStr) > 0 then begin
    //Есть. Значит считаем количество символов с начала строки совпадающие с TrimChars...
    I := 0;
    FindedNoTrimChar := false;
    repeat
      //Цикл собственно подсчета количества тримаемых символов.
      //Щелкаем счетчиком и обнуляем индикатор проверки символа.
      I := I+1;
      FindedTrimChar := false;
      
      //Проверяем символ
      for J := 1 to Length(TrimChars) do begin
        //Цикл проверки является ли символ тримаемым %).
        if InputStr[I] = TrimChars[J] then begin
          FindedTrimChar := true;     //Нашли такой символ.
        end;
      end;
      
      //Смотрим результат проверки.
      if FindedTrimChar = false then begin
        //Таки символ оказался не тримаемым - подсчет завершен, отмечаем что первый не-трим символ найден.
        FindedNoTrimChar := true;
      end;
      
    until (I = Length(InputStr)) or (FindedNoTrimChar = true);
    
    //Теперь в зависимости от того что нашли...
    If FindedNoTrimChar = true then begin
      //Если в строке есть что-то помимо тримаемых символов - будем тримы удалять.
      //Если бы там были только они - можно было бы вообще ничего не делать - вернется пустая строка.
      Result := RightStr(InputStr,Length(InputStr)-I+1);
    end;
  end;
  
end;

Function TrimExRight(const InputStr, TrimChars : string) : string;
//Тримает символы справа.
var
  FindedTrimChar, FindedNoTrimChar : boolean;
  I, J : Integer;

begin

  //Умолчальное возвращаемое значение.
  Result := '';

  //Есть ли во входной строке хоть что-то....
  if Length(InputStr) > 0 then begin
    //Есть. Значит считаем количество символов с конца строки совпадающие с TrimChars...
    I := Length(InputStr)+1;
    FindedNoTrimChar := false;
    repeat
      //Цикл собственно подсчета количества тримаемых символов.
      //Щелкаем счетчиком и обнуляем индикатор проверки символа.
      I := I-1;
      FindedTrimChar := false;

      //Проверяем символ
      for J := 1 to Length(TrimChars) do begin
        //Цикл проверки является ли символ тримаемым %).
        if InputStr[I] = TrimChars[J] then begin
          FindedTrimChar := true;     //Нашли такой символ.
        end;
      end;

      //Смотрим результат проверки.
      if FindedTrimChar = false then begin
        //Таки символ оказался не тримаемым - подсчет завершен, отмечаем что первый не-трим символ найден.
        FindedNoTrimChar := true;
      end;

    until (I = 1) or (FindedNoTrimChar = true);

    //Теперь в зависимости от того что нашли...
    If FindedNoTrimChar = true then begin
      //Если в строке есть что-то помимо тримаемых символов - будем тримы удалять.
      //Если бы там были только они - можно было бы вообще ничего не делать - вернется пустая строка.
      Result := LeftStr(InputStr,I);
    end;
  end;

end;

Function TrimEx(const InputStr, TrimChars : string) : string;
//Тримает символы со всех сторон.
begin
  //Просто вызываем обе отдельные функции.
  Result := TrimExLeft(TrimExRight(InputStr, TrimChars), TrimChars);
end;

Function FileToCRC32(const FileName : string; const ConsoleOutput : boolean = false) : cardinal;
//Вычислить CRC32 для файла, если надо с индикацией процесса в консоль.
const
  ReadBuffSize = 500000;              //По 500 кб - думаю такой буффер пойдет даже на самой древней вендовой системе...
                                      //... или на виртуальном linux-хосте с wine.
var
  CurrStream : TFileStream;
  //Buffer : array [0..ReadBuffSize-1] of byte;    //Изза бага, возможно в fpc (в дельфе все пашет) - приходится юзать динамический массив.
  Buffer : array of byte;
  Readed, FullReaded : LongInt;
  
begin

  //Инициализируем значение CRC
  Result := crc32(0, nil, 0);
  //и выделяем память под буффер...
  SetLength(Buffer,ReadBuffSize-1);

  //Существует ли файлег...
  if FileExists(FileName) = true then begin
    //Если есть что высчитывать - считаем...
    
    //Счетчики чтения...
    Readed := 0;
    FullReaded := 0;
    
    //Открываем файл...
    CurrStream := TFileStream.Create(FileName,fmOpenRead);
    
    //Если надо - выводим инфу о прогрессе в консоль.
    if ConsoleOutput = true then begin
      Write('CRC32: '+FileName+' -> ');
    end;
    
    //Собсно считаем. Читаем файл по кусочкам пока файл не кончится.
    repeat
      Readed := CurrStream.Read(buffer[0],ReadBuffSize);
      FullReaded := FullReaded+Readed;
      Result := crc32(Result, @buffer[0], Readed);
    until Readed = 0;
    
    //Готово. Закрыть прочитанный файл.
    CurrStream.Free;
    //И если надо сообщить новую CRC в консоль...
    if ConsoleOutput = true then begin
      Writeln(IntToHex(Result,8));
    end;
    
  end;
  
  //Чистим мусор
  SetLength(Buffer,0);
end;

Function CheckCharNum(const Ch : char) : boolean;
//Проверить - является ли символ цифрой
begin
  result := false;
  if Ch = '0' then result := true;
  if Ch = '1' then result := true;
  if Ch = '2' then result := true;
  if Ch = '3' then result := true;
  if Ch = '4' then result := true;
  if Ch = '5' then result := true;
  if Ch = '6' then result := true;
  if Ch = '7' then result := true;
  if Ch = '8' then result := true;
  if Ch = '9' then result := true;
end;

Function CheckStrInt(const St : string) : boolean;
//Проверить - является ли строка представлением целочисленного значения
var
  ch : char;
  I : integer;
  
begin
  If (st <> '') and (st<>'-') then begin
    result := true;
    I := 0;
    If St[I+1] = '-' then I := I+1;
    repeat
      I := I+1;
      Ch := St[I];
      if ch <> #0 then if CheckCharNum(Ch) = false then result := false;
    until Ch = #0;
  end
  else result := false;
end;

Function CheckStrFloat(const St : string) : boolean;
//Проверить - является ли строка представлением дробного значения
var
  zapatih, I : integer;
  ch : char;
  
begin
  If (st <> '') and (st <> 'NAN') and (st<>'-') then begin
    result := true;
    zapatih := 1;
    I := 0;
    If St[I+1] = '-' then I := I+1;
    repeat
      I := I+1;
      Ch := St[I];
      If ch = '.' then zapatih := zapatih-1
      else if ch <> #0 then if CheckCharNum(Ch) = false then result := false;
    until Ch = #0;
    if zapatih < 0 then result := false;
  end
  else begin
    If St = 'NAN' then result := true
    else Result := false;
  end;
end;

Function IntToBool(const InputInt : Integer) : boolean;
//Превратить Integer в Boolean
begin
  If InputInt = 1 then begin
    Result := true;
  end
  else begin
    Result := false;
  end;
end;

Function StrToBool(const InputStr : AnsiString) : boolean;
//Превратить String в Boolean
begin
  //Проверить, интегеровое число ли ето.
  If CheckStrInt(InputStr) = true then begin
    //Если какое-то число, то вернуть его значение...
    Result := IntToBool(StrToInt(InputStr));
  end
  else begin
    //Если там какая-то фигня, то вернуть false
    Result := false;
  end;
end;

Function BoolToInt(const InputBool : boolean) : Integer;
//Превратить Boolean в Integer
begin
  If InputBool = true then begin
    //true
    Result := 1;
  end
  else begin
    //false
    Result := 0;
  end;
end;

Function BoolToStr(const InputBool : boolean) : AnsiString;
//Превратить Boolean в String
begin
  Result := IntToStr(BoolToInt(InputBool));
end;

Function IsLocalPath(const PathStr : string) : boolean;
//Возвращает true если путь локальный, и false если нет.
//Под локальным понимается путь начинающийся с точки.
begin
  Result := false;   //По умолчанию считаем что путь глобален.
  
  if Length(PathStr) >= 1 then begin
    if PathStr[1] = '.' then begin
      Result := true;
    end;
  end;
end;

Function ReadFirstLineFromStr(const InputStr : AnsiString) : AnsiString;
//Элементарно скопировать строку от начала до байта #13 или #10 если #13 не обнаружится.
var
  EndStrPos13, EndStrPos10, EndStrPos : Integer;
begin
  //Инициализация.
  Result := '';

  //Определяем позицию конца строки по #13.
  EndStrPos13 := Longint( StrPos( PChar(InputStr), PChar(#13) ) - LongInt(InputStr) + 1 ) ;
  if EndStrPos13 <= 0 then begin
    EndStrPos13 := Length( InputStr )+1;
  end;
  //И по #10
  EndStrPos10 := Longint( StrPos( PChar(InputStr), PChar(#10) ) - LongInt(InputStr) + 1 ) ;
  if EndStrPos10 <= 0 then begin
    EndStrPos10 := Length( InputStr )+1;
  end;
  //Определяем реальный конец строки.
  if EndStrPos10 < EndStrPos13 then begin
    EndStrPos := EndStrPos10;
  end
  else begin
    EndStrPos := EndStrPos13;
  end;

  //И собсно копируем результат.
  Result := Copy(InputStr,1,EndStrPos-1);
end;

// добаляет расширение если его еще нет.
function AddExtensionIfAbsent(const path, extension :String) :String;
var
  ex :AnsiString;
begin
  Result := path;
  ex := ExtractFileExt(path);
  if (ex = '') then begin
    Result := path + extension;
  end;
end;

// чистое имя файла, без расширения
function GetFileNameWithoutExtension(const path :String) :String;
var
  fileName :String;
  i        :Integer;
begin
  fileName := ExtractFileName(path);
  i := Length(FileName);
  while (i > 0) and (FileName[i] <> '.') do Dec(i);

  if (i > 0) then
    Result := Copy(FileName, 1, i - 1)
  else
    Result := fileName;


end;

end.