unit InSysUtils;

interface
uses Windows, SysUtils, Classes, Variants, Graphics,
		 Types, ActiveX, Math, ArrayUtils, SimpleXML;

{	Генерация внутренних ошибок [Власов] }
type
	EInternal = class(Exception)
		constructor Create(const aProcName, aText: String);
	end;

{Очищает слова от лишних пробелов. Если FirstUpper = True, то первая буква
 первого слова переводится в верхний регистер, если OtherUpper = True, то
 все первые буквы кроме первого слова переводятся в верхний регистер.[brd]}
	function CleanWords(const s: string; FirstUpper, OtherUpper: Boolean): string;


{Удаляет все вхождения символа в строке.[brd]}
	function DeleteChar(const s: string; c: char): string;
{Заменяет все вхождения символа в строке на другой символ.[brd]}
	function ReplaceChar(const s: string; aSrcC, aDstC: char): string;
{Удваивает все вхождения символа в строке.[brd]}
	function ExpandChar(const s: string; c: char): string;
{Удваивание символа заменяет на один символ.[brd]}
	function CompressChar(const s: string; c: char): string;
{Создает путь.[brd]}
	function MakePath(const AParts: array of string): string;

{Строка в вещественное число. [brd]}
	function StringToFloat(s: string): Extended;
{Вещественное число в строку с разделителем точкой. [brd]}
	function FloatToString(v: Extended): String;
	function StrToColor(const s: String): TColor;

{Возвращает true, если аргумент - число.[sergey]}
	function IsNumeric(const v: string): Boolean;

	function StrIsInteger(const s: string): Boolean;
	function StrIsFloat(const s: string): Boolean;
	function StrIsDate(const s: string): Boolean;
	function StrIsTime(const s: string): Boolean;
	function StrIsDateTime(const s: string): Boolean;

{	Поиск слова aWord в строке aWhere [Власов] }
	function FindWord(const aWord, aWhere: String): Boolean;

{Сравнивает два участка памяти и возвращает "<0", 0 или ">0"}
	function CmpBytes(P1, P2: Pointer; Count: Integer): Integer;
{Меняет содержимое двух учасков памяти}
	procedure SwapBytes(V1, V2: Pointer; Size: Integer); assembler;

{	Генерация внутренних ошибок [Власов] }
	procedure InternalError(const aProcName, aText: String); overload;
	procedure InternalCheck(aCond: Boolean; const aProcName, aText: String); overload;
	procedure InternalError(const aProcName, aFmt: String; const anArgs: array of const); overload;
	procedure InternalCheck(aCond: Boolean; const aProcName, aFmt: String;
		const anArgs: array of const); overload;

{	функции короткого if. [Власов] }
	function IIF(aCondition: Boolean; aTrueValue, aFalseValue: Integer): Integer;
	function FIF(aCondition: Boolean; aTrueValue, aFalseValue: Extended): Extended;
	function SIF(aCondition: Boolean; const aTrueValue, aFalseValue: String): String;
	function PIF(aCondition: Boolean; aTrueValue, aFalseValue: Pointer): Pointer;

{Очищает TList вместе с уничтожением объектов(TObject).[brd]}
	procedure ClearObjectList(aList: TList);
{Освобождает TList вместе с уничтожением объектов(TObject).[brd]}
	procedure FreeObjectList(aList: TList);
{Очищает Strings вместе с удалением объектов(TObject).[brd]}
	procedure ClearStringsWithObjects(aList: TStrings);
{Освобождает Strings вместе с удалением объектов(TObject).[brd]}
	procedure FreeStringsWithObjects(aList: TStrings);

	{	Следующие функции копируют значение и возвращают True, елси значение было изменено [Власов]}
	function SetChar(var aRef: Char; aValue: Char): Boolean; overload;
	function SetByte(var aRef: Byte; aValue: Byte): Boolean; overload;
	function SetSmallInt(var aRef: SmallInt; aValue: SmallInt): Boolean; overload;
	function SetWord(var aRef: Word; aValue: Word): Boolean; overload;
	function SetInt(var aRef: Integer; aValue: Integer): Boolean; overload;
	function SetLongint(var aRef: Longint; aValue: Longint): Boolean; overload;
	function SetShortString(var aRef; aSize: Integer; const aValue: string): Boolean;
	function SetString(var aRef: string; const aValue: string): Boolean; overload;
	function SetDouble(var aRef: Double; aValue: Double): Boolean; overload;
	function SetBoolean(var aRef: Boolean; aValue: Boolean): Boolean; overload;
	function SetColor(var aRef: TColor; aValue: TColor): Boolean; overload;
	function SetBrushStyle(var aRef: TBrushStyle; aValue: TBrushStyle): Boolean; overload;
	function SetPenStyle(var aRef: TPenStyle; aValue: TPenStyle): Boolean; overload;
	function SetFontPitch(var aRef: TFontPitch; aValue: TFontPitch): Boolean; overload;
	function SetFontStyle(var aRef: TFontStyles; aValue: TFontStyles): Boolean; overload;
	function SetBuf(var aRef; const aValue; aSize: Integer): Boolean;

	{	Следующие функции возвращают aNewValue. aHasChanges устанавливается в True
		только в том случае, если aNewValue <> anOldValue [Власов]}
	function SetChar(anOldValue, aNewValue: Char; var aHasChanges: Boolean): Char; overload;
	function SetByte(anOldValue, aNewValue: Byte; var aHasChanges: Boolean): Byte; overload;
	function SetSmallInt(anOldValue, aNewValue: SmallInt; var aHasChanges: Boolean): SmallInt; overload;
	function SetWord(anOldValue, aNewValue: Word; var aHasChanges: Boolean): Word; overload;
	function SetInt(anOldValue, aNewValue: Integer; var aHasChanges: Boolean): Integer; overload;
	function SetLongint(anOldValue, aNewValue: Longint; var aHasChanges: Boolean): Longint; overload;
	function SetString(const anOldValue, aNewValue: string; var aHasChanges: Boolean): String; overload;
	function SetDouble(anOldValue, aNewValue: Double; var aHasChanges: Boolean): Double; overload;
	function SetBoolean(anOldValue, aNewValue: Boolean; var aHasChanges: Boolean): Boolean; overload;
	function SetColor(anOldValue, aNewValue: TColor; var aHasChanges: Boolean): TColor; overload;
	function SetBrushStyle(anOldValue, aNewValue: TBrushStyle; var aHasChanges: Boolean): TBrushStyle; overload;
	function SetPenStyle(anOldValue, aNewValue: TPenStyle; var aHasChanges: Boolean): TPenStyle; overload;
	function SetFontPitch(anOldValue, aNewValue: TFontPitch; var aHasChanges: Boolean): TFontPitch; overload;
	function SetFontStyle(anOldValue, aNewValue: TFontStyles; var aHasChanges: Boolean): TFontStyles; overload;
	function SetPoint(const anOldValue, aNewValue: TPoint; var aHasChanges: Boolean): TPoint;

	{	Возвращает True, если хотя бы один aChanges[i] = True [Власов]}
	function HasChanges(const aChanges: array of Boolean): Boolean;

	{Функции для чтения/записи простых типов из потока / в поток}

	function ReadByte(aStm: TStream): Byte;
	procedure WriteByte(aStm: TStream; v: Byte);
	function ReadSmallInt(aStm: TStream): SmallInt;
	procedure WriteSmallInt(aStm: TStream; v: SmallInt);
	function ReadLongint(aStm: TStream): Longint;
	procedure WriteLongint(aStm: TStream; v: Longint);
	function ReadSingle(aStm: TStream): Single;
	procedure WriteSingle(aStm: TStream; v: Single);
	function ReadDouble(aStm: TStream): Double;
	procedure WriteDouble(aStm: TStream; v: Double);
	function ReadCurrency(aStm: TStream): Currency;
	procedure WriteCurrency(aStm: TStream; v: Currency);
	function ReadString(aStm: TStream): string;
	procedure WriteString(aStm: TStream; const v: string);
	function ReadBoolean(aStm: TStream): Boolean;
	procedure WriteBoolean(aStm: TStream; v: Boolean);
	function ReadVariant(aStm: TStream): Variant;
	procedure WriteVariant(aStm: TStream; const v: Variant);

	procedure LoadStringsFromStream(aStm: TStream; aStrings: TStrings);
	procedure SaveStringsToStream(aStm: TStream; aStrings: TStrings);

{ Вспомогательные функции для работы с TRect-ом [Власов]}
	function RectEqual(const r1, r2: TRect): Boolean;
	function RectWidth(const r: TRect): integer;
	function RectHeight(const r: TRect): integer;
	function RectInflatedBy(const r: TRect; dx, dy: integer): TRect;
	function RectOffsetBy(const r: TRect; dx, dy: integer): TRect;
	function RectNormalized(const r: TRect): TRect;
	function RectIntersected(const aR1, aR2: TRect): Boolean;
	procedure ExpandRect(var aRect: TRect; const aPoint: TPoint);

{Ищет ключ в командной строке. Символы "/" и "-" не надо передавать.[brd]}
	function FindCmdLineKey(const aSwitch: string): Boolean;
{Ищет параметр в командной строке. Формат: /aSwitch:aValue .
 Если не находит, то возвращает пустую строку.
 Символы "/" и "-" а также ":" не надо передавать.[brd]}
	function FindCmdLineParam(const aSwitch: string; var aValue: string): Boolean;
{Ищет параметр в командной строке. Формат: /aSwitch:aValue .
 Если не находит, то возвращает aDefValue.
 Символы "/" и "-" а также ":" не надо передавать.[brd]}
	function GetCmdLineParam(const aSwitch, aDefValue: string): string;

 function GetCompName: string;
 function GetTempFolder: string;
 function GetTmpFileName(const aThreeLetters: String): String;
 function GetCurrentModuleFileName: String;

 function ScanLong(const s: string; var aPos, aValue: Longint): Boolean;

 function GetStrIndex(const aValue: String; const aValues: array of String): Integer;

{	Копирование объекта через поток [Власов]}
type
	TLoadSaveProc = procedure(aStm: TStream) of object;
	TLoadSaveXmlProc = procedure(aNode: IXmlNode) of object;

	procedure CopyByStream(aSave, aLoad: TLoadSaveProc);
	procedure CopyByXml(aSave, aLoad: TLoadSaveXmlProc);

type
	TGetItemKey = function(anItem: Pointer): Pointer;
	TCompareKeys = function(aKey1, aKey2: Pointer): Integer;
	TListSortCompareFunction = function(anItem1, anItem2, aData: Pointer): Integer;

{	Следующие функции позволяют работать с TList-ом как с сортированным списком [Власов]}
function SortedList_Find(aList: TList; aGetItemKey: TGetItemKey; aCompareKeys: TCompareKeys;
	aKey: Pointer; var anIndex: Integer): Boolean;
procedure SortedList_Insert(aList: TList; aGetItemKey: TGetItemKey;
	aCompareKeys: TCompareKeys; anItem: Pointer);
procedure List_Sort(aList: TList; aCompare: TListSortCompareFunction; aData: Pointer);


// заменяет используемые в пути переменные среды их значениями
//(%PROGRAMFILES%\MyProgram -> C:\Program File\MyProgram)
function  ExpandPathEnvironmentValues(const aPath: String): String;

// получает из относительного пути абсолютный (в качестве базового берется aCurrentFolder)
// предварительно вызывает ExpandPathEnvironmentValues
function  ExpandFileNameEx(const aCurrentFolder, aFileName: String): String;

// создает папку, если она не существует (также создает все родительские папки, если это необходимо)
procedure CreateFolderEx(const aPath: String);

function ShortFileNameToLongFileName(aFileName: String): String;

function ExecuteAndWait(const aFileName: String; aWaitTime: DWORD): Boolean;

type
	TStringBuilder = object
	private
		FData: String;
		FLength: Integer;
		procedure CorrectPosAndCount(var aPos, aCount: Integer);
	public
		procedure Init;
		procedure Insert(aPos: Integer; const anStr: String);
		procedure Add(const s: String);
		procedure GetString(var aString: String);
		procedure GetCopy(aPos, aCount: Integer; var aResult: String);
		function Left(aCount: Integer): String;
		function Right(aCount: Integer): String;
		procedure Delete(aPos, aCount: Integer);
		function Value: String;
		function IsEmpty: Boolean;

		property Length: Integer read FLength;
	end;

implementation

{$WARN SYMBOL_PLATFORM OFF}

function StringToFloat(s: string): Extended;
var
	aPos: Integer;
begin
	if '.' = DecimalSeparator then
		aPos := Pos(',', s)
	else if ',' = DecimalSeparator then
		aPos := Pos('.', s)
	else begin
		aPos := Pos(',', s);
		if aPos = 0 then
			aPos := Pos('.', s);
	end;

	if aPos <> 0 then
		s[aPos] := DecimalSeparator;
	Result := StrToFloat(s);
end;

function FloatToString(v: Extended): String;
var
	aPos: Integer;
begin
	Result := FloatToStr(v);
	aPos := Pos(DecimalSeparator, Result);
	if aPos <> 0 then
		Result[aPos] := '.';
end;

function StrToColor(const s: String): TColor;

	function HexCharToByte(c: Char): Byte;
	begin
		if c in ['0'..'9'] then
			Result := Ord(c) - Ord('0')
		else if c in ['A'..'F'] then
			Result := Ord(c) - Ord('A') + 10
		else if c in ['a'..'f'] then
			Result := Ord(c) - Ord('a') + 10
		else
			raise Exception.Create('Некорректный формат цвета');
	end;

	function GetColorPart(const s: String; i: Integer): Byte;
	begin
		Result := (HexCharToByte(s[i]) shl 4) or HexCharToByte(s[i + 1]);
	end;

begin
	if (Length(s) <> 7) or (s[1] <> '#') then
		raise Exception.Create('Некорректный формат цвета');
	Result := RGB(GetColorPart(s, 2), GetColorPart(s, 4), GetColorPart(s, 6));
end;


function IsNumeric(const v: string): Boolean;
begin
	try
		StringToFloat(v);
		Result := true;
	except
		on EConvertError do
			Result := false;
	end;
end;

var
	iTemp: Integer; // Чтобы не было Hint'ов
	dTemp: Extended; // Чтобы не было Hint'ов

function StrIsInteger(const s: string): Boolean;
var
	code: Integer;
begin
	Val(s,iTemp,code);
	Result := code = 0;
end;

function StrIsFloat(const s: string): Boolean;
var
	aPos: Integer;
	s1: String;
begin
	if DecimalSeparator <> '.' then begin
		aPos := Pos(DecimalSeparator, s);
		if aPos <> 0 then begin
			s1 := s;
			s1[aPos] := '.';
			Val(s1, dTemp, aPos);
			Result := aPos = 0;
			Exit;
		end;
	end;
	Val(s, dTemp, aPos);
	Result := aPos = 0;
end;

function StrIsDate(const s: string): Boolean;
var
	dateOut: TOleDate;
	bstr: TBStr;
begin
	bstr := StringToOleStr(s); try
		Result := VarDateFromStr(bstr,0,VAR_DATEVALUEONLY,dateOut) = 0;
	finally SysFreeString(bstr) end;
end;

function StrIsTime(const s: string): Boolean;
var
	dateOut: TOleDate;
	bstr: TBStr;
begin
	bstr := StringToOleStr(s);
	try
		Result := VarDateFromStr(bstr,0,VAR_TIMEVALUEONLY,dateOut) = 0;
	finally
		SysFreeString(bstr)
	end;
end;

function StrIsDateTime(const s: string): Boolean;
var
	dateOut: TOleDate;
	bstr: TBStr;
begin
	bstr := StringToOleStr(s); try
		Result := VarDateFromStr(bstr,0,0,dateOut) = 0;
	finally SysFreeString(bstr) end;
end;

function StrToDate(const s: string): TDateTime;
var
	dateOut: TOleDate;
	bstr: TBStr;
begin
	Result := 0;

	bstr := StringToOleStr(s);
	try
		if VarDateFromStr(bstr, 0, VAR_DATEVALUEONLY, dateOut) <> 0 then
			raise EConvertError.Create('Can''t convert string to date');

		Result := dateOut;
	finally
		SysFreeString(bstr)
	end;
end;

function StrToTime(const s: string): TDateTime;
var
	dateOut: TOleDate;
	bstr: TBStr;
begin
	Result := 0;

	bstr := StringToOleStr(s);
	try
		if VarDateFromStr(bstr, 0, VAR_TIMEVALUEONLY, dateOut) <> 0 then
			raise EConvertError.Create('Can''t convert string to time');

		Result := dateOut;
	finally
		SysFreeString(bstr)
	end;
end;

function StrToDateTime(const s: string): TDateTime;
var
	dateOut: TOleDate;
	bstr: TBStr;
begin
	Result := 0;

	bstr := StringToOleStr(s);
	try
		if VarDateFromStr(bstr, 0, 0, dateOut) <> 0 then
			raise EConvertError.Create('Can''t convert string to datetime');

		Result := dateOut;
	finally
		SysFreeString(bstr)
	end;
end;


{ Работа с внутренними ошибками [Власов] }

{ EInternal }

constructor EInternal.Create(const aProcName, aText: String);
begin
	inherited Create('Внутренняя ошибка: ' + aText + ' (' + aProcName + ')');
end;

procedure InternalError(const aProcName, aText: String);
begin
	raise EInternal.Create(aProcName, aText);
end;

procedure InternalCheck(aCond: Boolean; const aProcName, aText: String);
begin
	if not aCond then
		raise EInternal.Create(aProcName, aText);
end;

procedure InternalError(const aProcName, aFmt: String; const anArgs: array of const);
begin
	raise EInternal.Create(aProcName, Format(aFmt, anArgs));
end;

procedure InternalCheck(aCond: Boolean; const aProcName, aFmt: String;
	const anArgs: array of const);
begin
	if not aCond then
		raise EInternal.Create(aProcName, Format(aFmt, anArgs));
end;

function FindWord(const aWord, aWhere: String): Boolean;
var
	i1, i2, i, aPos: Integer;
begin
	i1 := 1;
	i2 := Length(aWhere);
	while i1 <= i2 do begin
		aPos := Pos(aWord, Copy(aWhere, i1, i2 - i1 + 1));
		if aPos = 0 then
			break;
		i := i1 + aPos - 1;
		if i = 0 then
			break
		else if (i = 1) or (not IsCharAlphaNumeric(aWhere[i - 1])) then begin
			Result := True;
			Exit
		end;
		i1 := i + 1;
	end;
	Result := False;
end;

function CmpBytes(P1, P2: Pointer; Count: Integer): Integer;
begin
	while Count > 0 do
		if PByte(P1)^ = PByte(P2)^ then begin
			Inc(PByte(P1));
			Inc(PByte(P2));
			Dec(Count);
		end
		else begin
			if PByte(P1)^ < PByte(P2)^ then
				Result := -1
			else
				Result := 1;
			Exit;
		end;
	Result := 0;
end;

procedure SwapBytes(V1, V2: Pointer; Size: Integer); assembler;
asm
	cld
	mov    ESI, V1
	mov    EDI, V2
	mov    ECX, Size
@1:
	mov    AL, [EDI]
	xchg   AL, [ESI]
	stosb
	inc    ESI
	loop   @1
end;

{	функции короткого if. [Власов] }
function IIF(aCondition: Boolean; aTrueValue, aFalseValue: Integer): Integer;
begin
	if aCondition then
		Result := aTrueValue
	else
		Result := aFalseValue
end;

function FIF(aCondition: Boolean; aTrueValue, aFalseValue: Extended): Extended;
begin
	if aCondition then
		Result := aTrueValue
	else
		Result := aFalseValue
end;

function SIF(aCondition: Boolean; const aTrueValue, aFalseValue: String): String;
begin
	if aCondition then
		Result := aTrueValue
	else
		Result := aFalseValue
end;

function PIF(aCondition: Boolean; aTrueValue, aFalseValue: Pointer): Pointer;
begin
	if aCondition then
		Result := aTrueValue
	else
		Result := aFalseValue
end;

{Очищает TList вместе с уничтожением объектов(TObject).[brd]}
procedure ClearObjectList(aList: TList);
var
	anObject: TObject;
	i: Integer;
begin
	if Assigned(aList) then begin
		i := aList.Count - 1;
		while i >= 0 do begin
			anObject := aList[i];
			aList.Delete(i);
			anObject.Free;
			i := aList.Count - 1;
		end;
	end;
end;

{Освобождает TList вместе с уничтожением объектов(TObject).[brd]}
procedure FreeObjectList(aList: TList);
begin
	ClearObjectList(aList);
	aList.Free;
end;

{Очищает Strings вместе с удалением объектов(TObject).[brd]}
procedure ClearStringsWithObjects(aList: TStrings);
var
	anObject: TObject;
	i: Integer;
begin
	if Assigned(aList) then begin
		i := aList.Count - 1;
		while i >= 0 do begin
			anObject := aList.Objects[i];
			aList.Delete(i);
			anObject.Free;
			i := aList.Count - 1;
		end;
	end;
end;

{Освобождает Strings вместе с удалением объектов(TObject).[brd]}
procedure FreeStringsWithObjects(aList: TStrings);
begin
	ClearStringsWithObjects(aList);
	aList.Free;
end;

{	Следующие функции копируют значение и возвращают True, елси значение было изменено [Власов]}

function SetChar(var aRef: Char; aValue: Char): Boolean;
begin
	Result := aRef <> aValue;
	aRef := aValue;
end;

function SetByte(var aRef: Byte; aValue: Byte): Boolean;
begin
	Result := aRef <> aValue;
	aRef := aValue;
end;

function SetSmallInt(var aRef: SmallInt; aValue: SmallInt): Boolean;
begin
	Result := aRef <> aValue;
	aRef := aValue;
end;

function SetWord(var aRef: Word; aValue: Word): Boolean;
begin
	Result := aRef <> aValue;
	aRef := aValue;
end;

function SetInt(var aRef: Integer; aValue: Integer): Boolean;
begin
	Result := aRef <> aValue;
	aRef := aValue;
end;

function SetLongint(var aRef: Longint; aValue: Longint): Boolean;
begin
	Result := aRef <> aValue;
	aRef := aValue;
end;

function SetShortString(var aRef; aSize: Integer; const aValue: string): Boolean;
var
	aStr: string[255] absolute aRef;
begin
	Result := aStr <> aValue;
	aStr := Copy(aValue, 1, aSize - 1)
end;

function SetString(var aRef: string; const aValue: string): Boolean;
begin
	Result := aRef <> aValue;
	aRef := aValue;
end;

function SetDouble(var aRef: Double; aValue: Double): Boolean;
begin
	Result := aRef <> aValue;
	aRef := aValue;
end;

function SetBoolean(var aRef: Boolean; aValue: Boolean): Boolean;
begin
	Result := aRef <> aValue;
	aRef := aValue;
end;

function SetColor(var aRef: TColor; aValue: TColor): Boolean;
begin
	Result := aRef <> aValue;
	aRef := aValue;
end;

function SetBrushStyle(var aRef: TBrushStyle; aValue: TBrushStyle): Boolean;
begin
	Result := aRef <> aValue;
	aRef := aValue;
end;

function SetPenStyle(var aRef: TPenStyle; aValue: TPenStyle): Boolean;
begin
	Result := aRef <> aValue;
	aRef := aValue;
end;

function SetFontPitch(var aRef: TFontPitch; aValue: TFontPitch): Boolean;
begin
	Result := aRef <> aValue;
	aRef := aValue;
end;

function SetFontStyle(var aRef: TFontStyles; aValue: TFontStyles): Boolean;
begin
	Result := aRef <> aValue;
	aRef := aValue;
end;

function SetBuf(var aRef; const aValue; aSize: Integer): Boolean;
begin
	Result := CmpBytes(@aRef, @aValue, aSize) <> 0;
	if Result then
		Move(aValue, aRef, aSize);
end;

function SetChar(anOldValue, aNewValue: Char; var aHasChanges: Boolean): Char;
begin
	Result := aNewValue;
	if aNewValue <> anOldValue then
		aHasChanges := True;
end;

function SetByte(anOldValue, aNewValue: Byte; var aHasChanges: Boolean): Byte;
begin
	Result := aNewValue;
	if aNewValue <> anOldValue then
		aHasChanges := True;
end;

function SetSmallInt(anOldValue, aNewValue: SmallInt; var aHasChanges: Boolean): SmallInt;
begin
	Result := aNewValue;
	if aNewValue <> anOldValue then
		aHasChanges := True;
end;

function SetWord(anOldValue, aNewValue: Word; var aHasChanges: Boolean): Word;
begin
	Result := aNewValue;
	if aNewValue <> anOldValue then
		aHasChanges := True;
end;

function SetInt(anOldValue, aNewValue: Integer; var aHasChanges: Boolean): Integer;
begin
	Result := aNewValue;
	if aNewValue <> anOldValue then
		aHasChanges := True;
end;

function SetLongint(anOldValue, aNewValue: Longint; var aHasChanges: Boolean): Longint;
begin
	Result := aNewValue;
	if aNewValue <> anOldValue then
		aHasChanges := True;
end;

function SetString(const anOldValue, aNewValue: string; var aHasChanges: Boolean): String;
begin
	Result := aNewValue;
	if aNewValue <> anOldValue then
		aHasChanges := True;
end;

function SetDouble(anOldValue, aNewValue: Double; var aHasChanges: Boolean): Double;
begin
	Result := aNewValue;
	if aNewValue <> anOldValue then
		aHasChanges := True;
end;

function SetBoolean(anOldValue, aNewValue: Boolean; var aHasChanges: Boolean): Boolean;
begin
	Result := aNewValue;
	if aNewValue <> anOldValue then
		aHasChanges := True;
end;

function SetColor(anOldValue, aNewValue: TColor; var aHasChanges: Boolean): TColor;
begin
	Result := aNewValue;
	if aNewValue <> anOldValue then
		aHasChanges := True;
end;

function SetBrushStyle(anOldValue, aNewValue: TBrushStyle; var aHasChanges: Boolean): TBrushStyle;
begin
	Result := aNewValue;
	if aNewValue <> anOldValue then
		aHasChanges := True;
end;

function SetPenStyle(anOldValue, aNewValue: TPenStyle; var aHasChanges: Boolean): TPenStyle;
begin
	Result := aNewValue;
	if aNewValue <> anOldValue then
		aHasChanges := True;
end;

function SetFontPitch(anOldValue, aNewValue: TFontPitch; var aHasChanges: Boolean): TFontPitch;
begin
	Result := aNewValue;
	if aNewValue <> anOldValue then
		aHasChanges := True;
end;

function SetFontStyle(anOldValue, aNewValue: TFontStyles; var aHasChanges: Boolean): TFontStyles;
begin
	Result := aNewValue;
	if aNewValue <> anOldValue then
		aHasChanges := True;
end;

function SetPoint(const anOldValue, aNewValue: TPoint; var aHasChanges: Boolean): TPoint;
begin
	Result := aNewValue;
	if (aNewValue.X <> anOldValue.X) or (aNewValue.Y <> anOldValue.Y) then
		aHasChanges := True;
end;

{	Возвращает True, если хотя бы один aChanges[i] = True [Власов]}
function HasChanges(const aChanges: array of Boolean): Boolean;
var
	i: Integer;
begin
	Result := False;
	for i := Low(aChanges) to High(aChanges) do
		if aChanges[i] then begin
			Result := True;
			break;
		end;
end;

function ReadByte(aStm: TStream): Byte;
begin
	aStm.ReadBuffer(Result, sizeof(Result));
end;

procedure WriteByte(aStm: TStream; v: Byte);
begin
	aStm.WriteBuffer(v, sizeof(v));
end;

function ReadSmallInt(aStm: TStream): SmallInt;
begin
	aStm.ReadBuffer(Result, sizeof(Result));
end;

procedure WriteSmallInt(aStm: TStream; v: SmallInt);
begin
	aStm.WriteBuffer(v, sizeof(v));
end;

function ReadLongint(aStm: TStream): Longint;
begin
	aStm.ReadBuffer(Result, sizeof(Result));
end;

procedure WriteLongint(aStm: TStream; v: Longint);
begin
	aStm.WriteBuffer(v, sizeof(v));
end;

function ReadSingle(aStm: TStream): Single;
begin
	aStm.ReadBuffer(Result, sizeof(Result));
end;

procedure WriteSingle(aStm: TStream; v: Single);
begin
	aStm.WriteBuffer(v, sizeof(v));
end;

function ReadDouble(aStm: TStream): Double;
begin
	aStm.ReadBuffer(Result, sizeof(Result));
end;

procedure WriteDouble(aStm: TStream; v: Double);
begin
	aStm.WriteBuffer(v, sizeof(v));
end;

function ReadCurrency(aStm: TStream): Currency;
begin
	aStm.ReadBuffer(Result, sizeof(Result));
end;

procedure WriteCurrency(aStm: TStream; v: Currency);
begin
	aStm.WriteBuffer(v, sizeof(v));
end;

function ReadString(aStm: TStream): string;
var
	aLength: Longint;
begin
	aLength := ReadByte(aStm);
	if aLength = 254 then
		aLength := ReadLongint(aStm);
	SetLength(Result, aLength);
	if aLength > 0 then
		aStm.ReadBuffer(Result[1], aLength);
end;

procedure WriteString(aStm: TStream; const v: string);
var
	aLength: Longint;
begin
	aLength := Length(v);
	if aLength > 253 then begin
		WriteByte(aStm, 254);
		WriteLongint(aStm, aLength);
	end else
		WriteByte(aStm, aLength);
	if aLength > 0 then
		aStm.WriteBuffer(v[1], aLength);
end;

function ReadBoolean(aStm: TStream): Boolean;
begin
	Result := Boolean(ReadByte(aStm));
end;

procedure WriteBoolean(aStm: TStream; v: Boolean);
begin
	WriteByte(aStm,Byte(v));
end;

const
	varArrayEx = 99;

function ReadVariantOfType(aStm: TStream; vt: Integer): Variant;
var
	elType: Byte;
	i, j, dims, dim1, dim2, dim3, dim4: Integer;
begin
	case vt of
	varEmpty:
		Result := Unassigned;
	varNull:
		Result := Null;
	varByte:
		Result := ReadByte(aStm);
	varSmallint:
		Result := ReadSmallInt(aStm);
	varInteger:
		Result := ReadLongint(aStm);
	varSingle:
		Result := ReadSingle(aStm);
	varDouble:
		Result := ReadDouble(aStm);
	varCurrency:
		Result := ReadCurrency(aStm);
	varDate:
		Result := ReadDouble(aStm);
	varBoolean:
		Result := ReadBoolean(aStm);
	varOleStr:
		Result := ReadString(aStm);
	varVariant:
		Result := ReadVariant(aStm);
	varArrayEx: begin
		elType := ReadByte(aStm);
		dims := ReadByte(aStm);
		case dims of
		1: begin
			dim1 := ReadLongint(aStm);
			dim2 := ReadLongint(aStm);
			Result := VarArrayCreate([dim1,dim2],elType);
			for i:=dim1 to dim2 do
				Result[i] := ReadVariantOfType(aStm,elType);
		end;
		2: begin
			dim1 := ReadLongint(aStm);
			dim2 := ReadLongint(aStm);
			dim3 := ReadLongint(aStm);
			dim4 := ReadLongint(aStm);
			Result := VarArrayCreate([dim1,dim2,dim3,dim4],elType);
			for i:=dim1 to dim2 do
				for j:=dim3 to dim4 do
					Result[i,j] := ReadVariantOfType(aStm,elType);
		end;
		else
			raise Exception.Create('Invalid Dim count');
		end;
	end;
	else
		raise Exception.Create('Invalid variant type');
	end;
end;

function ReadVariant(aStm: TStream): Variant;
begin
	Result := ReadVariantOfType(aStm, ReadByte(aStm));
end;

procedure WriteVariantOfType(aStm: TStream; const v: Variant; vt: Integer);
begin
	case vt of
	varEmpty:
		;
	varNull:
		;
	varByte:
		WriteByte(aStm,v);
	varSmallint:
		WriteSmallInt(aStm,v);
	varInteger:
		WriteLongint(aStm,v);
	varSingle:
		WriteSingle(aStm,v);
	varDouble:
		WriteDouble(aStm,v);
	varCurrency:
		WriteCurrency(aStm,v);
	varDate:
		WriteDouble(aStm,v);
	varBoolean:
		WriteBoolean(aStm,v);
	varOleStr, varString:
		WriteString(aStm,v);
	varVariant:
		WriteVariant(aStm,v);
	else
		raise Exception.Create('This variant type is not supported');
	end;
end;

procedure WriteVariant(aStm: TStream; const v: Variant);
var
	elType: Variant;
	i, j, dim1, dim2, dim3, dim4, dims: Integer;
	vt: Variant;
begin
	vt := VarType(v);
	case vt of
	varEmpty:
		WriteByte(aStm,varEmpty);
	varNull:
		WriteByte(aStm,varNull);
	varByte: begin
		WriteByte(aStm, varByte);
		WriteVariantOfType(aStm, v, vt);
	end;
	varSmallint: begin
		WriteByte(aStm,varSmallint);
		WriteVariantOfType(aStm,v,vt);
	end;
	varInteger: begin
		WriteByte(aStm,varInteger);
		WriteVariantOfType(aStm,v,vt);
	end;
	varSingle: begin
		WriteByte(aStm,varSingle);
		WriteVariantOfType(aStm,v,vt);
	end;
	varDouble: begin
		WriteByte(aStm,varDouble);
		WriteVariantOfType(aStm,v,vt);
	end;
	varCurrency: begin
		WriteByte(aStm, varCurrency);
		WriteVariantOfType(aStm, v, vt);
	end;
	varDate: begin
		WriteByte(aStm, varDate);
		WriteVariantOfType(aStm, v, vt);
	end;
	varBoolean: begin
		WriteByte(aStm,varBoolean);
		WriteVariantOfType(aStm,v,vt);
	end;
	varOleStr, varString: begin
		WriteByte(aStm,varOleStr);
		WriteVariantOfType(aStm,v,vt);
	end;
	else begin
		if VarIsArray(v, true) then begin
			WriteByte(aStm,varArrayEx);
			elType := Byte(VarType(v));
			WriteByte(aStm,elType);
			dims := VarArrayDimCount(v);
			WriteByte(aStm,dims);
			case dims of
			1: begin
				dim1 := VarArrayLowBound(v,1);
				dim2 := VarArrayHighBound(v,1);
				WriteLongint(aStm,dim1);
				WriteLongint(aStm,dim2);
				for i:=dim1 to dim2 do
					WriteVariantOfType(aStm,v[i],elType);
			end;
			2: begin
				dim1 := VarArrayLowBound(v,1);
				dim2 := VarArrayHighBound(v,1);
				dim3 := VarArrayLowBound(v,2);
				dim4 := VarArrayHighBound(v,2);
				WriteLongint(aStm,dim1);
				WriteLongint(aStm,dim2);
				WriteLongint(aStm,dim3);
				WriteLongint(aStm,dim4);
				for i:=dim1 to dim2 do
					for j:=dim3 to dim4 do
						WriteVariantOfType(aStm,v[i,j],elType);
			end;
			else
				raise Exception.Create('Invalid Dim count');
			end;
		end else
			raise Exception.Create('This variant type is not supported');
	end;
	end;
end;

procedure LoadStringsFromStream(aStm: TStream; aStrings: TStrings);
var
	i: Integer;
	aCount: SmallInt;
begin
	aStrings.BeginUpdate;
	try
		aStrings.Clear;
		aStm.Read(aCount, sizeof(aCount));
		for i := 0 to aCount - 1 do
			aStrings.Add(ReadString(aStm));
	finally
		aStrings.EndUpdate
	end;
end;

procedure SaveStringsToStream(aStm: TStream; aStrings: TStrings);
var
	i: Integer;
	aCount: SmallInt;
begin
	aCount := aStrings.Count;
	aStm.Write(aCount, sizeof(aCount));
	for i := 0 to aCount - 1 do
		WriteString(aStm, aStrings[i]);
end;

{ Вспомогательные функции для работы с TRect-ом [Власов]}

function RectIntersected(const aR1, aR2: TRect): Boolean;
begin
	Result := False;
	with aR1 do begin
		if Left > aR2.Right then Exit;
		if Top > aR2.Bottom then Exit;
		if Right < aR2.Left then Exit;
		if Bottom < aR2.Top then Exit;
	end;
	Result := True;
end;

function RectEqual(const r1, r2: TRect): Boolean;
begin
	Result :=
		(r1.Left = r2.Left) and
		(r1.Right = r2.Right) and
		(r1.Top = r2.Top) and
		(r1.Bottom = r2.Bottom);
end;

function RectWidth(const r: TRect): integer;
begin
	result := r.right - r.left;
end;

function RectHeight(const r: TRect): integer;
begin
	result := r.bottom - r.top;
end;

function RectInflatedBy(const r: TRect; dx, dy: integer): TRect;
begin
	result := r;
	InflateRect(result, dx, dy);
end;

function RectOffsetBy(const r: TRect; dx, dy: integer): TRect;
begin
	result := r;
	OffsetRect(result, dx, dy);
end;

function RectNormalized(const r: TRect): TRect;
begin
	result.left := Min(r.left, r.right);
	result.right := Max(r.left, r.right);
	result.top := Min(r.top, r.bottom);
	result.bottom := Max(r.top, r.bottom);
end;

procedure ExpandRect(var aRect: TRect; const aPoint: TPoint);
begin
	if aRect.Left > aPoint.x then
		aRect.Left := aPoint.x;
	if aRect.Top > aPoint.y then
		aRect.Top := aPoint.y;
	if aRect.Right < aPoint.x then
		aRect.Right := aPoint.x;
	if aRect.Bottom < aPoint.y then
		aRect.Bottom := aPoint.y;
end;

{Ищет ключ в командной строке. Символы "/" и "-" не надо передавать.[brd]}
function FindCmdLineKey(const aSwitch: string): Boolean;
var
	i: Integer;
	s: string;
begin
	Result := False;
	for i := 1 to ParamCount do begin
		s := ParamStr(i);
		if (s[1] in ['-', '/']) and (AnsiCompareText(Copy(s, 2, Maxint), aSwitch) = 0) then begin
			Result := True;
			exit;
		end;
	end;
end;

function FindCmdLineParam(const aSwitch: string; var aValue: string): Boolean;
var
	i, aLen: Integer;
	s: string;
begin
	aValue := '';
	Result := False;
	aLen := Length(aSwitch);
	for i := 1 to ParamCount do begin
		s := ParamStr(i);
		if (s[1] in ['-', '/']) and (Copy(s, aLen+2, 1) = ':') and
				(AnsiCompareText(Copy(s, 2, aLen), aSwitch) = 0) then begin
			aValue := Copy(s, aLen+3, Maxint);
			Result := True;
			exit;
		end;
	end;
end;

function GetCmdLineParam(const aSwitch, aDefValue: string): string;
begin
	if not FindCmdLineParam(aSwitch, Result) then
		Result := aDefValue;
end;

{	Копирование объекта через поток [Власов]}
procedure CopyByStream(aSave, aLoad: TLoadSaveProc);
var
	aMemStm: TMemoryStream;
begin
	aMemStm := TMemoryStream.Create;
	try
		aSave(aMemStm);
		aMemStm.Position := 0;
		aLoad(aMemStm);
	finally
		aMemStm.Free
	end;
end;

{	Копирование объекта через XML [Власов]}
procedure CopyByXML(aSave, aLoad: TLoadSaveXmlProc);
var
	aDoc: IXmlDocument;
begin
	aDoc := CreateXmlDocument('Copy');
	aSave(aDoc.DocumentElement);
	aLoad(aDoc.DocumentElement);
end;

{	Следующие функции позволяют работать с TList-ом как с сортированным списком [Власов]}
function SortedList_Find(aList: TList; aGetItemKey: TGetItemKey; aCompareKeys: TCompareKeys;
	aKey: Pointer; var anIndex: Integer): Boolean;
var
	L, H, I, C: Integer;
begin
	Result := False;
	L := 0;
	H := aList.Count - 1;
	while L <= H do begin
		I := (L + H) shr 1;
		if Assigned(aGetItemKey) then
			C := aCompareKeys(aGetItemKey(aList[I]), aKey)
		else
			C := aCompareKeys(aList[I], aKey);

		if C < 0 then L := I + 1 else begin
      H := I - 1;
			if C = 0 then begin
        Result := True;
      end;
    end;
  end;
  anIndex := L;
end;

procedure SortedList_Insert(aList: TList; aGetItemKey: TGetItemKey;
	aCompareKeys: TCompareKeys; anItem: Pointer);
var
	anIndex: Integer;
	aKey: Pointer;
begin
	if Assigned(aGetItemKey) then
		aKey := aGetItemKey(anItem)
	else
		aKey := anItem;

	SortedList_Find(aList, aGetItemKey, aCompareKeys, aKey, anIndex);
	aList.Insert(anIndex, anItem);
end;

procedure List_Sort(aList: TList; aCompare: TListSortCompareFunction; aData: Pointer);

	procedure QuickSort(L, R: Integer);
	var
		i, j: Integer;
		P: Pointer;
	begin
		repeat
			i := L;
			j := R;
			P := aList[(L + R) shr 1];
			repeat
				while aCompare(aList[i], P, aData) < 0 do
					Inc(i);
				while aCompare(aList[j], P, aData) > 0 do
					Dec(j);
				if i <= j then
				begin
					aList.Exchange(i, j);
					Inc(i);
					Dec(j);
				end;
			until i > j;
			if L < j then
				QuickSort(L, j);
			L := i;
		until i >= R;
	end;

begin
	Assert(Assigned(aList));
	if aList.Count > 0 then
		QuickSort(0, aList.Count - 1);
end;

function GetCompName: string;
var
	aComputerName: array [0..MAX_COMPUTERNAME_LENGTH+2] of char;
	aSize: DWORD;
begin
	aSize := MAX_COMPUTERNAME_LENGTH+2;
	if not GetComputerName(aComputerName, aSize) then
		raise Exception.Create('Ошибка при получении имени компьютера');
	Result := aComputerName;
end;

function GetTempFolder: string;
var
	aPath: array [0..MAX_PATH] of char;
begin
	Win32Check(GetTempPath(MAX_PATH, aPath) <> 0);
	Result := aPath;
end;

function GetTmpFileName(const aThreeLetters: String): String;
var
	aPath: String;
	aFileName: array[0..MAX_PATH] of Char;
begin
	aPath := GetTempFolder;
	Win32Check(GetTempFileName(PChar(aPath), PChar(aThreeLetters), 0, aFileName) <> 0);
	Result := aFileName;
//	DeleteFile(Result);
end;

function GetCurrentModuleFileName: String;
var
	aBuf: array [0..MAX_PATH] of Char;
begin
	Win32Check(GetModuleFileName(HInstance, aBuf, MAX_PATH) <> 0);
	Result := aBuf;
end;

function MakePath(const aParts: array of String): String;
var
	i, len: Integer;
begin
	Result := '';
	for i := Low(aParts) to High(aParts) do begin
		if Length(aParts[i]) = 0 then
			continue;
		len := Length(Result);
		if len = 0 then begin
			Result := aParts[i];
			continue;
		end;
		if Result[len] = '\' then begin
			if aParts[i][1] = '\' then
				SetLength(Result, len - 1);
			Result := Result + aParts[i];
		end
		else begin
			if aParts[i][1] <> '\' then
				Result := Result + '\';
			Result := Result + aParts[i];
		end;
	end;
end;


{Очищает слова от лишних пробелов. Если FirstUpper = True, то первая буква
 первого слова переводится в верхний регистер, если OtherUpper = True, то
 все первые буквы кроме первого слова переводятся в верхний регистер.[brd]}
function CleanWords(const s: string; FirstUpper, OtherUpper: Boolean): string;
var
	i, j, len, tmpLen: Integer;
	c: char;
	fSp: Boolean;
begin
	len:= Length(s);
	while (len > 0) and (s[len] = ' ') do
		dec(len);
	i:= 1;
	while (i <= len) and (s[i] = ' ') do
		inc(i);
	tmpLen:= len-i+1;
	SetLength(Result, tmpLen);
	j:= 0;
	fSp:= false;
	while i <= len do begin
		c:= s[i];
		if c = ' ' then
			fSp:= true
		else begin
			if fSp then begin
				inc(j);
				Result[j]:= ' ';
				if OtherUpper then
					c:= AnsiUpperCase(c)[1];
				fSp:= false;
			end;
			inc(j);
			Result[j]:= c;
		end;
		inc(i);
	end;
	if j <> tmpLen then
		SetLength(Result, j);
	if (j > 0) and FirstUpper then
		Result[1]:= AnsiUpperCase(Result[1])[1];
end;


function DeleteChar(const s: string; c: char): string;
var
	i, aLen: Integer;
begin
	Result := s;
	aLen := Length(Result);
	i := 1;
	while i <= aLen do begin
		if Result[i] = c then begin
			Delete(Result, i, 1);
			Dec(aLen);
		end
		else
			Inc(i);
	end;
end;

function ReplaceChar(const s: string; aSrcC, aDstC: char): string;
var
	i: Integer;
begin
	Result := s;
	for i := 1 to Length(Result) do
		if Result[i] = aSrcC then
			Result[i] := aDstC;
end;

function ExpandChar(const s: string; c: char): string;
var
	i: Integer;
begin
	Result := '';
	for i := 1 to Length(s) do begin
		if s[i] = c then
			Result := Result + c;
		Result := Result + s[i];
	end;
end;

function CompressChar(const s: string; c: char): string;
var
	aLen, i: Integer;
begin
	Result := s;
	aLen := Length(Result);
	i := 1;
	while i < aLen do begin
		if (Result[i] = c) and (Result[i + 1] = c) then begin
			Delete(Result, i, 1);
			Dec(aLen);
		end;
		Inc(i);
	end;
end;

function ScanLong(const s: string; var aPos, aValue: Longint): Boolean;
var
	aLen, aLast: Longint;
begin
	Result := False;
	aLen := Length(s);
	while (aPos <= aLen) and (s[aPos] <= ' ') do
		Inc(aPos);
	aLast := aPos;
	if (aLast < aLen) and (s[aLast] = '-') and (s[aLast+1] in ['0'..'9']) then
		Inc(aLast);
	while (aLast <= aLen) and (s[aLast] > ' ') do begin
		if not (s[aLast] in ['0'..'9']) then
			exit;
		Inc(aLast);
	end;
	if aLast = aPos then
		exit;
	aValue := StrToInt(Copy(s, aPos, aLast-aPos));
	aPos := aLast;
	Result := True;
end;

function GetStrIndex(const aValue: String; const aValues: array of String): Integer;
begin
	for Result := Low(aValues) to High(aValues) do
		if AnsiCompareText(aValue, aValues[Result]) = 0 then
			Exit;
	raise
		Exception.CreateFmt('Некорректное значение атрибута: %s', [aValue]);
end;

function ExpandPathEnvironmentValues(const aPath: String): String;
var
	aBuffer: array[0..MAX_PATH] of char;
	aSize: DWORD;
begin
	aSize := ExpandEnvironmentStrings(PChar(aPath), aBuffer, MAX_PATH);
	if (aSize <> 0) or (aSize <= MAX_PATH) then
		Result := aBuffer
	else
		Result := aPath;
end;

function ExpandFileNameEx(const aCurrentFolder, aFileName: String): String;

	function ExpandFileName(const aCurrentFolder, aPath: String): String;

		function ExpandRelativeFileName(aCurrentFolder, aPath: String): String;
		var
			aFolders: TStrArray;
			aFolderName: String;
			i: Integer;
		begin
			Result := ExtractFileName(aPath);
			aFolders.Split(ExtractFileDir(aPath), PathDelim);
			for i := 0 to aFolders.Count - 1 do begin
				aFolderName := aFolders.Items(i);
				if (aFolderName = '') or (aFolderName = '.') then
					Continue
				else if aFolderName = '..' then
					aCurrentFolder := ExtractFileDir(aCurrentFolder)
				else begin
					if aCurrentFolder = '' then
						aCurrentFolder := aFolderName
					else
						aCurrentFolder := IncludeTrailingPathDelimiter(aCurrentFolder) + aFolderName
				end;
			end;
			if aCurrentFolder <> '' then
				Result := IncludeTrailingPathDelimiter(aCurrentFolder) + Result;
		end;

		function RemoveRelationFolders(const aFileName: String): String;
		var
			aDrive: String;
		begin
			aDrive := ExtractFileDrive(aFileName);
			Result := aDrive +
				ExpandRelativeFileName('', Copy(aFileName, Length(aDrive) + 1, Length(aFileName) - Length(aDrive)));
		end;

	begin
		if Length(aPath) > 0 then begin
			if IsPathDelimiter(aPath, 1) then
				Result := ExpandRelativeFileName('', ExtractFileDrive(aCurrentFolder) + aPath)
			else
				Result := ExpandRelativeFileName(aCurrentFolder, aPath)
		end;
	end;

begin
	Result := ExpandPathEnvironmentValues(aFileName);
	if ExtractFileDrive(Result) = '' then
		Result := ExpandFileName(aCurrentFolder, Result);
end;

procedure CreateFolderEx(const aPath: String);

	procedure CreateFolderIfNeed(const aPath: String);
	var
		aParentPath: String;
	begin
		if not DirectoryExists(aPath) then begin
			aParentPath := ExtractFileDir(aPath);
			Assert(Length(aParentPath) < Length(aPath), 'circular recursive call');

			CreateFolderIfNeed(aParentPath);
			CreateDir(aPath)
		end;
	end;

begin
	CreateFolderIfNeed(aPath);
end;

{ TStringBuilder }

procedure TStringBuilder.Init;
begin
	FData := '';
	FLength := 0;
end;

procedure TStringBuilder.Add(const s: String);
begin
  Insert(FLength + 1, s);
end;

procedure TStringBuilder.Insert(aPos: Integer; const anStr: String);
var
  anAddLength,
  aNewLength: Integer;
begin
  anAddLength := System.Length(anStr);
  if anAddLength = 0 then
    Exit;

  aNewLength := FLength + anAddLength;
  if aNewLength > System.Length(FData) then
    if aNewLength > 64 then
      SetLength(FData, aNewLength + aNewLength div 4)
    else if aNewLength > 8 then
      SetLength(FData, aNewLength + 16)
		else
			SetLength(FData, aNewLength + 4);

  if aPos < 1 then
    aPos := 1;
  if aPos > FLength + 1 then
    aPos := FLength + 1;

  if aPos <= FLength then
    Move(FData[aPos], FData[aPos + anAddLength], FLength - aPos + 1);
  Move(anStr[1], FData[aPos], anAddLength);
	FLength := aNewLength;
end;

procedure TStringBuilder.Delete(aPos, aCount: Integer);
begin
  CorrectPosAndCount(aPos, aCount);
  if aCount > 0 then begin
    if aPos + aCount <= FLength then
      Move(FData[aPos + aCount], FData[aPos], FLength - (aPos + aCount) + 1);
    Dec(FLength, aCount);
  end;
end;

procedure TStringBuilder.GetString(var aString: String);
begin
  SetLength(aString, FLength);
  if FLength > 0 then
    Move(FData[1], aString[1], FLength);
end;

function TStringBuilder.Value: String;
begin
	GetString(Result);
end;

procedure TStringBuilder.CorrectPosAndCount(var aPos, aCount: Integer);
begin
	if aPos < 1 then
		aPos := 0;
	if (aCount <= 0) or (aPos > FLength) then
		aCount := 0;
	if aPos + aCount > FLength then
		aCount := FLength - aPos + 1;
end;

procedure TStringBuilder.GetCopy(aPos, aCount: Integer; var aResult: String);
begin
	CorrectPosAndCount(aPos, aCount);
	SetLength(aResult, aCount);
	if aCount > 0 then
		Move(FData[aPos], aResult[1], aCount);
end;

function TStringBuilder.Left(aCount: Integer): String;
begin
	GetCopy(1, aCount, Result);
end;

function TStringBuilder.Right(aCount: Integer): String;
begin
	GetCopy(FLength - aCount + 1, aCount, Result);
end;

function TStringBuilder.IsEmpty: Boolean;
begin
	Result := FLength = 0
end;

function ShortFileNameToLongFileName(aFileName: String): String;
var
	FindData: TWin32FindData;
	Search,
	KernelHandle: THandle;
	GetLongPathName: function(lpszShortName: LPCTSTR; lpszLongName: LPTSTR;
		cchBuffer: DWORD): DWORD; stdcall;
begin
	Result := aFileName;
	KernelHandle := GetModuleHandle('KERNEL32');
	if KernelHandle = 0 then
		GetLongPathName := nil
	else
		@GetLongPathName := GetProcAddress(KernelHandle, 'GetLongPathNameA');
	if Assigned(GetLongPathName) then begin
		SetLength(Result, MAX_PATH + 1);
		SetLength(Result, GetLongPathName(PChar(aFileName), @Result[1], MAX_PATH));
	end
	else begin
		Result := '';
		while (True) do begin
			Search := Windows.FindFirstFile(PChar(aFileName), FindData);
			if Search = INVALID_HANDLE_VALUE then
				Break;
			Result := string('\') + FindData.cFileName + Result;
			aFileName := ExtractFileDir(aFileName);
			Windows.FindClose(Search);

			if Length(aFileName) <= 2 then
				Break;
		end;
		Result := ExtractFileDrive(aFileName) + Result;
	end;
end;

function ExecuteAndWait(const aFileName: String; aWaitTime: DWORD): Boolean;
var
	aStartupInfo: TStartupInfo;
  aProcessInfo: TPROCESSINFORMATION;
  aFullFileName: String;
begin
  FillChar(aStartupInfo, SizeOf(aStartupInfo), 0);
  aStartupInfo.cb := SizeOf(aStartupInfo);
  aStartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  aStartupInfo.wShowWindow := SW_SHOW;

  aFullFileName := ExpandPathEnvironmentValues(aFilename);

  Win32Check(CreateProcess(PChar(aFullFileName), nil, nil, nil, False, 0, nil, nil,
  	aStartupInfo, aProcessInfo));
  try
    Result := WaitForSingleObject(aProcessInfo.hProcess, aWaitTime) = WAIT_OBJECT_0;
  finally
	  CloseHandle(aProcessInfo.hThread);
		CloseHandle(aProcessInfo.hProcess);
  end;
end;








end.
