root/branches/0_1_3/ExtraFunctionsLcl.pas

Revision 120, 29.1 kB (checked in by sagrer, 1 year ago)

Пофиксана бага с неправильной работой инсталлера под wine в котором по умолчанию отсутствует Environment для юзверя в реестре. Теперь вроде все инсталлится правильно, осталась проблема с багой в самом wine но она решается ручной правкой реестра (конфликтуют глобальные и юзврские переменные окружения - юзерские перекрывают глобальные а должны как бы складываться) а о баге запошенно в виневскую багзиллу.

  • Property svnmailer:content-charset set to cp1251
Line 
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
Note: See TracBrowser for help on using the browser.