| 1 |
/////////////////////////////////////////////////////////// |
|---|
| 2 |
// ExtraFunctionsFcl // |
|---|
| 3 |
// Модуль с самопальными функциями и прочим общего // |
|---|
| 4 |
// назначения под LCL. // |
|---|
| 5 |
// Copyright (C) 2007 Sagrer // |
|---|
| 6 |
// Распространяется на условиях // |
|---|
| 7 |
// LGPL v2.1 // |
|---|
| 8 |
// // |
|---|
| 9 |
// версия модуля 0.0 // |
|---|
| 10 |
// // |
|---|
| 11 |
// sagrer@yandex.ru // |
|---|
| 12 |
/////////////////////////////////////////////////////////// |
|---|
| 13 |
|
|---|
| 14 |
//К работе над данным файлом приложили руки, ноги.... короче аффтары: |
|---|
| 15 |
// 1) Sagrer (sagrer@yandex.ru) |
|---|
| 16 |
|
|---|
| 17 |
//////////////////////////////////////////////////////////////////////// |
|---|
| 18 |
|
|---|
| 19 |
unit ExtraFunctionsLcl; |
|---|
| 20 |
|
|---|
| 21 |
{$mode objfpc}{$H+} |
|---|
| 22 |
|
|---|
| 23 |
interface |
|---|
| 24 |
|
|---|
| 25 |
uses |
|---|
| 26 |
Classes, SysUtils, Windows, Registry, crc; |
|---|
| 27 |
|
|---|
| 28 |
const |
|---|
| 29 |
DoDebugOutput = true; //Выводить ли дебажные мессаги. |
|---|
| 30 |
|
|---|
| 31 |
//Типо идентификаторы... |
|---|
| 32 |
|
|---|
| 33 |
//EnvPathAdd |
|---|
| 34 |
EnvPathAdd_User = 0; |
|---|
| 35 |
EnvPathAdd_Global = 1; |
|---|
| 36 |
|
|---|
| 37 |
Function StrRPos(str1,str2 : pchar) : pchar; //На основе функции из FPC. Ищет первое вхождение str2 в str1, но с конца строки. |
|---|
| 38 |
Function Parse( var S : AnsiString; const Separators : AnsiString ) : AnsiString; //Функция для парсинга строк, сделано на основе функции из KOL. |
|---|
| 39 |
Function ParseTail( var S : AnsiString; const Separators : AnsiString ) : AnsiString; //Анологично тому что выше, но работает с хвоста. |
|---|
| 40 |
Function ParseNumericHead(var S : AnsiString) : AnsiString; //Парсит считая за разделитель первый попавшийся символ не-цифру. |
|---|
| 41 |
Function IsNumericStr (Str : string) : boolean; //А эта функа должна определять, состоит ли строка только из цифр. |
|---|
| 42 |
Function IsVersionStr (Str : string) : boolean; //Является ли строка номером версии. |
|---|
| 43 |
Function IsNewVersion(OldVer, NewVer : string) : boolean; //Функа должна проверять, новее ли версия. |
|---|
| 44 |
Procedure ParsePathString(const PathString : string; var PathStringList : TStringList); //Парсит строку с путями и загоняет инфу в TStringList. |
|---|
| 45 |
Function CombinePathString(const PathStringList : TStringList) : string; //Генерит из TStringList строку типа Path. |
|---|
| 46 |
Function EnvPathExists(const PathStr : string; const CheckUser, CheckGlobal : boolean) : boolean; //Проверяет, существует ли такой path в указанных переменных. |
|---|
| 47 |
Function EnvPathRemove(const PathStr : string; const CheckUser, CheckGlobal : boolean) : boolean; //Удаляет строку пути из указанных PATH. Результат - true если чего-то было удалено. |
|---|
| 48 |
Function EnvPathAdd(const PathStr : string; const Target : integer; const ForceRemoveDoubles : boolean = true; const ForceCreateLocal : boolean = false) : boolean; //Добавляет путь в указанные PATH. |
|---|
| 49 |
Function TrimExLeft(const InputStr, TrimChars : string) : string; //Тримает символы слева. |
|---|
| 50 |
Function TrimExRight(const InputStr, TrimChars : string) : string; //Тримает символы справа. |
|---|
| 51 |
Function TrimEx(const InputStr, TrimChars : string) : string; //Тримает символы со всех сторон. |
|---|
| 52 |
Function FileToCRC32(const FileName : string; const ConsoleOutput : boolean = false) : cardinal; //Вычислить CRC32 для файла, если надо с индикацией процесса в консоль. |
|---|
| 53 |
Function CheckCharNum(const Ch : char) : boolean; //Проверить - является ли символ цифрой |
|---|
| 54 |
Function CheckStrInt(const St : string) : boolean; //Проверить - является ли строка представлением целочисленного значения |
|---|
| 55 |
Function CheckStrFloat(const St : string) : boolean; //Проверить - является ли строка представлением дробного значения |
|---|
| 56 |
Function IntToBool(const InputInt : Integer) : boolean; //Превратить Integer в Boolean |
|---|
| 57 |
Function StrToBool(const InputStr : AnsiString) : boolean; //Превратить String в Boolean |
|---|
| 58 |
Function BoolToInt(const InputBool : boolean) : Integer; //Превратить Boolean в Integer |
|---|
| 59 |
Function BoolToStr(const InputBool : boolean) : AnsiString; //Превратить Boolean в String |
|---|
| 60 |
Function ReadFirstLineFromStr(const InputStr : AnsiString) : AnsiString; //Элементарно скопировать строку от начала до байта #13 или #10 если #13 не обнаружится. |
|---|
| 61 |
|
|---|
| 62 |
implementation |
|---|
| 63 |
|
|---|
| 64 |
uses |
|---|
| 65 |
ExtraFileUtilsLCL; |
|---|
| 66 |
|
|---|
| 67 |
Function StrRPos(str1,str2 : pchar) : pchar; |
|---|
| 68 |
//На основе функции из FPC. |
|---|
| 69 |
//Ищет первое вхождение str2 в str1, но с конца строки. |
|---|
| 70 |
var |
|---|
| 71 |
p : pchar; |
|---|
| 72 |
lstr2 : SizeInt; |
|---|
| 73 |
begin |
|---|
| 74 |
StrRPos:=nil; |
|---|
| 75 |
if (str1 = nil) or (str2 = nil) then |
|---|
| 76 |
exit; |
|---|
| 77 |
p:=strrscan(str1,str2^); |
|---|
| 78 |
if p=nil then |
|---|
| 79 |
exit; |
|---|
| 80 |
lstr2:=strlen(str2); |
|---|
| 81 |
while p<>nil do |
|---|
| 82 |
begin |
|---|
| 83 |
if strlcomp(p,str2,lstr2)=0 then |
|---|
| 84 |
begin |
|---|
| 85 |
StrRPos:=p; |
|---|
| 86 |
exit; |
|---|
| 87 |
end; |
|---|
| 88 |
dec(p); |
|---|
| 89 |
p:=strrscan(p,str2^); |
|---|
| 90 |
end; |
|---|
| 91 |
end; |
|---|
| 92 |
|
|---|
| 93 |
Function Parse( var S : AnsiString; const Separators : AnsiString ) : AnsiString; |
|---|
| 94 |
//Функция для парсинга строк, сделано на основе функции из KOL. |
|---|
| 95 |
var Pos : Integer; |
|---|
| 96 |
|
|---|
| 97 |
begin |
|---|
| 98 |
Pos := Longint( StrPos( PChar(S), PChar(Separators) ) - LongInt(S) + 1 ) ; |
|---|
| 99 |
if Pos <= 0 then |
|---|
| 100 |
Pos := Length( S ) + Length(Separators); |
|---|
| 101 |
Result := S; |
|---|
| 102 |
S := Copy( Result, Pos + Length(Separators), MaxInt ); |
|---|
| 103 |
Result := Copy( Result, 1, Pos - 1 ); |
|---|
| 104 |
end; |
|---|
| 105 |
|
|---|
| 106 |
Function ParseTail( var S : AnsiString; const Separators : AnsiString ) : AnsiString; |
|---|
| 107 |
//Анологично тому что выше, но работает с хвоста. |
|---|
| 108 |
var Pos : Integer; |
|---|
| 109 |
|
|---|
| 110 |
begin |
|---|
| 111 |
Pos := Longint( StrRPos( PChar(S), PChar(Separators) ) - LongInt(S) + 1 ) ; |
|---|
| 112 |
Result := S; |
|---|
| 113 |
S := Copy(Result, 1, Pos-1); |
|---|
| 114 |
Result := Copy(Result, Pos+Length(Separators), Length(Result)-(Pos+Length(Separators))+1); |
|---|
| 115 |
end; |
|---|
| 116 |
|
|---|
| 117 |
Function ParseNumericHead(var S : AnsiString) : AnsiString; |
|---|
| 118 |
//Парсит считая за разделитель первый попавшийся символ не-цифру. |
|---|
| 119 |
var |
|---|
| 120 |
Pos : Integer; |
|---|
| 121 |
Finded : Boolean; |
|---|
| 122 |
|
|---|
| 123 |
begin |
|---|
| 124 |
//Инициализация. |
|---|
| 125 |
Pos := 0; |
|---|
| 126 |
Finded := false; |
|---|
| 127 |
|
|---|
| 128 |
//Ищем первую "не-цифру" |
|---|
| 129 |
repeat |
|---|
| 130 |
Pos := Pos+1; |
|---|
| 131 |
if Pos <= Length(S) then begin |
|---|
| 132 |
if IsNumericStr(S[Pos]) = false then begin |
|---|
| 133 |
//Нашли. |
|---|
| 134 |
Finded := true; |
|---|
| 135 |
Pos := Pos-1; |
|---|
| 136 |
end; |
|---|
| 137 |
end; |
|---|
| 138 |
until (Pos = Length(S)) or (Finded = true); |
|---|
| 139 |
|
|---|
| 140 |
//Ну и, собсно парсенг. |
|---|
| 141 |
Result := Copy(S,1,Pos); |
|---|
| 142 |
Delete(S,1,Pos); |
|---|
| 143 |
end; |
|---|
| 144 |
|
|---|
| 145 |
Function IsNumericStr (Str : string) : boolean; |
|---|
| 146 |
var |
|---|
| 147 |
I, StrLength : integer; |
|---|
| 148 |
FindedChar : boolean; |
|---|
| 149 |
begin |
|---|
| 150 |
//А эта функа должна определять, состоит ли строка только из цифр. |
|---|
| 151 |
|
|---|
| 152 |
Result := true; //Умолчальный результат. |
|---|
| 153 |
|
|---|
| 154 |
StrLength := Length(Str); |
|---|
| 155 |
If StrLength > 0 then begin |
|---|
| 156 |
//Если в строке чета есть то можно приступать. |
|---|
| 157 |
For I := 1 to StrLength do begin |
|---|
| 158 |
FindedChar := true; |
|---|
| 159 |
If Str[I] = '1' then FindedChar := false; //Достаточно выполнится 1 проверке - и чар будет не найден :) |
|---|
| 160 |
If Str[I] = '2' then FindedChar := false; |
|---|
| 161 |
If Str[I] = '3' then FindedChar := false; |
|---|
| 162 |
If Str[I] = '4' then FindedChar := false; |
|---|
| 163 |
If Str[I] = '5' then FindedChar := false; |
|---|
| 164 |
If Str[I] = '6' then FindedChar := false; |
|---|
| 165 |
If Str[I] = '7' then FindedChar := false; |
|---|
| 166 |
If Str[I] = '8' then FindedChar := false; |
|---|
| 167 |
If Str[I] = '9' then FindedChar := false; |
|---|
| 168 |
If Str[I] = '0' then FindedChar := false; |
|---|
| 169 |
|
|---|
| 170 |
//И если был обнаружен символ-не цифра - обломить все нафиг. |
|---|
| 171 |
If FindedChar = true then Result := false; |
|---|
| 172 |
end; |
|---|
| 173 |
end |
|---|
| 174 |
else begin |
|---|
| 175 |
Result := false; //Типа строка пустая. |
|---|
| 176 |
end; |
|---|
| 177 |
end; |
|---|
| 178 |
|
|---|
| 179 |
Function IsVersionStr (Str : string) : boolean; |
|---|
| 180 |
var |
|---|
| 181 |
I, StrLength : integer; |
|---|
| 182 |
FindedChar, WasPoint : boolean; |
|---|
| 183 |
begin |
|---|
| 184 |
//Является ли строка номером версии. |
|---|
| 185 |
|
|---|
| 186 |
Result := true; //Умолчальный результат. |
|---|
| 187 |
|
|---|
| 188 |
StrLength := Length(Str); |
|---|
| 189 |
If StrLength > 0 then begin |
|---|
| 190 |
//Если в строке чета есть то можно приступать. |
|---|
| 191 |
WasPoint := false; |
|---|
| 192 |
For I := 1 to StrLength do begin |
|---|
| 193 |
FindedChar := true; |
|---|
| 194 |
If Str[I] = '1' then begin |
|---|
| 195 |
FindedChar := false; |
|---|
| 196 |
WasPoint := false; |
|---|
| 197 |
end; |
|---|
| 198 |
If Str[I] = '2' then begin |
|---|
| 199 |
FindedChar := false; |
|---|
| 200 |
WasPoint := false; |
|---|
| 201 |
end; |
|---|
| 202 |
If Str[I] = '3' then begin |
|---|
| 203 |
FindedChar := false; |
|---|
| 204 |
WasPoint := false; |
|---|
| 205 |
end; |
|---|
| 206 |
If Str[I] = '4' then begin |
|---|
| 207 |
FindedChar := false; |
|---|
| 208 |
WasPoint := false; |
|---|
| 209 |
end; |
|---|
| 210 |
If Str[I] = '5' then begin |
|---|
| 211 |
FindedChar := false; |
|---|
| 212 |
WasPoint := false; |
|---|
| 213 |
end; |
|---|
| 214 |
If Str[I] = '6' then begin |
|---|
| 215 |
FindedChar := false; |
|---|
| 216 |
WasPoint := false; |
|---|
| 217 |
end; |
|---|
| 218 |
If Str[I] = '7' then begin |
|---|
| 219 |
FindedChar := false; |
|---|
| 220 |
WasPoint := false; |
|---|
| 221 |
end; |
|---|
| 222 |
If Str[I] = '8' then begin |
|---|
| 223 |
FindedChar := false; |
|---|
| 224 |
WasPoint := false; |
|---|
| 225 |
end; |
|---|
| 226 |
If Str[I] = '9' then begin |
|---|
| 227 |
FindedChar := false; |
|---|
| 228 |
WasPoint := false; |
|---|
| 229 |
end; |
|---|
| 230 |
If Str[I] = '0' then begin |
|---|
| 231 |
FindedChar := false; |
|---|
| 232 |
WasPoint := false; |
|---|
| 233 |
end; |
|---|
| 234 |
If Str[I] = '.' then begin |
|---|
| 235 |
FindedChar := false; |
|---|
| 236 |
If WasPoint = true then begin |
|---|
| 237 |
//Если до этого уже была точка - то аблооом. |
|---|
| 238 |
FindedChar := true; |
|---|
| 239 |
end; |
|---|
| 240 |
WasPoint := true; |
|---|
| 241 |
end; |
|---|
| 242 |
|
|---|
| 243 |
//И если был обнаружен символ-не цифра и не точка - обломить все нафиг. |
|---|
| 244 |
If FindedChar = true then Result := false; |
|---|
| 245 |
end; |
|---|
| 246 |
end |
|---|
| 247 |
else begin |
|---|
| 248 |
Result := false; //Типа строка пустая. |
|---|
| 249 |
end; |
|---|
| 250 |
end; |
|---|
| 251 |
|
|---|
| 252 |
Function IsNewVersion(OldVer, NewVer : string) : boolean; |
|---|
| 253 |
var |
|---|
| 254 |
CurrVerLevels, I, |
|---|
| 255 |
OldVerLevels, MaxLevel : integer; |
|---|
| 256 |
TempStr, TempStr2, |
|---|
| 257 |
OldVerTemp, NewVerTemp : string; |
|---|
| 258 |
begin |
|---|
| 259 |
//Функа должна проверять, новее ли версия. |
|---|
| 260 |
|
|---|
| 261 |
Result := false; //Типа умолчальное значение. |
|---|
| 262 |
OldVerTemp := OldVer; |
|---|
| 263 |
NewVerTemp := NewVer; |
|---|
| 264 |
|
|---|
| 265 |
|
|---|
| 266 |
If (IsVersionStr(OldVer) = true) and (IsVersionStr(NewVer) = true) then begin |
|---|
| 267 |
//Только если в обоих строках - версии. |
|---|
| 268 |
|
|---|
| 269 |
//Для начала - посмотреть сколько уровней версии в старой версии. |
|---|
| 270 |
TempStr := NewVerTemp; |
|---|
| 271 |
TempStr2 := ''; //Переменная инициализируется чисто чтоб не вылазил хинт при Parse от компилера. |
|---|
| 272 |
CurrVerLevels := 1; //Есть как минимум 1 уровень. |
|---|
| 273 |
repeat |
|---|
| 274 |
If Pos('.',TempStr) <> 0 then begin |
|---|
| 275 |
CurrVerLevels := CurrVerLevels + 1; //Есть минимум еще 1 уровень. |
|---|
| 276 |
TempStr2 := Parse(TempStr,'.'); |
|---|
| 277 |
end; |
|---|
| 278 |
until Pos('.',TempStr) = 0; |
|---|
| 279 |
|
|---|
| 280 |
//И в новой. |
|---|
| 281 |
TempStr := OldVerTemp; |
|---|
| 282 |
OldVerLevels := 1; //Есть как минимум 1 уровень. |
|---|
| 283 |
repeat |
|---|
| 284 |
If Pos('.',TempStr) <> 0 then begin |
|---|
| 285 |
OldVerLevels := OldVerLevels + 1; //Есть минимум еще 1 уровень. |
|---|
| 286 |
TempStr2 := Parse(TempStr,'.'); |
|---|
| 287 |
end; |
|---|
| 288 |
until Pos('.',TempStr) = 0; |
|---|
| 289 |
|
|---|
| 290 |
//Теперь вычислить максимальный уровень. |
|---|
| 291 |
If CurrVerLevels > OldVerLevels then begin |
|---|
| 292 |
MaxLevel := CurrVerLevels; |
|---|
| 293 |
end |
|---|
| 294 |
else begin |
|---|
| 295 |
MaxLevel := OldVerLevels; |
|---|
| 296 |
end; |
|---|
| 297 |
|
|---|
| 298 |
//Теперь - к той версии что самая малоуровневая - добавить нулей. |
|---|
| 299 |
If CurrVerLevels < MaxLevel then begin |
|---|
| 300 |
For I := 1 to MaxLevel - CurrVerLevels do begin |
|---|
| 301 |
NewVerTemp := NewVerTemp+'.0'; |
|---|
| 302 |
end; |
|---|
| 303 |
end; |
|---|
| 304 |
If OldVerLevels < MaxLevel then begin |
|---|
| 305 |
For I := 1 to MaxLevel - OldVerLevels do begin |
|---|
| 306 |
OldVerTemp := OldVerTemp+'.0'; |
|---|
| 307 |
end; |
|---|
| 308 |
end; |
|---|
| 309 |
|
|---|
| 310 |
//Ну а теперь - собсно сравнение наконецто. |
|---|
| 311 |
I := 0; |
|---|
| 312 |
repeat |
|---|
| 313 |
I := I+1; |
|---|
| 314 |
TempStr := Parse(OldVerTemp,'.'); |
|---|
| 315 |
TempStr2 := Parse(NewVerTemp,'.'); |
|---|
| 316 |
If StrToInt(TempStr2) > StrToInt(TempStr) then Result := true; |
|---|
| 317 |
until (I = MaxLevel) or (Result = true); |
|---|
| 318 |
end; |
|---|
| 319 |
end; |
|---|
| 320 |
|
|---|
| 321 |
|
|---|
| 322 |
|
|---|
| 323 |
Procedure ParsePathString(const PathString : string; var PathStringList : TStringList); |
|---|
| 324 |
//Парсит строку с путями и загоняет инфу в TStringList. |
|---|
| 325 |
begin |
|---|
| 326 |
|
|---|
| 327 |
//Чистим список. |
|---|
| 328 |
PathStringList.Clear; |
|---|
| 329 |
|
|---|
| 330 |
//Парсим... |
|---|
| 331 |
ExtractStrings([';'], [' '], PChar(PathString), PathStringList); |
|---|
| 332 |
end; |
|---|
| 333 |
|
|---|
| 334 |
Function CombinePathString(const PathStringList : TStringList) : string; |
|---|
| 335 |
//Генерит из TStringList строку типа Path. |
|---|
| 336 |
var |
|---|
| 337 |
I : integer; |
|---|
| 338 |
begin |
|---|
| 339 |
|
|---|
| 340 |
Result := ''; |
|---|
| 341 |
|
|---|
| 342 |
if PathStringList.Count > 0 then begin |
|---|
| 343 |
for I := 0 to PathStringList.Count-1 do begin |
|---|
| 344 |
//Добавить строку... |
|---|
| 345 |
Result := Result+PathStringList.Strings[I]; |
|---|
| 346 |
//И если надо - разделитель. |
|---|
| 347 |
if I < PathStringList.Count-1 then begin |
|---|
| 348 |
Result := Result+';'; |
|---|
| 349 |
end; |
|---|
| 350 |
end; |
|---|
| 351 |
end; |
|---|
| 352 |
|
|---|
| 353 |
end; |
|---|
| 354 |
|
|---|
| 355 |
Function EnvPathExists(const PathStr : string; const CheckUser, CheckGlobal : boolean) : boolean; |
|---|
| 356 |
//Проверяет, существует ли такой path в указанных переменных. |
|---|
| 357 |
var |
|---|
| 358 |
Registr : TRegistry; |
|---|
| 359 |
PathVar : string; |
|---|
| 360 |
PathVarList : TStringList; |
|---|
| 361 |
I : Integer; |
|---|
| 362 |
|
|---|
| 363 |
Function SearcherCode : boolean; |
|---|
| 364 |
begin |
|---|
| 365 |
Result := false; |
|---|
| 366 |
|
|---|
| 367 |
//Получаем путь... |
|---|
| 368 |
PathVar := Registr.ReadString('PATH'); |
|---|
| 369 |
//Парсим строчку... |
|---|
| 370 |
ParsePathString(PathVar,PathVarList); |
|---|
| 371 |
if PathVarList.Count > 0 then begin |
|---|
| 372 |
//Ищем там все наши пути. Только если есть где искать ессно. |
|---|
| 373 |
I := -1; |
|---|
| 374 |
repeat |
|---|
| 375 |
I := I+1; |
|---|
| 376 |
if UpperCase(DelLastSlash(PathVarList.Strings[I])) = UpperCase(DelLastSlash(PathStr)) then begin |
|---|
| 377 |
Result := true; //Чета нашли % ). |
|---|
| 378 |
end; |
|---|
| 379 |
until (I >= PathVarList.Count-1) or (Result = true); |
|---|
| 380 |
end; |
|---|
| 381 |
end; |
|---|
| 382 |
|
|---|
| 383 |
begin |
|---|
| 384 |
|
|---|
| 385 |
//Инициализация.. |
|---|
| 386 |
Registr := TRegistry.Create; |
|---|
| 387 |
PathVarList := TStringList.Create; |
|---|
| 388 |
Result := false; |
|---|
| 389 |
|
|---|
| 390 |
//Чистим |
|---|
| 391 |
//Юзверя... |
|---|
| 392 |
If CheckUser = true then begin |
|---|
| 393 |
Registr.RootKey := HKEY_CURRENT_USER; |
|---|
| 394 |
Registr.OpenKey('\Environment',false); |
|---|
| 395 |
Result := SearcherCode(); |
|---|
| 396 |
end; |
|---|
| 397 |
|
|---|
| 398 |
//Глобально... |
|---|
| 399 |
If CheckGlobal = true then begin |
|---|
| 400 |
Registr.RootKey := HKEY_LOCAL_MACHINE; |
|---|
| 401 |
Registr.OpenKey('\SYSTEM\CurrentControlSet\Control\Session Manager\Environment',false); |
|---|
| 402 |
Result := Result or SearcherCode(); |
|---|
| 403 |
end; |
|---|
| 404 |
|
|---|
| 405 |
//Чистим мусор... |
|---|
| 406 |
Registr.Free; |
|---|
| 407 |
PathVarList.Free; |
|---|
| 408 |
|
|---|
| 409 |
end; |
|---|
| 410 |
|
|---|
| 411 |
Function EnvPathRemove(const PathStr : string; const CheckUser, CheckGlobal : boolean) : boolean; |
|---|
| 412 |
//Удаляет строку пути из указанных PATH. Результат - true если чего-то было удалено. |
|---|
| 413 |
var |
|---|
| 414 |
Registr : TRegistry; |
|---|
| 415 |
PathVar : string; |
|---|
| 416 |
PathVarList : TStringList; |
|---|
| 417 |
I : Integer; |
|---|
| 418 |
Finded : boolean; |
|---|
| 419 |
|
|---|
| 420 |
Function RemoverCode : boolean; |
|---|
| 421 |
begin |
|---|
| 422 |
Result := false; |
|---|
| 423 |
|
|---|
| 424 |
//Получаем путь... |
|---|
| 425 |
PathVar := Registr.ReadString('PATH'); |
|---|
| 426 |
//Парсим строчку... |
|---|
| 427 |
ParsePathString(PathVar,PathVarList); |
|---|
| 428 |
if PathVarList.Count > 0 then begin |
|---|
| 429 |
//Ищем там все наши пути и удаляем. Только если есть где искать ессно. |
|---|
| 430 |
I := -1; |
|---|
| 431 |
Finded := false; //Нашли ли мы там нужный путь... |
|---|
| 432 |
repeat |
|---|
| 433 |
I := I+1; |
|---|
| 434 |
if UpperCase(DelLastSlash(PathVarList.Strings[I])) = UpperCase(DelLastSlash(PathStr)) then begin |
|---|
| 435 |
PathVarList.Delete(I); |
|---|
| 436 |
I := I-1; |
|---|
| 437 |
Finded := true; //Чета нашли % ). |
|---|
| 438 |
end; |
|---|
| 439 |
until I >= PathVarList.Count-1; |
|---|
| 440 |
|
|---|
| 441 |
//Вернем строчку обратно в переменную... |
|---|
| 442 |
//Ессно это сработает только если в переменной хоть что-то было и тем более если |
|---|
| 443 |
//там удалось найти искомое... |
|---|
| 444 |
if Finded = true then begin |
|---|
| 445 |
//Генерим строчку... |
|---|
| 446 |
PathVar := CombinePathString(PathVarList); |
|---|
| 447 |
if DoDebugOutput = true then begin |
|---|
| 448 |
//Writeln('New path will be: '+PathVar); |
|---|
| 449 |
end; |
|---|
| 450 |
//И собсно записываем новое значение... |
|---|
| 451 |
Registr.WriteString('PATH',PathVar); //Временно закомменчено - на время отладки. |
|---|
| 452 |
//Результат. |
|---|
| 453 |
Result := true; |
|---|
| 454 |
end; |
|---|
| 455 |
|
|---|
| 456 |
end; |
|---|
| 457 |
end; |
|---|
| 458 |
|
|---|
| 459 |
begin |
|---|
| 460 |
|
|---|
| 461 |
//Инициализация.. |
|---|
| 462 |
Registr := TRegistry.Create; |
|---|
| 463 |
PathVarList := TStringList.Create; |
|---|
| 464 |
Result := false; |
|---|
| 465 |
|
|---|
| 466 |
//Чистим |
|---|
| 467 |
//Юзверя... |
|---|
| 468 |
If CheckUser = true then begin |
|---|
| 469 |
Registr.RootKey := HKEY_CURRENT_USER; |
|---|
| 470 |
Registr.OpenKey('\Environment',false); |
|---|
| 471 |
Result := RemoverCode(); |
|---|
| 472 |
Registr.CloseKey; |
|---|
| 473 |
end; |
|---|
| 474 |
|
|---|
| 475 |
//Глобально... |
|---|
| 476 |
If CheckGlobal = true then begin |
|---|
| 477 |
Registr.RootKey := HKEY_LOCAL_MACHINE; |
|---|
| 478 |
Registr.OpenKey('\SYSTEM\CurrentControlSet\Control\Session Manager\Environment',false); |
|---|
| 479 |
Result := Result or RemoverCode(); |
|---|
| 480 |
Registr.CloseKey; |
|---|
| 481 |
end; |
|---|
| 482 |
|
|---|
| 483 |
//Сообщаем другим прогам что щей-то поменялось... |
|---|
| 484 |
if Result = true then begin |
|---|
| 485 |
SendMessage( HWND_BROADCAST, WM_SETTINGCHANGE, 0, LPARAM(LPCSTR('Environment')) ); |
|---|
| 486 |
end; |
|---|
| 487 |
|
|---|
| 488 |
//Чистим мусор... |
|---|
| 489 |
Registr.Free; |
|---|
| 490 |
PathVarList.Free; |
|---|
| 491 |
|
|---|
| 492 |
end; |
|---|
| 493 |
|
|---|
| 494 |
Function EnvPathAdd(const PathStr : string; const Target : integer; const ForceRemoveDoubles : boolean = true; const ForceCreateLocal : boolean = false) : boolean; |
|---|
| 495 |
//Добавляет путь в указанные PATH. |
|---|
| 496 |
var |
|---|
| 497 |
Registr : TRegistry; |
|---|
| 498 |
UserPathVar, GlobalPathVar : string; |
|---|
| 499 |
UserPathVarList, GlobalPathVarList : TStringList; |
|---|
| 500 |
Finded : boolean; |
|---|
| 501 |
|
|---|
| 502 |
begin |
|---|
| 503 |
//Инициализация.. |
|---|
| 504 |
Registr := TRegistry.Create; |
|---|
| 505 |
Result := false; |
|---|
| 506 |
|
|---|
| 507 |
//Итак, в зависимости от того куда собираемся добавлять... |
|---|
| 508 |
if Target = EnvPathAdd_Global then begin |
|---|
| 509 |
//В глобалку добавляем |
|---|
| 510 |
|
|---|
| 511 |
//Ищем есть ли этот путь в локалке. Если есть - удаляем. |
|---|
| 512 |
EnvPathRemove(PathStr, true, false); |
|---|
| 513 |
|
|---|
| 514 |
//Теперь проверим - есть ли в глобалке такой путь уже... |
|---|
| 515 |
Finded := EnvPathExists(PathStr, false, true); |
|---|
| 516 |
|
|---|
| 517 |
//Если нифига не нашли - добавляем переменную. Если нашли - ниче трогать не надо %). |
|---|
| 518 |
if Finded = false then begin |
|---|
| 519 |
Registr.RootKey := HKEY_LOCAL_MACHINE; |
|---|
| 520 |
Registr.OpenKey('\SYSTEM\CurrentControlSet\Control\Session Manager\Environment',true); |
|---|
| 521 |
//Получаем путь... |
|---|
| 522 |
GlobalPathVar := Registr.ReadString('PATH'); |
|---|
| 523 |
//Парсим строчку... |
|---|
| 524 |
GlobalPathVarList := TStringList.Create; |
|---|
| 525 |
ParsePathString(GlobalPathVar,GlobalPathVarList); |
|---|
| 526 |
//Добавляем значение... |
|---|
| 527 |
GlobalPathVarList.Add(PathStr); |
|---|
| 528 |
GlobalPathVar := CombinePathString(GlobalPathVarList); |
|---|
| 529 |
//Пишем все обратно. |
|---|
| 530 |
if DoDebugOutput = true then begin |
|---|
| 531 |
//Writeln('New global path will be: '+GlobalPathVar); |
|---|
| 532 |
end; |
|---|
| 533 |
//И собсно записываем новое значение... |
|---|
| 534 |
Registr.WriteString('PATH',GlobalPathVar); //Временно закомменчено - на время отладки. |
|---|
| 535 |
Registr.CloseKey; |
|---|
| 536 |
//Сообщаем другим прогам что щей-то поменялось... |
|---|
| 537 |
SendMessage( HWND_BROADCAST, WM_SETTINGCHANGE, 0, LPARAM(LPCSTR('Environment')) ); |
|---|
| 538 |
//Чистим мусор... |
|---|
| 539 |
GlobalPathVarList.Free; |
|---|
| 540 |
end; |
|---|
| 541 |
end |
|---|
| 542 |
else if Target = EnvPathAdd_User then begin |
|---|
| 543 |
//В локалку добавляем |
|---|
| 544 |
|
|---|
| 545 |
//Проверяем, есть ли в глобалке такой путь (если не форсим добавление в локалку), |
|---|
| 546 |
//либо если сказано удалять в глобалке - удаляем. |
|---|
| 547 |
Finded := false; |
|---|
| 548 |
if ForceRemoveDoubles = true then begin |
|---|
| 549 |
//Удаляем глобалку |
|---|
| 550 |
EnvPathRemove(PathStr, false, true); |
|---|
| 551 |
end |
|---|
| 552 |
else if ForceCreateLocal = false then begin |
|---|
| 553 |
//Проверяем есть ли что-то в глобалке - если есть то в локалку добавляться не будет. |
|---|
| 554 |
Finded := EnvPathExists(PathStr, false, true); |
|---|
| 555 |
end; |
|---|
| 556 |
|
|---|
| 557 |
//Если пока есть причины продолжать - проверяем, есть ли в локалке такой путь... |
|---|
| 558 |
if Finded = false then begin |
|---|
| 559 |
Finded := EnvPathExists(PathStr, true, false); |
|---|
| 560 |
end; |
|---|
| 561 |
|
|---|
| 562 |
//И теперь, если таки нужно добавить новое значение в переменную - добавляем. |
|---|
| 563 |
Registr.RootKey := HKEY_CURRENT_USER; |
|---|
| 564 |
Registr.OpenKey('\Environment',true); |
|---|
| 565 |
//Получаем путь... |
|---|
| 566 |
UserPathVar := Registr.ReadString('PATH'); |
|---|
| 567 |
//Парсим строчку... |
|---|
| 568 |
UserPathVarList := TStringList.Create; |
|---|
| 569 |
ParsePathString(UserPathVar,UserPathVarList); |
|---|
| 570 |
//Добавляем значение... |
|---|
| 571 |
UserPathVarList.Add(PathStr); |
|---|
| 572 |
UserPathVar := CombinePathString(UserPathVarList); |
|---|
| 573 |
//Пишем все обратно. |
|---|
| 574 |
if DoDebugOutput = true then begin |
|---|
| 575 |
//Writeln('New user path will be: '+UserPathVar); |
|---|
| 576 |
end; |
|---|
| 577 |
//И собсно записываем новое значение... |
|---|
| 578 |
Registr.WriteString('PATH',UserPathVar); //Временно закомменчено - на время отладки. |
|---|
| 579 |
Registr.CloseKey; |
|---|
| 580 |
//Сообщаем другим прогам что щей-то поменялось... |
|---|
| 581 |
SendMessage( HWND_BROADCAST, WM_SETTINGCHANGE, 0, LPARAM(LPCSTR('Environment')) ); |
|---|
| 582 |
//Чистим мусор... |
|---|
| 583 |
UserPathVarList.Free; |
|---|
| 584 |
end; |
|---|
| 585 |
|
|---|
| 586 |
//Чистим мусор... |
|---|
| 587 |
Registr.Free; |
|---|
| 588 |
end; |
|---|
| 589 |
|
|---|
| 590 |
Function TrimExLeft(const InputStr, TrimChars : string) : string; |
|---|
| 591 |
//Тримает символы слева. |
|---|
| 592 |
var |
|---|
| 593 |
FindedTrimChar, FindedNoTrimChar : boolean; |
|---|
| 594 |
I, J : Integer; |
|---|
| 595 |
|
|---|
| 596 |
begin |
|---|
| 597 |
|
|---|
| 598 |
//Умолчальное возвращаемое значение. |
|---|
| 599 |
Result := ''; |
|---|
| 600 |
|
|---|
| 601 |
//Есть ли во входной строке хоть что-то.... |
|---|
| 602 |
if Length(InputStr) > 0 then begin |
|---|
| 603 |
//Есть. Значит считаем количество символов с начала строки совпадающие с TrimChars... |
|---|
| 604 |
I := 0; |
|---|
| 605 |
FindedNoTrimChar := false; |
|---|
| 606 |
repeat |
|---|
| 607 |
//Цикл собственно подсчета количества тримаемых символов. |
|---|
| 608 |
//Щелкаем счетчиком и обнуляем индикатор проверки символа. |
|---|
| 609 |
I := I+1; |
|---|
| 610 |
FindedTrimChar := false; |
|---|
| 611 |
|
|---|
| 612 |
//Проверяем символ |
|---|
| 613 |
for J := 1 to Length(TrimChars) do begin |
|---|
| 614 |
//Цикл проверки является ли символ тримаемым %). |
|---|
| 615 |
if InputStr[I] = TrimChars[J] then begin |
|---|
| 616 |
FindedTrimChar := true; //Нашли такой символ. |
|---|
| 617 |
end; |
|---|
| 618 |
end; |
|---|
| 619 |
|
|---|
| 620 |
//Смотрим результат проверки. |
|---|
| 621 |
if FindedTrimChar = false then begin |
|---|
| 622 |
//Таки символ оказался не тримаемым - подсчет завершен, отмечаем что первый не-трим символ найден. |
|---|
| 623 |
FindedNoTrimChar := true; |
|---|
| 624 |
end; |
|---|
| 625 |
|
|---|
| 626 |
until (I = Length(InputStr)) or (FindedNoTrimChar = true); |
|---|
| 627 |
|
|---|
| 628 |
//Теперь в зависимости от того что нашли... |
|---|
| 629 |
If FindedNoTrimChar = true then begin |
|---|
| 630 |
//Если в строке есть что-то помимо тримаемых символов - будем тримы удалять. |
|---|
| 631 |
//Если бы там были только они - можно было бы вообще ничего не делать - вернется пустая строка. |
|---|
| 632 |
Result := RightStr(InputStr,Length(InputStr)-I+1); |
|---|
| 633 |
end; |
|---|
| 634 |
end; |
|---|
| 635 |
|
|---|
| 636 |
end; |
|---|
| 637 |
|
|---|
| 638 |
Function TrimExRight(const InputStr, TrimChars : string) : string; |
|---|
| 639 |
//Тримает символы справа. |
|---|
| 640 |
var |
|---|
| 641 |
FindedTrimChar, FindedNoTrimChar : boolean; |
|---|
| 642 |
I, J : Integer; |
|---|
| 643 |
|
|---|
| 644 |
begin |
|---|
| 645 |
|
|---|
| 646 |
//Умолчальное возвращаемое значение. |
|---|
| 647 |
Result := ''; |
|---|
| 648 |
|
|---|
| 649 |
//Есть ли во входной строке хоть что-то.... |
|---|
| 650 |
if Length(InputStr) > 0 then begin |
|---|
| 651 |
//Есть. Значит считаем количество символов с конца строки совпадающие с TrimChars... |
|---|
| 652 |
I := Length(InputStr)+1; |
|---|
| 653 |
FindedNoTrimChar := false; |
|---|
| 654 |
repeat |
|---|
| 655 |
//Цикл собственно подсчета количества тримаемых символов. |
|---|
| 656 |
//Щелкаем счетчиком и обнуляем индикатор проверки символа. |
|---|
| 657 |
I := I-1; |
|---|
| 658 |
FindedTrimChar := false; |
|---|
| 659 |
|
|---|
| 660 |
//Проверяем символ |
|---|
| 661 |
for J := 1 to Length(TrimChars) do begin |
|---|
| 662 |
//Цикл проверки является ли символ тримаемым %). |
|---|
| 663 |
if InputStr[I] = TrimChars[J] then begin |
|---|
| 664 |
FindedTrimChar := true; //Нашли такой символ. |
|---|
| 665 |
end; |
|---|
| 666 |
end; |
|---|
| 667 |
|
|---|
| 668 |
//Смотрим результат проверки. |
|---|
| 669 |
if FindedTrimChar = false then begin |
|---|
| 670 |
//Таки символ оказался не тримаемым - подсчет завершен, отмечаем что первый не-трим символ найден. |
|---|
| 671 |
FindedNoTrimChar := true; |
|---|
| 672 |
end; |
|---|
| 673 |
|
|---|
| 674 |
until (I = 1) or (FindedNoTrimChar = true); |
|---|
| 675 |
|
|---|
| 676 |
//Теперь в зависимости от того что нашли... |
|---|
| 677 |
If FindedNoTrimChar = true then begin |
|---|
| 678 |
//Если в строке есть что-то помимо тримаемых символов - будем тримы удалять. |
|---|
| 679 |
//Если бы там были только они - можно было бы вообще ничего не делать - вернется пустая строка. |
|---|
| 680 |
Result := LeftStr(InputStr,I); |
|---|
| 681 |
end; |
|---|
| 682 |
end; |
|---|
| 683 |
|
|---|
| 684 |
end; |
|---|
| 685 |
|
|---|
| 686 |
Function TrimEx(const InputStr, TrimChars : string) : string; |
|---|
| 687 |
//Тримает символы со всех сторон. |
|---|
| 688 |
begin |
|---|
| 689 |
//Просто вызываем обе отдельные функции. |
|---|
| 690 |
Result := TrimExLeft(TrimExRight(InputStr, TrimChars), TrimChars); |
|---|
| 691 |
end; |
|---|
| 692 |
|
|---|
| 693 |
Function FileToCRC32(const FileName : string; const ConsoleOutput : boolean = false) : cardinal; |
|---|
| 694 |
//Вычислить CRC32 для файла, если надо с индикацией процесса в консоль. |
|---|
| 695 |
const |
|---|
| 696 |
ReadBuffSize = 500000; //По 500 кб - думаю такой буффер пойдет даже на самой древней вендовой системе... |
|---|
| 697 |
//... или на виртуальном linux-хосте с wine. |
|---|
| 698 |
var |
|---|
| 699 |
CurrStream : TFileStream; |
|---|
| 700 |
//Buffer : array [0..ReadBuffSize-1] of byte; //Изза бага, возможно в fpc (в дельфе все пашет) - приходится юзать динамический массив. |
|---|
| 701 |
Buffer : array of byte; |
|---|
| 702 |
Readed, FullReaded : LongInt; |
|---|
| 703 |
|
|---|
| 704 |
begin |
|---|
| 705 |
|
|---|
| 706 |
//Инициализируем значение CRC |
|---|
| 707 |
Result := crc32(0, nil, 0); |
|---|
| 708 |
//и выделяем память под буффер... |
|---|
| 709 |
SetLength(Buffer,ReadBuffSize-1); |
|---|
| 710 |
|
|---|
| 711 |
//Существует ли файлег... |
|---|
| 712 |
if FileExists(FileName) = true then begin |
|---|
| 713 |
//Если есть что высчитывать - считаем... |
|---|
| 714 |
|
|---|
| 715 |
//Счетчики чтения... |
|---|
| 716 |
Readed := 0; |
|---|
| 717 |
FullReaded := 0; |
|---|
| 718 |
|
|---|
| 719 |
//Открываем файл... |
|---|
| 720 |
CurrStream := TFileStream.Create(FileName,fmOpenRead); |
|---|
| 721 |
|
|---|
| 722 |
//Если надо - выводим инфу о прогрессе в консоль. |
|---|
| 723 |
if ConsoleOutput = true then begin |
|---|
| 724 |
Write('CRC32: '+FileName+' -> '); |
|---|
| 725 |
end; |
|---|
| 726 |
|
|---|
| 727 |
//Собсно считаем. Читаем файл по кусочкам пока файл не кончится. |
|---|
| 728 |
repeat |
|---|
| 729 |
Readed := CurrStream.Read(buffer[0],ReadBuffSize); |
|---|
| 730 |
FullReaded := FullReaded+Readed; |
|---|
| 731 |
Result := crc32(Result, @buffer[0], Readed); |
|---|
| 732 |
until Readed = 0; |
|---|
| 733 |
|
|---|
| 734 |
//Готово. Закрыть прочитанный файл. |
|---|
| 735 |
CurrStream.Free; |
|---|
| 736 |
//И если надо сообщить новую CRC в консоль... |
|---|
| 737 |
if ConsoleOutput = true then begin |
|---|
| 738 |
Writeln(IntToHex(Result,8)); |
|---|
| 739 |
end; |
|---|
| 740 |
|
|---|
| 741 |
end; |
|---|
| 742 |
|
|---|
| 743 |
//Чистим мусор |
|---|
| 744 |
SetLength(Buffer,0); |
|---|
| 745 |
end; |
|---|
| 746 |
|
|---|
| 747 |
Function CheckCharNum(const Ch : char) : boolean; |
|---|
| 748 |
//Проверить - является ли символ цифрой |
|---|
| 749 |
begin |
|---|
| 750 |
result := false; |
|---|
| 751 |
if Ch = '0' then result := true; |
|---|
| 752 |
if Ch = '1' then result := true; |
|---|
| 753 |
if Ch = '2' then result := true; |
|---|
| 754 |
if Ch = '3' then result := true; |
|---|
| 755 |
if Ch = '4' then result := true; |
|---|
| 756 |
if Ch = '5' then result := true; |
|---|
| 757 |
if Ch = '6' then result := true; |
|---|
| 758 |
if Ch = '7' then result := true; |
|---|
| 759 |
if Ch = '8' then result := true; |
|---|
| 760 |
if Ch = '9' then result := true; |
|---|
| 761 |
end; |
|---|
| 762 |
|
|---|
| 763 |
Function CheckStrInt(const St : string) : boolean; |
|---|
| 764 |
//Проверить - является ли строка представлением целочисленного значения |
|---|
| 765 |
var |
|---|
| 766 |
ch : char; |
|---|
| 767 |
I : integer; |
|---|
| 768 |
|
|---|
| 769 |
begin |
|---|
| 770 |
If (st <> '') and (st<>'-') then begin |
|---|
| 771 |
result := true; |
|---|
| 772 |
I := 0; |
|---|
| 773 |
If St[I+1] = '-' then I := I+1; |
|---|
| 774 |
repeat |
|---|
| 775 |
I := I+1; |
|---|
| 776 |
Ch := St[I]; |
|---|
| 777 |
if ch <> #0 then if CheckCharNum(Ch) = false then result := false; |
|---|
| 778 |
until Ch = #0; |
|---|
| 779 |
end |
|---|
| 780 |
else result := false; |
|---|
| 781 |
end; |
|---|
| 782 |
|
|---|
| 783 |
Function CheckStrFloat(const St : string) : boolean; |
|---|
| 784 |
//Проверить - является ли строка представлением дробного значения |
|---|
| 785 |
var |
|---|
| 786 |
zapatih, I : integer; |
|---|
| 787 |
ch : char; |
|---|
| 788 |
|
|---|
| 789 |
begin |
|---|
| 790 |
If (st <> '') and (st <> 'NAN') and (st<>'-') then begin |
|---|
| 791 |
result := true; |
|---|
| 792 |
zapatih := 1; |
|---|
| 793 |
I := 0; |
|---|
| 794 |
If St[I+1] = '-' then I := I+1; |
|---|
| 795 |
repeat |
|---|
| 796 |
I := I+1; |
|---|
| 797 |
Ch := St[I]; |
|---|
| 798 |
If ch = '.' then zapatih := zapatih-1 |
|---|
| 799 |
else if ch <> #0 then if CheckCharNum(Ch) = false then result := false; |
|---|
| 800 |
until Ch = #0; |
|---|
| 801 |
if zapatih < 0 then result := false; |
|---|
| 802 |
end |
|---|
| 803 |
else begin |
|---|
| 804 |
If St = 'NAN' then result := true |
|---|
| 805 |
else Result := false; |
|---|
| 806 |
end; |
|---|
| 807 |
end; |
|---|
| 808 |
|
|---|
| 809 |
Function IntToBool(const InputInt : Integer) : boolean; |
|---|
| 810 |
//Превратить Integer в Boolean |
|---|
| 811 |
begin |
|---|
| 812 |
If InputInt = 1 then begin |
|---|
| 813 |
Result := true; |
|---|
| 814 |
end |
|---|
| 815 |
else begin |
|---|
| 816 |
Result := false; |
|---|
| 817 |
end; |
|---|
| 818 |
end; |
|---|
| 819 |
|
|---|
| 820 |
Function StrToBool(const InputStr : AnsiString) : boolean; |
|---|
| 821 |
//Превратить String в Boolean |
|---|
| 822 |
begin |
|---|
| 823 |
//Проверить, интегеровое число ли ето. |
|---|
| 824 |
If CheckStrInt(InputStr) = true then begin |
|---|
| 825 |
//Если какое-то число, то вернуть его значение... |
|---|
| 826 |
Result := IntToBool(StrToInt(InputStr)); |
|---|
| 827 |
end |
|---|
| 828 |
else begin |
|---|
| 829 |
//Если там какая-то фигня, то вернуть false |
|---|
| 830 |
Result := false; |
|---|
| 831 |
end; |
|---|
| 832 |
end; |
|---|
| 833 |
|
|---|
| 834 |
Function BoolToInt(const InputBool : boolean) : Integer; |
|---|
| 835 |
//Превратить Boolean в Integer |
|---|
| 836 |
begin |
|---|
| 837 |
If InputBool = true then begin |
|---|
| 838 |
//true |
|---|
| 839 |
Result := 1; |
|---|
| 840 |
end |
|---|
| 841 |
else begin |
|---|
| 842 |
//false |
|---|
| 843 |
Result := 0; |
|---|
| 844 |
end; |
|---|
| 845 |
end; |
|---|
| 846 |
|
|---|
| 847 |
Function BoolToStr(const InputBool : boolean) : AnsiString; |
|---|
| 848 |
//Превратить Boolean в String |
|---|
| 849 |
begin |
|---|
| 850 |
Result := IntToStr(BoolToInt(InputBool)); |
|---|
| 851 |
end; |
|---|
| 852 |
|
|---|
| 853 |
Function IsLocalPath(const PathStr : string) : boolean; |
|---|
| 854 |
//Возвращает true если путь локальный, и false если нет. |
|---|
| 855 |
//Под локальным понимается путь начинающийся с точки. |
|---|
| 856 |
begin |
|---|
| 857 |
Result := false; //По умолчанию считаем что путь глобален. |
|---|
| 858 |
|
|---|
| 859 |
if Length(PathStr) >= 1 then begin |
|---|
| 860 |
if PathStr[1] = '.' then begin |
|---|
| 861 |
Result := true; |
|---|
| 862 |
end; |
|---|
| 863 |
end; |
|---|
| 864 |
end; |
|---|
| 865 |
|
|---|
| 866 |
Function ReadFirstLineFromStr(const InputStr : AnsiString) : AnsiString; |
|---|
| 867 |
//Элементарно скопировать строку от начала до байта #13 или #10 если #13 не обнаружится. |
|---|
| 868 |
var |
|---|
| 869 |
EndStrPos13, EndStrPos10, EndStrPos : Integer; |
|---|
| 870 |
begin |
|---|
| 871 |
//Инициализация. |
|---|
| 872 |
Result := ''; |
|---|
| 873 |
|
|---|
| 874 |
//Определяем позицию конца строки по #13. |
|---|
| 875 |
EndStrPos13 := Longint( StrPos( PChar(InputStr), PChar(#13) ) - LongInt(InputStr) + 1 ) ; |
|---|
| 876 |
if EndStrPos13 <= 0 then begin |
|---|
| 877 |
EndStrPos13 := Length( InputStr )+1; |
|---|
| 878 |
end; |
|---|
| 879 |
//И по #10 |
|---|
| 880 |
EndStrPos10 := Longint( StrPos( PChar(InputStr), PChar(#10) ) - LongInt(InputStr) + 1 ) ; |
|---|
| 881 |
if EndStrPos10 <= 0 then begin |
|---|
| 882 |
EndStrPos10 := Length( InputStr )+1; |
|---|
| 883 |
end; |
|---|
| 884 |
//Определяем реальный конец строки. |
|---|
| 885 |
if EndStrPos10 < EndStrPos13 then begin |
|---|
| 886 |
EndStrPos := EndStrPos10; |
|---|
| 887 |
end |
|---|
| 888 |
else begin |
|---|
| 889 |
EndStrPos := EndStrPos13; |
|---|
| 890 |
end; |
|---|
| 891 |
|
|---|
| 892 |
//И собсно копируем результат. |
|---|
| 893 |
Result := Copy(InputStr,1,EndStrPos-1); |
|---|
| 894 |
end; |
|---|
| 895 |
|
|---|
| 896 |
// добаляет расширение если его еще нет. |
|---|
| 897 |
function AddExtensionIfAbsent(const path, extension :String) :String; |
|---|
| 898 |
var |
|---|
| 899 |
ex :AnsiString; |
|---|
| 900 |
begin |
|---|
| 901 |
Result := path; |
|---|
| 902 |
ex := ExtractFileExt(path); |
|---|
| 903 |
if (ex = '') then begin |
|---|
| 904 |
Result := path + extension; |
|---|
| 905 |
end; |
|---|
| 906 |
end; |
|---|
| 907 |
|
|---|
| 908 |
// чистое имя файла, без расширения |
|---|
| 909 |
function GetFileNameWithoutExtension(const path :String) :String; |
|---|
| 910 |
var |
|---|
| 911 |
fileName :String; |
|---|
| 912 |
i :Integer; |
|---|
| 913 |
begin |
|---|
| 914 |
fileName := ExtractFileName(path); |
|---|
| 915 |
i := Length(FileName); |
|---|
| 916 |
while (i > 0) and (FileName[i] <> '.') do Dec(i); |
|---|
| 917 |
|
|---|
| 918 |
if (i > 0) then |
|---|
| 919 |
Result := Copy(FileName, 1, i - 1) |
|---|
| 920 |
else |
|---|
| 921 |
Result := fileName; |
|---|
| 922 |
|
|---|
| 923 |
|
|---|
| 924 |
end; |
|---|
| 925 |
|
|---|
| 926 |
end. |
|---|
| 927 |
|
|---|