diff options
Diffstat (limited to 'UCoreUtils.pas')
| -rw-r--r-- | UCoreUtils.pas | 1821 |
1 files changed, 1821 insertions, 0 deletions
diff --git a/UCoreUtils.pas b/UCoreUtils.pas new file mode 100644 index 0000000..0e12550 --- /dev/null +++ b/UCoreUtils.pas @@ -0,0 +1,1821 @@ +(* + Tux Commander - UCoreUtils - Some other useful core functions + Copyright (C) 2008 Tomas Bzatek <tbzatek@users.sourceforge.net> + Check for updates on tuxcmd.sourceforge.net + + Portions of this unit (CRC32, THash_MD5) are part of the Delphi Encryption Compendium + Copyright: Hagen Reddmann mailto:HaReddmann@AOL.COM + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*) +unit UCoreUtils; + +interface + +uses gdk2pixbuf, gtk2, gdk2, glib2, SysUtils, Classes, Libc, GTKControls, GTKStdCtrls, GTKClasses, UEngines; + +type + PIntArray = ^TIntArray; + TIntArray = array[0..1023] of LongWord; + + TOpenStringArray = array of string; + + THash_MD5 = class + private + FCount: Int64; + FBuffer: array[0..63] of Byte; + FDigest: array[0..9] of LongWord; + protected + function TestVector: Pointer; + procedure Transform(Buffer: PIntArray); + public + constructor Create; + procedure Init; + procedure Done; + procedure Calc(const Data; DataSize: Integer); + function DigestKey: string; + function GetKeyStrH: string; + end; + + +const ConstERRSpawn = 26; + ConstQuotationCharacters = [' ', '"', '''', '(', ')', ':', '&']; + +function GetErrorString(ErrorNo: integer): string; +function GetSignalString(SignalNo: integer): string; + +function UnixTimeToTDateTime(UnixTime: Int64): TDateTime; +function FormatSize(Value: Int64; Base: integer): string; + +function AttrToStr(const Mode: Cardinal; IncludeFileType: boolean = True): string; +function AttrToOctal(const Mode: Cardinal): integer; +function OctalToAttr(Octal: Cardinal): Cardinal; +{ Convert an octal specified number to decimal } +{ Copied from linux.pp (Free Pascal run time library) - Copyright (c) 1999-2000 by Michael Van Canneyt, BSD parts (c) 2000 by Marco van de Voort, members of the Free Pascal development team } + +function PosEnd(Substr: string; S: string): Integer; +function GetHomePath: string; +function GetUserName: string; +function GetHostName: string; +procedure SeparateExt(const Original: string; var Name, Ext: string); +procedure SeparateNameDir(Original: string; var Path, FileName: string); +function PadRightStr(const Str: string; Len: byte): string; + +function IsWild(InputStr, Wilds: string; IgnoreCase: Boolean): Boolean; +{ IsWild compares InputString with WildCard string and returns True if corresponds. } +{ Copied from Delphi VCL Extensions (RX) - Copyright (c) 1995, 1996 AO ROSNO, Copyright (c) 1997, 1998 Master-Bank } +function ReplaceStr(const S, Srch, Replace: string): string; +{ Returns string with every occurrence of Srch string replaced with Replace string. } +{ Copied from Delphi VCL Extensions (RX) - Copyright (c) 1995, 1996 AO ROSNO, Copyright (c) 1997, 1998 Master-Bank } +function NumCountChars(const Char: char; const S: string): integer; + +procedure ParseString(const Str, Separator: string; var SubStrings: TOpenStringArray); + + +function ProcessPattern(Engine: TPanelEngine; Pattern, APath, FileName: string; const Directory: boolean): string; +// Processess pattern with FileName located in APath and return destination path+filename +procedure ShowAbout; + +procedure TrimCRLFESC(var s: string); +procedure TrimQuotes(var s: string); +function QuoteStr(const Str: string): string; +function QuoteMarkupStr(const Str: string): string; +function QuotePercentStr(const Str: string): string; +function RemoveQuotation(const Str: string): string; +function GetStrSize(s: string): Int64; +procedure DebugMsg(Params: array of const); +function SpawnProcess(const AppPath: string; var Running: boolean; const Parameters: array of string): Cardinal; +function ExecuteProgram(const AppCMDLine, CWD: string; const AutodetectGUI, RunInTerminal: boolean; var ErrorSignal: integer): boolean; +function IsItX11App(const Application: string): boolean; +function HandleSystemCommand(const Command, ErrorText: string): boolean; + +function CompareTextsEx(S1, S2: PChar): integer; +function LVCompareItems(Data1, Data2: PDataItem; const Ascending: boolean; const SortColumnID: integer): integer; +procedure SortDataList(var List: TList; const Ascending: boolean; const SortColumnID: integer); +procedure GetFirstLastPanelColumn(var FirstColumn, LastColumn: integer); + +procedure SetupColors; + +function ConstructURI(HidePasswd: boolean; Protocol, Server, Username, Password, Dir: string): string; +function URIHidePassword(const SrcURI: string): string; + +{$IFDEF __FPC__} +function StrToDateDef(const S: string; const Default: TDateTime): TDateTime; +function UnixToDateTime(const AValue: Int64): TDateTime; +{$ENDIF} + +procedure SaveItemToHistory(s: string; History: TStringList); + + + + +// Calculate CRC32 Checksum, CRC is default $FFFFFFFF, +// After calc you must inverse Result with NOT +function CRC32(CRC: LongWord; Data: Pointer; DataSize: LongWord): LongWord; + +procedure ReportGTKVersion; + +// Internal locking +procedure InternalLock; +procedure InternalUnLock; +function InternalLockUnlocked: boolean; +procedure InternalLockInit(Locked: boolean); + +var ChildExitStatus: sig_atomic_t; + + AppPath, IconPath: string; // Used in UFileTypeSettings + + NormalItemGDKColor, ActiveItemGDKColor, InactiveItemGDKColor, SelectedItemGDKColor, DotFileItemGDKColor, LinkItemGDKColor, + NormalItemGDKBackground, ActiveItemGDKBackground, InactiveItemGDKBackground: PGdkColor; + InactiveItemBGColorNum: LongWord; + + +implementation + +uses DateUtils, GTKForms, GTKUtils, GTKView, ULocale, UConfig, UCore, UGnome, UMain; + +(********************************************************************************************************************************) +function GetErrorString(ErrorNo: integer): string; +begin + if ErrorNo >= 0 then Result := String(strerror(ErrorNo)) + else + case ErrorNo of + ERRException : Result := LANGUnknownException; + ERRNoAccess : Result := LANGNoAccess; + else Result := LANGUnknownError; + end; +end; + +(********************************************************************************************************************************) +function GetSignalString(SignalNo: integer): string; +begin + Result := strsignal(SignalNo); +end; + +(********************************************************************************************************************************) +function UnixTimeToTDateTime(UnixTime: Int64): TDateTime; +//var tm : PUnixTime; +begin + Result := UnixToDateTime(UnixTime); +{ tm := localtime(@UnixTime); + Result := EncodeDate(tm^.tm_year + 1900, tm^.tm_mon + 1, tm^.tm_mday) + + EncodeTime(tm^.tm_hour, tm^.tm_min, tm^.tm_sec, 0); } +end; + +(********************************************************************************************************************************) +function FormatFloat64(Value: Int64; Sep: string): string; +var i : integer; + Orig : string; +begin + Result := IntToStr(Value); + Orig := Result; + if (Sep <> '') and (Length(Result) > 2) then + for i := Length(Result) downto 2 do + if (Length(Orig) - i + 1) mod 3 = 0 then + Insert(Sep, Result, i); +end; + +function FormatSize(Value: Int64; Base: integer): string; +var s: string; + i: integer; +begin + if Base < 1 then Base := 1; + case ConfSizeFormat of + 0 : begin // System default formatting + Result := FormatFloat('###,###,##0', Value div Base); + end; + 1 : begin // 123456 + Result := IntToStr(Value div Base); + end; + 2 : begin // 123,456 + Result := FormatFloat64(Value div Base, ','); + end; + 3 : begin // 123 456 + Result := FormatFloat64(Value div Base, ' '); + end; + 4 : begin // 123'456 + Result := FormatFloat64(Value div Base, ''''); + end; + 5 : begin // 123kB - Grouped + s := '###,###,##0'; + if ConfSizeGroupPrecision > 0 then begin + s := s + '.'; + for i := 1 to ConfSizeGroupPrecision do + if ConfSizeGroupRequestZeroDigits then s := s + '0' + else s := s + '#'; + end; + if (Value >= 1024*1024*1024) or (Base = 1024*1024*1024) then Result := FormatFloat(s + ' GB', Value / (1024*1024*1024)) else + if (Value >= 1024*1024) or (Base = 1024*1024) then Result := FormatFloat(s + ' MB', Value / (1024*1024)) else + if (Value >= 1024) or (Base = 1024) then Result := FormatFloat(s + ' kB', Value / (1024)) else + Result := IntToStr(Value); + end; + end; + if ConfSizeFormat in [0..4] then begin + if Result = '' then Result := '0'; + if Base = 1024 then Result := Result + ' kB' else + if Base = 1024*1024 then Result := Result + ' MB' else + if Base = 1024*1024*1024 then Result := Result + ' GB'; + end; + if Result = '' then Result := '0'; +end; + +(********************************************************************************************************************************) +function AttrToStr(const Mode: Cardinal; IncludeFileType: boolean = True): string; +begin + if IncludeFileType then begin + if __S_ISTYPE(Mode, __S_IFLNK) then Result := 'l' else + if __S_ISTYPE(Mode, __S_IFDIR) then Result := 'd' else + if __S_ISTYPE(Mode, __S_IFBLK) then Result := 'b' else + if __S_ISTYPE(Mode, __S_IFCHR) then Result := 'c' else + if __S_ISTYPE(Mode, __S_IFIFO) then Result := 'f' else + if __S_ISTYPE(Mode, __S_IFSOCK) then Result := 's' else Result := '-'; + end else Result := ''; + if Mode and S_IRUSR = S_IRUSR then Result := Result + 'r' else Result := Result + '-'; + if Mode and S_IWUSR = S_IWUSR then Result := Result + 'w' else Result := Result + '-'; + if Mode and __S_ISUID = __S_ISUID then if Mode and S_IXUSR = S_IXUSR then Result := Result + 's' else Result := Result + 'S' else + if Mode and S_IXUSR = S_IXUSR then Result := Result + 'x' else Result := Result + '-'; + if Mode and S_IRGRP = S_IRGRP then Result := Result + 'r' else Result := Result + '-'; + if Mode and S_IWGRP = S_IWGRP then Result := Result + 'w' else Result := Result + '-'; + if Mode and __S_ISGID = __S_ISGID then if Mode and S_IXGRP = S_IXGRP then Result := Result + 's' else Result := Result + 'S' else + if Mode and S_IXGRP = S_IXGRP then Result := Result + 'x' else Result := Result + '-'; + if Mode and S_IROTH = S_IROTH then Result := Result + 'r' else Result := Result + '-'; + if Mode and S_IWOTH = S_IWOTH then Result := Result + 'w' else Result := Result + '-'; + if Mode and __S_ISVTX = __S_ISVTX then if Mode and S_IXOTH = S_IXOTH then Result := Result + 't' else Result := Result + 'T' else + if Mode and S_IXOTH = S_IXOTH then Result := Result + 'x' else Result := Result + '-'; +end; + +(********************************************************************************************************************************) +function AttrToOctal(const Mode: Cardinal): integer; +var x, Mult: Cardinal; +begin + Result := 0; + Mult := 1; + x := Mode; + while x > 0 do begin + Result := Result + Integer((x mod 8) * Mult); + x := x div 8; + Mult := Mult * 10; + end; +end; + +(********************************************************************************************************************************) +function OctalToAttr(Octal: Cardinal): Cardinal; +var octnr, oct : Cardinal; +begin + octnr := 0; + oct := 0; + while (Octal > 0) do begin + oct := oct or ((Octal mod 10) shl octnr); + Octal := Octal div 10; + inc(octnr, 3); + end; + Result := oct; +end; + +(********************************************************************************************************************************) +function PosEnd(Substr: string; S: string): Integer; +var i : integer; +begin + Result := 0; + if (Length(Trim(S)) < 1) or (Length(Trim(Substr)) < 1) or (Length(Trim(Substr)) > Length(Trim(S))) then Exit; + for i := Length(S) - Length(SubStr) downto 1 do + if Copy(s, i, Length(Substr)) = SubStr then begin + Result := i; + Break; + end; +end; + +(********************************************************************************************************************************) +function GetHomePath: string; +begin + Result := PgcharToString(g_get_home_dir); +end; + +(********************************************************************************************************************************) +function GetUserName: string; +begin + Result := PgcharToString(g_get_user_name); +end; + +(********************************************************************************************************************************) +function GetHostName: string; +var s: PChar; +begin + s := Libc.malloc(65536); + Libc.memset(s, 0, 65536); + Libc.gethostname(s, 65536); + Result := PgcharToString(strdup(s)); + Libc.free(s); +end; + +(********************************************************************************************************************************) +procedure SeparateExt(const Original: string; var Name, Ext: string); +var j: integer; +begin + Ext := ''; + Name := Original; + if {(Pos('.', Original) > 1) and } (Length(Original) > 2) then begin + j := LastDelimiter('.', Original); + if (j > 1) and (j < Length(Original)) then begin + Ext := Copy(Original, j + 1, Length(Original) - j); + Delete(Name, j, Length(Name) - j + 1); + end; + end; +end; + +(********************************************************************************************************************************) +procedure SeparateNameDir(Original: string; var Path, FileName: string); +var j: integer; +begin + Original := ExcludeTrailingPathDelimiter(Original); + Path := Original; + FileName := ''; + if (Pos('/', Original) > 0) and (Length(Original) > 2) then begin + j := LastDelimiter('/', Original); + if j > 0 then begin + FileName := Copy(Original, j + 1, Length(Original) - j); + Delete(Path, j, Length(Original) - j + 1); + end; + end; +end; + +(********************************************************************************************************************************) +function PadRightStr(const Str: string; Len: byte): string; +var i: integer; +begin + Result := Str; + for i := 1 to Len - Length(Str) do Insert(' ', Result, 1); +end; + +(********************************************************************************************************************************) +function SearchNext(var Wilds: string): Integer; + +{ looking for next *, returns position and string until position } +begin + Result := Pos('*', Wilds); + if Result > 0 then Wilds := Copy(Wilds, 1, Result - 1); +end; + + +function FindPart(const HelpWilds, InputStr: string): Integer; + +{ FindPart compares a string with '?' and another, returns the position of HelpWilds in InputStr. } +var + I, J: Integer; + Diff: Integer; +begin + I := Pos('?', HelpWilds); + if I = 0 then begin + { if no '?' in HelpWilds } + Result := Pos(HelpWilds, InputStr); + Exit; + end; + { '?' in HelpWilds } + Diff := Length(InputStr) - Length(HelpWilds); + if Diff < 0 then begin + Result := 0; + Exit; + end; + { now move HelpWilds over InputStr } + for I := 0 to Diff do begin + for J := 1 to Length(HelpWilds) do begin + if (InputStr[I + J] = HelpWilds[J]) or + (HelpWilds[J] = '?') then + begin + if J = Length(HelpWilds) then begin + Result := I + 1; + Exit; + end; + end + else Break; + end; + end; + Result := 0; +end; + + +function IsWild(InputStr, Wilds: string; IgnoreCase: Boolean): Boolean; + +var + CWild, CInputWord: Integer; { counter for positions } + I, LenHelpWilds: Integer; + MaxInputWord, MaxWilds: Integer; { Length of InputStr and Wilds } + HelpWilds: string; +begin + if Wilds = InputStr then begin + Result := True; + Exit; + end; + repeat { delete '**', because '**' = '*' } + I := Pos('**', Wilds); + if I > 0 then + Wilds := Copy(Wilds, 1, I - 1) + '*' + Copy(Wilds, I + 2, MaxInt); + until I = 0; + if (Wilds = '*') or (Wilds = '*.*') then begin { for fast end, if Wilds only '*' } + Result := True; + Exit; + end; + MaxInputWord := Length(InputStr); + MaxWilds := Length(Wilds); + if IgnoreCase then begin { upcase all letters } + InputStr := AnsiUpperCase(InputStr); + Wilds := AnsiUpperCase(Wilds); + end; + if (MaxWilds = 0) or (MaxInputWord = 0) then begin + Result := False; + Exit; + end; + CInputWord := 1; + CWild := 1; + Result := True; + repeat + if InputStr[CInputWord] = Wilds[CWild] then begin { equal letters } + { goto next letter } + Inc(CWild); + Inc(CInputWord); + Continue; + end; + if Wilds[CWild] = '?' then begin { equal to '?' } + { goto next letter } + Inc(CWild); + Inc(CInputWord); + Continue; + end; + if Wilds[CWild] = '*' then begin { handling of '*' } + HelpWilds := Copy(Wilds, CWild + 1, MaxWilds); + I := SearchNext(HelpWilds); + LenHelpWilds := Length(HelpWilds); + if I = 0 then begin + { no '*' in the rest, compare the ends } + if HelpWilds = '' then Exit; { '*' is the last letter } + { check the rest for equal Length and no '?' } + {$R-} + for I := 0 to LenHelpWilds - 1 do begin + if (HelpWilds[LenHelpWilds - I] <> InputStr[MaxInputWord - I]) and + (HelpWilds[LenHelpWilds - I]<> '?') then + begin + Result := False; + Exit; + end; + end; + {$R+} + Exit; + end; + { handle all to the next '*' } + Inc(CWild, 1 + LenHelpWilds); + I := FindPart(HelpWilds, Copy(InputStr, CInputWord, MaxInt)); + if I = 0 then begin + Result := False; + Exit; + end; + CInputWord := I + LenHelpWilds; + Continue; + end; + Result := False; + Exit; + until (CInputWord > MaxInputWord) or (CWild > MaxWilds); + { no completed evaluation } + if CInputWord <= MaxInputWord then Result := False; + if (CWild <= MaxWilds) and (Wilds[MaxWilds] <> '*') then Result := False; +end; + + +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) + + +(********************************************************************************************************************************) +type TPatternCacheItem = record + Pattern, APath, FileName: string; + DirDidNotExist: boolean; + end; + +var PatternCache : array of TPatternCacheItem; + +function ProcessPattern(Engine: TPanelEngine; Pattern, APath, FileName: string; const Directory: boolean): string; +var Path : string; + + procedure ProcessParam(const Part: string); + begin + // Check for upper directory + if (Length(Part) >= 2) and (Copy(Part, 1, 2) = '..') then begin + if (Path <> '/') and (LastDelimiter('/', Path) > 1) then begin + Path := ExcludeTrailingPathDelimiter(Path); + Delete(Path, LastDelimiter('/', Path), Length(Path) - LastDelimiter('/', Path) + 1); + Path := IncludeTrailingPathDelimiter(Path); + end; + end else + if Part = '.' then begin end else // On current dir ('.') do nothing + // Add directory + Path := IncludeTrailingPathDelimiter(IncludeTrailingPathDelimiter(Path) + Part); + end; + + function ProcessPart(WildPart, FilePart: string): string; + var i, j, CWild, CInputWord, MaxInputWord, MaxWilds, LenHelpWilds: integer; + HelpWilds, s: string; + begin + Result := ''; + if (WildPart = '*') or (Length(WildPart) = 0) then Result := FilePart else + if LastDelimiter('*?', WildPart) = 0 then Result := WildPart else + begin + repeat { delete '**', because '**' = '*' } + I := Pos('**', WildPart); + if I > 0 then WildPart := Copy(WildPart, 1, I - 1) + '*' + Copy(WildPart, I + 2, MaxInt); + until I = 0; + MaxInputWord := Length(FilePart); + MaxWilds := Length(WildPart); + CInputWord := 1; + CWild := 1; + repeat + if not (WildPart[CWild] in ['?', '*']) then begin + Result := Result + WildPart[CWild]; + if WildPart[CWild] = FilePart[CInputWord] then Inc(CInputWord); + Inc(CWild); + Continue; + end; + if WildPart[CWild] = '?' then begin + if Length(FilePart) <= CWild then Result := Result + FilePart[CWild]; + Inc(CWild); + if Length(FilePart) < CWild then Inc(CInputWord); + Continue; + end; + if WildPart[CWild] = '*' then begin { handling of '*' } + HelpWilds := Copy(WildPart, CWild + 1, MaxWilds); + I := SearchNext(HelpWilds); + LenHelpWilds := Length(HelpWilds); + if (I = 0) and (HelpWilds = '') then begin + { no '*' in the rest, compare the ends } + Result := Result + Copy(FilePart, CInputWord, MaxInputWord - CInputWord + 1); + Break; { '*' is the last letter } + end; + if (I = 0) and (Pos('?', HelpWilds) = 0) then begin + Result := Result + Copy(FilePart, CInputWord, MaxInputWord - CInputWord + 1) + HelpWilds; + Break; + end; + s := Copy(FilePart, CInputWord, MaxInputWord - CInputWord + 1); + i := FindPart(HelpWilds, s); + if i = 0 then Result := Result + HelpWilds else + begin + for j := 1 to Length(HelpWilds) do + if HelpWilds[j] = '?' then HelpWilds[j] := s[j - 1 + i]; + Result := Result + Copy(s, 1, i + Length(HelpWilds) - 1); + Inc(CInputWord, i + LenHelpWilds - 1); + end; + Inc(CWild, 1 + LenHelpWilds); + Continue; + end; + Break; + until (CInputWord > MaxInputWord) or (CWild > MaxWilds); + end; + end; + + function ProcessWilds(WildStr, AFile: string): string; + var i, j, WPC, FPC: integer; + DotFile: boolean; + begin + if (WildStr = '*.*') or (WildStr = '') then Result := AFile else + if WildStr = '*' then begin + if (Pos('.', AFile) = 0) or (Copy(AFile, 1, 1) = '.') then Result := AFile else + Result := Copy(AFile, 1, LastDelimiter('.', AFile) - 1); + end else begin + Result := ''; + DotFile := False; + if (Length(AFile) > 0) and (AFile[1] = '.') then begin + DotFile := True; + Delete(AFile, 1, 1); + end; + // Trim redundant parameters + WPC := 0; + for i := 1 to Length(WildStr) do if WildStr[i] = '.' then Inc(WPC); + FPC := 0; + for i := 1 to Length(AFile) do if AFile[i] = '.' then Inc(FPC); + if WPC > FPC then + for j := 1 to WPC - FPC do begin + Result := '.' + Copy(WildStr, LastDelimiter('.', WildStr) + 1, Length(WildStr) - LastDelimiter('.', WildStr)) + Result; + Delete(WildStr, LastDelimiter('.', WildStr), Length(WildStr) - LastDelimiter('.', WildStr) + 1); + end; + // Going processing + while (LastDelimiter('.', WildStr) > 0) and (LastDelimiter('.', AFile) > 0) do begin + Result := '.' + ProcessPart(Copy(WildStr, LastDelimiter('.', WildStr) + 1, Length(WildStr) - LastDelimiter('.', WildStr)), + Copy(AFile, LastDelimiter('.', AFile) + 1, Length(AFile) - LastDelimiter('.', AFile))) + Result; + Delete(WildStr, LastDelimiter('.', WildStr), Length(WildStr) - LastDelimiter('.', WildStr) + 1); + Delete(AFile, LastDelimiter('.', AFile), Length(AFile) - LastDelimiter('.', AFile) + 1); + end; + if WildStr <> '' then Result := ProcessPart(WildStr, AFile) + Result; + if DotFile then Result := '.' + Result; + end; + // Trim unwanted characters + if Length(Result) > 0 then + for i := 1 to Length(Result) do + if Result[i] in ['*', '?', '/'] then Result[i] := '_'; + end; + + function FindInCache: integer; + var i: integer; + begin + Result := -1; + if LengtH(PatternCache) > 0 then + for i := 0 to Length(PatternCache) - 1 do + if (PatternCache[i].Pattern = Pattern) and (PatternCache[i].APath = APath) and (Pos(PatternCache[i].FileName, FileName) = 1) then + begin + Result := i; + Break; + end; + end; + + function CaseDirExists(DPath, DFileName: string): boolean; + begin + if (AnsiCompareStr(Pattern, FileName) <> 0) and (AnsiCompareText(Pattern, FileName) = 0) and Directory and + Engine.TwoSameFiles(DPath + Pattern, DPath + FileName) + then Result := False + else Result := Engine.DirectoryExists(DPath + DFileName); + end; + + + + +var s: string; + x: integer; +begin + Result := ''; + if Pattern = '' then Exit; + // Select basic directory + case Pattern[1] of + '/' : begin + Path := '/'; + if Length(Pattern) > 1 then Delete(Pattern, 1, 1); + end; + '~' : begin + Path := IncludeTrailingPathDelimiter(GetHomePath); + Delete(Pattern, 1, 1); + end; + else Path := IncludeTrailingPathDelimiter(APath); + end; + // Process directories in pattern + while Pos('/', Pattern) > 0 do begin + s := Copy(Pattern, 1, Pos('/', Pattern) - 1); + Delete(Pattern, 1, Pos('/', Pattern)); + ProcessParam(s); + end; + // Add rest of pattern parts + if (Pos('?', Pattern) = 0) and (Pos('*', Pattern) = 0) then begin + if (Pattern <> '.') and (Pattern <> '..') and (not CaseDirExists(IncludeTrailingPathDelimiter(Path), Pattern)) then begin + if Directory then Path := IncludeTrailingPathDelimiter(IncludeTrailingPathDelimiter(Path) + Pattern) + else Path := ExcludeTrailingPathDelimiter(IncludeTrailingPathDelimiter(Path) + Pattern); + SetLength(PatternCache, Length(PatternCache) + 1); + PatternCache[Length(PatternCache) - 1].Pattern := Pattern; + PatternCache[Length(PatternCache) - 1].APath := APath; + PatternCache[Length(PatternCache) - 1].FileName := FileName; + end else begin + if Length(Pattern) > 0 then ProcessParam(Pattern); + x := FindInCache; + if x < 0 then begin + Path := IncludeTrailingPathDelimiter(Path) + FileName; + end else begin + Delete(FileName, 1, Length(IncludeTrailingPathDelimiter(PatternCache[x].FileName))); + Path := IncludeTrailingPathDelimiter(Path) + FileName; + end; + if Directory then Path := IncludeTrailingPathDelimiter(Path) + else Path := ExcludeTrailingPathDelimiter(Path); + end; + end else Path := Path + ProcessWilds(Pattern, FileName); + + Result := Path; +end; + + +(********************************************************************************************************************************) +(********************************************************************************************************************************) +procedure ShowAbout; +const Authors : array[0..1] of PChar = ('Tomáš Bžatek <tbzatek@users.sourceforge.net>', nil); + Translations : PChar = 'Tomáš Bžatek <tbzatek@users.sourceforge.net> - English, Czech'#10 + + 'Maxim Baranov <maxbaranov@hotbox.ru> - Russian'#10 + + 'Sven Laufersweiler <laufersweiler@bettercad.de> - German'#10 + + 'Johan Åkesson <johan@badanka.com> - Swedish'#10 + + 'Marie-Agnès Pauchet-Le Héricy <marie@kerplh.com> - French'#10 + + 'Daniel Areiza <nnoseman@hotmail.com> - Spanish'#10 + + 'Dominik Zabłotny <dominz@wp.pl> - Polish'#10 + + 'Serhij Dubyk <dubyk@ukr.net> - Ukrainian'#10 + + 'Bojan Božović <bojanb@sbb.co.yu> - Serbian'#10 + + 'Marián Képesi <m_kepesi@yahoo.com> - Hungarian'#10 + + 'Francesco Turco <fctk86@gmail.com> - Italian'; +var AboutBox: PGtkWidget; +begin + if (libGnomeUI2Handle = nil) or (@gnome_about_new = nil) + then Application.MessageBox(Format(LANGAboutString, [ConstAboutVersion, ConstAboutBuildDate])) + else begin + AboutBox := gnome_about_new('Tux Commander', nil, 'Copyright © 2008 Tomáš Bžatek', + PChar(Format(LANGAboutStringGnome, [ConstAboutVersion, ConstAboutBuildDate])), + @Authors, nil, Translations, nil); + gtk_window_set_transient_for(GTK_WINDOW(AboutBox), GTK_WINDOW(FMain.FWidget)); + gtk_dialog_run(GTK_DIALOG(AboutBox)); + end; +end; + +(********************************************************************************************************************************) +procedure TrimCRLFESC(var s: string); +begin + while (Length(s) > 0) and (s[1] in [#13, #10, #27]) do Delete(s, 1, 1); + while (Length(s) > 0) and (s[Length(s)] in [#13, #10, #27]) do Delete(s, Length(s), 1); +end; + +(********************************************************************************************************************************) +procedure TrimQuotes(var s: string); +begin + while (Length(s) > 0) and (s[1] in ['"', '''']) do Delete(s, 1, 1); + while (Length(s) > 0) and (s[Length(s)] in ['"', '''']) do Delete(s, Length(s), 1); +end; + +(********************************************************************************************************************************) +function QuoteStr(const Str: string): string; +var i: integer; +begin + Result := ''; + if Length(Str) > 0 then + for i := 1 to Length(Str) do begin + if Str[i] in ConstQuotationCharacters then Result := Result + '\'; + Result := Result + Str[i]; + end; +end; + +(********************************************************************************************************************************) +function QuotePercentStr(const Str: string): string; +var i: integer; +begin + Result := ''; + if Length(Str) > 0 then + for i := 1 to Length(Str) do begin + if Str[i] = '%' then Result := Result + '%'; + Result := Result + Str[i]; + end; +end; + +(********************************************************************************************************************************) +function QuoteMarkupStr(const Str: string): string; +var i: integer; +begin + Result := ''; + if Length(Str) > 0 then + for i := 1 to Length(Str) do begin + if Str[i] = '<' then Result := Result + '<' else + if Str[i] = '>' then Result := Result + '>' else + if Str[i] = '&' then Result := Result + '&' else +// if Str[i] = '_' then Result := Result + '__' else + Result := Result + Str[i]; + end; +end; + +(********************************************************************************************************************************) +function RemoveQuotation(const Str: string): string; +var b: boolean; + i: integer; +begin + Result := Str; + if Length(Result) < 2 then Exit; + b := True; + for i := 2 to Length(Result) do + if (Result[i] in ConstQuotationCharacters) and (Result[i - 1] <> '\') then b := False; + if b then for i := Length(Result) downto 2 do + if (Result[i] in ConstQuotationCharacters) and (Result[i - 1] = '\') then Delete(Result, i - 1, 1); +end; + +(********************************************************************************************************************************) +function ReplaceStr(const S, Srch, Replace: string): string; +var + I: Integer; + Source: string; +begin + Source := S; + Result := ''; + repeat + I := Pos(Srch, Source); + if I > 0 then begin + Result := Result + Copy(Source, 1, I - 1) + Replace; + Source := Copy(Source, I + Length(Srch), MaxInt); + end + else Result := Result + Source; + until I <= 0; +end; + +(********************************************************************************************************************************) +function NumCountChars(const Char: char; const S: string): integer; +var i: integer; +begin + Result := 0; + if Length(S) > 0 then + for i := 1 to Length(S) do + if S[i] = Char then Inc(Result); +end; + +(********************************************************************************************************************************) +procedure ParseString(const Str, Separator: string; var SubStrings: TOpenStringArray); +var s: string; + i: integer; +begin + s := Str; + while Pos(Separator, s) > 0 do begin + i := Pos(Separator, s); + SetLength(SubStrings, Length(SubStrings) + 1); + SubStrings[Length(SubStrings) - 1] := Copy(s, 1, i - 1); + Delete(s, 1, i); + end; + if Length(s) > 0 then begin // Add the last element + SetLength(SubStrings, Length(SubStrings) + 1); + SubStrings[Length(SubStrings) - 1] := s; + end; +end; + +(********************************************************************************************************************************) +function GetStrSize(s: string): Int64; +var i: integer; + x: Double; + b: boolean; +begin + Result := 0; + x := 0; + s := AnsiUpperCase(Trim(s)); + if Length(s) = 0 then Exit; + for i := Length(s) downto 1 do + if s[i] in [#32, ThousandSeparator] then Delete(s, i, 1); + b := False; + for i := 2 to Length(s) do + if not (s[i] in ['0', '1'..'9', DecimalSeparator]) then + begin + x := StrToFloatDef(Copy(s, 1, i - 1), 0); + case s[i] of + 'G': x := x * 1000 * 1000 * 1000; + 'M': x := x * 1000 * 1000; + 'K': x := x * 1024; + end; + b := True; + Break; + end; + if not b then x := StrToInt64Def(s, Trunc(x)); + Result := Trunc(x); +end; + +(********************************************************************************************************************************) +function ConstructURI(HidePasswd: boolean; Protocol, Server, Username, Password, Dir: string): string; +begin + Result := Protocol + '://'; + if Length(Username) > 0 then begin + Result := Result + Username; + if Length(Password) > 0 then + if HidePasswd then Result := Result + ':' + StringOfChar('*', Length(Password)) + else Result := Result + ':' + Password; + Result := Result + '@'; + end; + Result := Result + Server; + if Length(Dir) > 0 then begin + if Dir[1] <> '/' then Result := Result + '/'; + Result := Result + Dir; + end; +end; + +(********************************************************************************************************************************) +function URIHidePassword(const SrcURI: string): string; +var i: integer; + InPasswd, BeforeServer: boolean; +begin + Result := SrcURI; + InPasswd := False; + BeforeServer := True; + if Length(SrcURI) > 0 then + if Pos('://', SrcURI) > 0 then + for i := Pos('://', SrcURI) + 2 to Length(SrcURI) do begin + if SrcURI[i] = '@' then begin + InPasswd := False; + BeforeServer := False; + end; + if (not InPasswd) or (not BeforeServer) + then InPasswd := BeforeServer and (SrcURI[i] = ':') + else Result[i] := '*'; + end; +end; + +(********************************************************************************************************************************) +procedure DebugMsg(Params: array of const); +var + I: Integer; +begin + if ParamDebug then begin + for I := 0 to High(Params) do + with Params[I] do + case VType of + vtInteger: Write(ErrOutput, IntToStr(VInteger)); + vtBoolean: Write(ErrOutput, VBoolean); + vtChar: Write(ErrOutput, VChar); + vtExtended: Write(ErrOutput, FloatToStr(VExtended^)); + vtString: Write(ErrOutput, VString^); + vtPChar: Write(ErrOutput, VPChar); + vtObject: Write(ErrOutput, VObject.ClassName); + vtClass: Write(ErrOutput, VClass.ClassName); + vtAnsiString: Write(ErrOutput, string(VAnsiString)); + vtCurrency: Write(ErrOutput, CurrToStr(VCurrency^)); + vtVariant: Write(ErrOutput, string(VVariant^)); + vtInt64: Write(ErrOutput, IntToStr(VInt64^)); + end; + WriteLn(ErrOutput); + end; +end; + +(********************************************************************************************************************************) +function SpawnProcess(const AppPath: string; var Running: boolean; const Parameters: array of string): Cardinal; +var child_pid: __pid_t; + args_list: System.PPChar; + i: integer; + Temp: string; + sv: sigval_t; +begin + Result := 0; + Running := False; + ChildExitStatus := -1; + + // Make the args_list array + args_list := nil; + if Length(Parameters) > 0 then begin + args_list := Libc.malloc((Length(Parameters) + 1) * SizeOf(PChar)); + Libc.memset(args_list, 0, (Length(Parameters) + 1) * SizeOf(PChar)); + for I := 0 to Length(Parameters) - 1 do + begin + Temp := Parameters[i]; + {$R-} +// PCharArray(args_list^)[I] := Libc.malloc(Length(Temp)+1); +// Libc.memset(PCharArray(args_list^)[I], 0, Length(Temp)+1); +// StrCopy(PCharArray(args_list^)[I], PChar(Temp)); + PCharArray(args_list^)[I] := strdup(PChar(Temp)); + {$R+} + end; + {$R-} + PCharArray(args_list^)[Length(Parameters)] := nil; + {$R+} + end; + + // Duplicate this process + child_pid := fork; + if child_pid <> 0 then begin + Result := child_pid; + Sleep(100); + Application.ProcessMessages; + Running := ChildExitStatus < 0; + if not Running then Result := 0; + if not WIFEXITED(ChildExitStatus) then Result := WTERMSIG(ChildExitStatus); + end else begin + // Now execute AppPath, searching for it in the path + execvp(PChar(AppPath), args_list); + // The execvp function returns only if an error occurs + sigqueue(getppid, SIGUSR1, sv); + Halt(ConstERRSpawn); + end; + ChildExitStatus := -1; +end; + +(********************************************************************************************************************************) +procedure SplitArgs(var Args: TOpenStringArray; CMDLine: string); +var InQuotes: boolean; + i, Start: integer; + QuoteChar: char; + s: string; +begin + SetLength(Args, 0); + InQuotes := False; + CMDLine := Trim(CMDLine); + if Length(CMDLine) = 0 then Exit; + Start := 1; + QuoteChar := #0; + for i := 1 to Length(CMDLine) do + case CMDLine[i] of + ' ': if (not InQuotes) and ((i = 1) or (CMDLine[i - 1] <> '\')) then begin + s := Trim(Copy(CMDLine, Start, i - Start)); + TrimQuotes(s); + Start := i; + if s = '' then Continue; + SetLength(Args, Length(Args) + 1); + Args[Length(Args) - 1] := s; + end; + '"', '''': if (i = 1) or (CMDLine[i - 1] <> '\') then + if not InQuotes then begin + InQuotes := True; + QuoteChar := CMDLine[i]; +// Start := i; + end else + if CMDLine[i] = QuoteChar then begin + InQuotes := False; + s := Trim(Copy(CMDLine, Start, i + 1 - Start)); + TrimQuotes(s); + Start := i; + if s = '' then Continue; + if (Pos('"', s) > 1) and (Pos('"', s) < Length(s)) and (NumCountChars('"', s) mod 2 = 1) then s := s + '"'; +// if (Pos('''', s) > 1) and (Pos('''', s) < Length(s)) and (NumCountChars('''', s) mod 2 = 1) then s := s + ''''; + SetLength(Args, Length(Args) + 1); + Args[Length(Args) - 1] := s; + end; + end; + if (Start <> Length(CMDLine)) or (Start = 1) then begin + SetLength(Args, Length(Args) + 1); + Args[Length(Args) - 1] := Trim(Copy(CMDLine, Start, Length(CMDLine) + 1 - Start)); + TrimQuotes(Args[Length(Args) - 1]); + end; +end; + +function ExecuteProgram(const AppCMDLine, CWD: string; const AutodetectGUI, RunInTerminal: boolean; var ErrorSignal: integer): boolean; +var Args: TOpenStringArray; + s, s2: string; + Running, Term: boolean; + x: integer; +begin + Result := False; + try + DebugMsg(['*** Running ExecuteProgram begin']); + s := Trim(AppCMDLine); + ErrorSignal := 0; + Term := RunInTerminal; + SplitArgs(Args, s); + + if AutodetectGUI then + if Length(Trim(Args[0])) > 0 then Term := not IsItX11App(Trim(Args[0])); + + if Term then begin + x := 1; + while x <= Length(s) do begin + if (s[x] in [{'"',} '''']) and ((x = 1) or (s[x - 1] <> '\')) then + Insert('\', s, x); + Inc(x); + end; + s2 := ReplaceStr(ConfTerminalCommand, '%cwd', QuoteStr(CWD)); + s := Format(s2, [s]); + SplitArgs(Args, s); + end; + + if ConfUseLibcSystem then begin + s := s + ' &'; + DebugMsg([s]); + DebugMsg(['**** Running libc.system']); + x := Libc.system(PChar(s)); + Result := x <> -1; // -1 means fork failed + DebugMsg(['**** Running libc.system = ', x, ' --- done']); + end else begin + if Length(Args) = 0 then Exit; + for x := 0 to Length(Args) - 1 do Args[x] := RemoveQuotation(Args[x]); + DebugMsg(['**** Running spawn']); + x := SpawnProcess(Args[0], Running, Args); + DebugMsg(['**** Running spawn -- done']); + Result := Running; + if not Running then ErrorSignal := x; + end; + + except + end; + DebugMsg(['*** Running ExecuteProgram end']); +end; + +(********************************************************************************************************************************) +function IsItX11App(const Application: string): boolean; +const BSize = 32768; + What = 'libX11.so'; +var stream: PIOFile; + Buffer: Pointer; + i: integer; + str: string; +begin + Result := False; + DebugMsg(['***** function IsItX11App(''', Application, ''') begin --']); + + try +// setenv('LD_TRACE_LOADED_OBJECTS', '1', True); + stream := popen(PChar('LD_TRACE_LOADED_OBJECTS=1 ' + Application), 'r'); +// stream := popen(PChar(Application), 'r'); + DebugMsg(['***** IsItX11App: popen OK']); + if Assigned(stream) then begin + Buffer := Libc.malloc(BSize); + if buffer = nil then Writeln('buffer nil: ', integer(errno)); + if stream = nil then Writeln('stream nil'); + Libc.memset(Buffer, 0, BSize); + DebugMsg(['***** IsItX11App: malloc() OK']); + + while feof(stream) = 0 do begin + i := Libc.fread(Buffer, 1, BSize, stream); + if i > 0 then begin + SetLength(str, i); + memcpy(@str[1], Buffer, i); + Result := Result or (Pos(What, str) > 0); + end; + end; + pclose(stream); + end; +// unsetenv('LD_TRACE_LOADED_OBJECTS'); + + except + on E: Exception do DebugMsg(['*** IsItX11App(''', Application, '''):Exception: ', E.Message]); + end; + DebugMsg(['***** function IsItX11App(''', Application, ''') = ', Result]); +end; + +function HandleSystemCommand(const Command, ErrorText: string): boolean; +const BSize = 32768; +var stream: PIOFile; + Buffer: Pointer; + i, NumRead: integer; + child_pid: __pid_t; + fds: array[0..1] of integer; + Parameters: TOpenStringArray; + args_list: System.PPChar; + Temp, s: string; +begin + Result := False; + DebugMsg(['***** function HandleSystemCommand(''', Command, ''') begin --']); + + try + DebugMsg(['***** HandleSystemCommand: before fork']); + pipe(@fds); + child_pid := fork; + DebugMsg(['***** HandleSystemCommand: fork, child_pid = ', child_pid]); + + + // Main application + if child_pid <> 0 then begin + __close(fds[1]); + stream := fdopen(fds[0], 'r'); + Buffer := Libc.malloc(BSize); + DebugMsg(['x0']); + Libc.memset(Buffer, 0, BSize); + DebugMsg(['x1']); + if buffer = nil then Writeln('buffer nil: ', integer(errno)); + if stream = nil then Writeln('stream nil'); + + SetLength(s, 0); + while feof(stream) = 0 do begin + NumRead := fread(Buffer, 1, BSize, stream); + DebugMsg(['***** HandleSystemCommand: NumRead = ', NumRead]); + if NumRead > 0 then begin + SetLength(s, Length(s) + NumRead); + memcpy(@s[Length(s) - NumRead + 1], Buffer, NumRead); + end; + end; + __close(fds[0]); + DebugMsg(['x2']); + TrimCRLFESC(s); + DebugMsg(['x3']); + + Libc.free(Buffer); + DebugMsg(['x4']); + end + + // forked PID + else begin + try + SplitArgs(Parameters, Command); + // Fill the args_list array + args_list := nil; + if Length(Parameters) > 0 then begin + args_list := Libc.malloc((Length(Parameters) + 1) * SizeOf(PChar)); + Libc.memset(args_list, 0, (Length(Parameters) + 1) * SizeOf(PChar)); + for I := 0 to Length(Parameters) - 1 do + begin + Temp := Parameters[i]; + {$R-} +// PCharArray(args_list^)[I] := Libc.malloc(Length(Temp)+1); +// Libc.memset(PCharArray(args_list^)[I], 0, Length(Temp)+1); +// StrCopy(PCharArray(args_list^)[I], PChar(Temp)); + PCharArray(args_list^)[I] := strdup(PChar(Temp)); + {$R+} + end; + {$R-} + PCharArray(args_list^)[Length(Parameters)] := nil; + {$R+} + end; + except + on E: Exception do DebugMsg(['*** forked ** function HandleSystemCommand(''', Command, '''):Exception: ', E.Message]); + end; + + __close(fds[0]); // Close copy of reader file descriptor + dup2(fds[1], STDERR_FILENO); + execvp(PChar(Parameters[0]), args_list); + DebugMsg(['***** HandleSystemCommand: failed execvp: something went wrong...']); + WriteLn(erroutput, 'Error executing command'); + Halt(ConstERRSpawn); + end; + + Result := Length(s) = 0; + if not Result then Application.MessageBox(Format('%s%s', [ErrorText, ANSIToUTF8(s)]), [mbOK], mbError, mbOK, mbOK); + except + on E: Exception do DebugMsg(['***** function HandleSystemCommand(''', Command, '''):Exception: ', E.Message]); + end; + DebugMsg(['***** finished function HandleSystemCommand(''', Command, ''') = ', Result]); +end; + + +(********************************************************************************************************************************) +function CompareTextsEx(S1, S2: PChar): integer; +const PriorityChars = '.[]_0123456789'; +var i, j, k, l1, l2 : integer; + Str1, Str2: string; +begin + Result := -2; + Str1 := UpperCase(String(S1)); + Str2 := UpperCase(String(S2)); + l1 := Length(Str1); + l2 := Length(Str2); + if (l1 > 0) and (l2 > 0) then begin + if (Str1[1] = '.') and (Str2[1] <> '.') then Result := -1 else // Priority for dot files + if (Str2[1] = '.') and (Str1[1] <> '.') then Result := 1 else + for i := 1 to l1 do + if l2 >= i then + if Str1[i] <> Str2[i] then begin + j := Pos(Str1[i], PriorityChars); + k := Pos(Str2[i], PriorityChars); + if (j > 0) and (k > 0) then begin + if j < k then Result := -1 else + if j > k then Result := 1; + end else + if j > 0 then Result := -1 else + if k > 0 then Result := 1; + Break; + end; + if Result = -2 then Result := CompareText(Str1, Str2); + end else Result := CompareText(Str1, Str2); +end; + +(********************************************************************************************************************************) +function LVCompareItems(Data1, Data2: PDataItem; const Ascending: boolean; const SortColumnID: integer): integer; +var mp: integer; + s1, s2, s3, s4: string; +begin + if Ascending then mp := 1 else mp := -1; + if Data1^.UpDir then Result := -1*mp else + if Data2^.UpDir then Result := 1*mp else + if Data1^.IsDir and (not Data2^.IsDir) then Result := -1*mp else + if Data2^.IsDir and (not Data1^.IsDir) then Result := 1*mp else + case SortColumnID of + 1, 2 : begin + Result := CompareTextsEx(Data1^.AName, Data2^.AName); + if Data1^.IsDir and Data2^.IsDir then Result := Result * mp; + end; + 3 : if Data1^.IsDir and Data2^.IsDir then Result := CompareTextsEx(Data1^.AName, Data2^.AName)*mp else begin + SeparateExt(String(Data1^.AName), s1, s2); + SeparateExt(String(Data2^.AName), s3, s4); + if ANSIUpperCase(s2) <> ANSIUpperCase(s4) + then Result := CompareTextsEx(PChar(s2), PChar(s4)) + else Result := CompareTextsEx(PChar(s1), PChar(s3)); + end; + 4 : if Data1^.IsDir and Data2^.IsDir then Result := CompareTextsEx(Data1^.AName, Data2^.AName)*mp else + if Data1^.Size > Data2^.Size then Result := -1 else + if Data1^.Size < Data2^.Size then Result := 1 else + Result := CompareTextsEx(Data1^.AName, Data2^.AName); + 5, 6 : if Data1^.IsDir and Data2^.IsDir then Result := CompareTextsEx(Data1^.AName, Data2^.AName)*mp else + if Data1^.ModifyTime > Data2^.ModifyTime then Result := -1 else + if Data1^.ModifyTime < Data2^.ModifyTime then Result := 1 else + Result := CompareTextsEx(Data1^.AName, Data2^.AName); + 7 : if Data1^.IsDir and Data2^.IsDir then Result := CompareTextsEx(Data1^.AName, Data2^.AName)*mp else + if Frac(Data1^.ModifyTime) > Frac(Data2^.ModifyTime) then Result := -1 else + if Frac(Data1^.ModifyTime) < Frac(Data2^.ModifyTime) then Result := 1 else + Result := CompareTextsEx(Data1^.AName, Data2^.AName); + 8 : if Data1^.IsDir and Data2^.IsDir then Result := CompareTextsEx(Data1^.AName, Data2^.AName)*mp else + if Data1^.UID > Data2^.UID then Result := -1 else + if Data1^.UID < Data2^.UID then Result := 1 else + Result := CompareTextsEx(Data1^.AName, Data2^.AName); + 9 : if Data1^.IsDir and Data2^.IsDir then Result := CompareTextsEx(Data1^.AName, Data2^.AName)*mp else + if Data1^.GID > Data2^.GID then Result := -1 else + if Data1^.GID < Data2^.GID then Result := 1 else + Result := CompareTextsEx(Data1^.AName, Data2^.AName); + 10 : if Data1^.IsDir and Data2^.IsDir then Result := CompareTextsEx(Data1^.AName, Data2^.AName)*mp else + if Data1^.Mode > Data2^.Mode then Result := -1 else + if Data1^.Mode < Data2^.Mode then Result := 1 else + Result := CompareTextsEx(Data1^.AName, Data2^.AName); + else Result := 0; + end; +end; + +(********************************************************************************************************************************) +procedure SortDataList(var List: TList; const Ascending: boolean; const SortColumnID: integer); +var AscCorr: integer; + + procedure QuickSort(iLo, iHi: Integer); + var Lo, Hi : Integer; + Mid, x: Pointer; + begin + Lo := iLo; + Hi := iHi; + Mid := List[(Lo + Hi) div 2]; + repeat + while LVCompareItems(List[Lo], Mid, Ascending, SortColumnID)*AscCorr < 0 do Inc(Lo); + while LVCompareItems(List[Hi], Mid, Ascending, SortColumnID)*AscCorr > 0 do Dec(Hi); + if Lo <= Hi then begin + x := List[Lo]; + List[Lo] := List[Hi]; + List[Hi] := x; + Inc(Lo); + Dec(Hi); + end; + until Lo > Hi; + if Hi > iLo then QuickSort(iLo, Hi); + if Lo < iHi then QuickSort(Lo, iHi); + end; + +begin + AscCorr := 2*Ord(Ascending) - 1; + QuickSort(0, List.Count - 1); +end; + +(********************************************************************************************************************************) +{$IFDEF CPU64} +function CRC32(CRC: LongWord; Data: Pointer; DataSize: LongWord): LongWord; +begin + Result := 0; +end; +{$ELSE} +function CRC32(CRC: LongWord; Data: Pointer; DataSize: LongWord): LongWord; assembler; +asm + AND EDX,EDX + JZ @Exit + AND ECX,ECX + JLE @Exit + PUSH EBX + PUSH EDI + XOR EBX,EBX + LEA EDI,CS:[OFFSET @CRC32] +@Start: MOV BL,AL + SHR EAX,8 + XOR BL,[EDX] + XOR EAX,[EDI + EBX * 4] + INC EDX + DEC ECX + JNZ @Start + POP EDI + POP EBX +@Exit: RET + DB 0, 0, 0, 0, 0 // Align Table +@CRC32: DD 000000000h, 077073096h, 0EE0E612Ch, 0990951BAh + DD 0076DC419h, 0706AF48Fh, 0E963A535h, 09E6495A3h + DD 00EDB8832h, 079DCB8A4h, 0E0D5E91Eh, 097D2D988h + DD 009B64C2Bh, 07EB17CBDh, 0E7B82D07h, 090BF1D91h + DD 01DB71064h, 06AB020F2h, 0F3B97148h, 084BE41DEh + DD 01ADAD47Dh, 06DDDE4EBh, 0F4D4B551h, 083D385C7h + DD 0136C9856h, 0646BA8C0h, 0FD62F97Ah, 08A65C9ECh + DD 014015C4Fh, 063066CD9h, 0FA0F3D63h, 08D080DF5h + DD 03B6E20C8h, 04C69105Eh, 0D56041E4h, 0A2677172h + DD 03C03E4D1h, 04B04D447h, 0D20D85FDh, 0A50AB56Bh + DD 035B5A8FAh, 042B2986Ch, 0DBBBC9D6h, 0ACBCF940h + DD 032D86CE3h, 045DF5C75h, 0DCD60DCFh, 0ABD13D59h + DD 026D930ACh, 051DE003Ah, 0C8D75180h, 0BFD06116h + DD 021B4F4B5h, 056B3C423h, 0CFBA9599h, 0B8BDA50Fh + DD 02802B89Eh, 05F058808h, 0C60CD9B2h, 0B10BE924h + DD 02F6F7C87h, 058684C11h, 0C1611DABh, 0B6662D3Dh + DD 076DC4190h, 001DB7106h, 098D220BCh, 0EFD5102Ah + DD 071B18589h, 006B6B51Fh, 09FBFE4A5h, 0E8B8D433h + DD 07807C9A2h, 00F00F934h, 09609A88Eh, 0E10E9818h + DD 07F6A0DBBh, 0086D3D2Dh, 091646C97h, 0E6635C01h + DD 06B6B51F4h, 01C6C6162h, 0856530D8h, 0F262004Eh + DD 06C0695EDh, 01B01A57Bh, 08208F4C1h, 0F50FC457h + DD 065B0D9C6h, 012B7E950h, 08BBEB8EAh, 0FCB9887Ch + DD 062DD1DDFh, 015DA2D49h, 08CD37CF3h, 0FBD44C65h + DD 04DB26158h, 03AB551CEh, 0A3BC0074h, 0D4BB30E2h + DD 04ADFA541h, 03DD895D7h, 0A4D1C46Dh, 0D3D6F4FBh + DD 04369E96Ah, 0346ED9FCh, 0AD678846h, 0DA60B8D0h + DD 044042D73h, 033031DE5h, 0AA0A4C5Fh, 0DD0D7CC9h + DD 05005713Ch, 0270241AAh, 0BE0B1010h, 0C90C2086h + DD 05768B525h, 0206F85B3h, 0B966D409h, 0CE61E49Fh + DD 05EDEF90Eh, 029D9C998h, 0B0D09822h, 0C7D7A8B4h + DD 059B33D17h, 02EB40D81h, 0B7BD5C3Bh, 0C0BA6CADh + DD 0EDB88320h, 09ABFB3B6h, 003B6E20Ch, 074B1D29Ah + DD 0EAD54739h, 09DD277AFh, 004DB2615h, 073DC1683h + DD 0E3630B12h, 094643B84h, 00D6D6A3Eh, 07A6A5AA8h + DD 0E40ECF0Bh, 09309FF9Dh, 00A00AE27h, 07D079EB1h + DD 0F00F9344h, 08708A3D2h, 01E01F268h, 06906C2FEh + DD 0F762575Dh, 0806567CBh, 0196C3671h, 06E6B06E7h + DD 0FED41B76h, 089D32BE0h, 010DA7A5Ah, 067DD4ACCh + DD 0F9B9DF6Fh, 08EBEEFF9h, 017B7BE43h, 060B08ED5h + DD 0D6D6A3E8h, 0A1D1937Eh, 038D8C2C4h, 04FDFF252h + DD 0D1BB67F1h, 0A6BC5767h, 03FB506DDh, 048B2364Bh + DD 0D80D2BDAh, 0AF0A1B4Ch, 036034AF6h, 041047A60h + DD 0DF60EFC3h, 0A867DF55h, 0316E8EEFh, 04669BE79h + DD 0CB61B38Ch, 0BC66831Ah, 0256FD2A0h, 05268E236h + DD 0CC0C7795h, 0BB0B4703h, 0220216B9h, 05505262Fh + DD 0C5BA3BBEh, 0B2BD0B28h, 02BB45A92h, 05CB36A04h + DD 0C2D7FFA7h, 0B5D0CF31h, 02CD99E8Bh, 05BDEAE1Dh + DD 09B64C2B0h, 0EC63F226h, 0756AA39Ch, 0026D930Ah + DD 09C0906A9h, 0EB0E363Fh, 072076785h, 005005713h + DD 095BF4A82h, 0E2B87A14h, 07BB12BAEh, 00CB61B38h + DD 092D28E9Bh, 0E5D5BE0Dh, 07CDCEFB7h, 00BDBDF21h + DD 086D3D2D4h, 0F1D4E242h, 068DDB3F8h, 01FDA836Eh + DD 081BE16CDh, 0F6B9265Bh, 06FB077E1h, 018B74777h + DD 088085AE6h, 0FF0F6A70h, 066063BCAh, 011010B5Ch + DD 08F659EFFh, 0F862AE69h, 0616BFFD3h, 0166CCF45h + DD 0A00AE278h, 0D70DD2EEh, 04E048354h, 03903B3C2h + DD 0A7672661h, 0D06016F7h, 04969474Dh, 03E6E77DBh + DD 0AED16A4Ah, 0D9D65ADCh, 040DF0B66h, 037D83BF0h + DD 0A9BCAE53h, 0DEBB9EC5h, 047B2CF7Fh, 030B5FFE9h + DD 0BDBDF21Ch, 0CABAC28Ah, 053B39330h, 024B4A3A6h + DD 0BAD03605h, 0CDD70693h, 054DE5729h, 023D967BFh + DD 0B3667A2Eh, 0C4614AB8h, 05D681B02h, 02A6F2B94h + DD 0B40BBE37h, 0C30C8EA1h, 05A05DF1Bh, 02D02EF8Dh + DD 074726F50h, 0736E6F69h, 0706F4320h, 067697279h + DD 028207468h, 031202963h, 020393939h, 048207962h + DD 06E656761h, 064655220h, 06E616D64h, 06FBBA36Eh +end; +{$ENDIF} +(********************************************************************************************************************************) +constructor THash_MD5.Create; +begin + Init; +end; + +function THash_MD5.DigestKey: string; +type TCharArray = array[1..40] of char; + PCharArray = ^TCharArray; +begin + Result := Copy(PCharArray(@FDigest)^, 1, 16); +end; + +procedure THash_MD5.Init; +begin + FillChar(FBuffer, SizeOf(FBuffer), 0); + FDigest[0] := $67452301; + FDigest[1] := $EFCDAB89; + FDigest[2] := $98BADCFE; + FDigest[3] := $10325476; + FDigest[4] := $C3D2E1F0; + FCount := 0; +end; + +{$R-} +procedure THash_MD5.Done; +var + I: Integer; + S: Int64; +begin + try + I := FCount and $3F; + FBuffer[I] := $80; + Inc(I); + if I > 64 - 8 then + begin + FillChar(FBuffer[I], 64 - I, 0); + Transform(@FBuffer); + I := 0; + end; + FillChar(FBuffer[I], 64 - I, 0); + S := Int64(FCount) * 8; + Move(S, FBuffer[64 - 8], SizeOf(S)); + Transform(@FBuffer); + FillChar(FBuffer, SizeOf(FBuffer), 0); + except + end; +end; + +procedure THash_MD5.Calc(const Data; DataSize: Integer); +var + Index: Integer; + P: PChar; +begin + if DataSize <= 0 then Exit; + Index := FCount and $3F; + Inc(FCount, DataSize); + if Index > 0 then + begin + if DataSize < 64 - Index then + begin + Move(Data, FBuffer[Index], DataSize); + Exit; + end; + Move(Data, FBuffer[Index], 64 - Index); + Transform(@FBuffer); + Index := 64 - Index; + Dec(DataSize, Index); + end; + P := @TByteArray(Data)[Index]; + Inc(Index, DataSize and not $3F); + while DataSize >= 64 do + begin + Transform(Pointer(P)); + Inc(P, 64); + Dec(DataSize, 64); + end; + Move(TByteArray(Data)[Index], FBuffer, DataSize); +end; +{$R+} + +function THash_MD5.GetKeyStrH: string; +const HexTable = '0123456789ABCDEF'; +var i: integer; + Value: string; +begin + Result := ''; + Value := DigestKey; + if Value = '' then Exit; + for i := 1 to Length(Value) do + Result := Result + HexTable[Byte(Value[i]) shr 4 + 1] + HexTable[Byte(Value[i]) and $F + 1]; +end; + +{$IFDEF CPU64} +function THash_MD5.TestVector: Pointer; +begin + Result := nil; +end; +{$ELSE} +function THash_MD5.TestVector: Pointer; +asm + MOV EAX,OFFSET @Vector + RET +@Vector: DB 03Eh,0D8h,034h,08Ch,0D2h,0A4h,045h,0D6h + DB 075h,05Dh,04Bh,0C9h,0FEh,0DCh,0C2h,0C6h +end; +{$ENDIF} + +{$Q-} +procedure THash_MD5.Transform(Buffer: PIntArray); +var + A, B, C, D: LongWord; +begin + A := FDigest[0]; + B := FDigest[1]; + C := FDigest[2]; + D := FDigest[3]; + + Inc(A, Buffer[ 0] + $D76AA478 + (D xor (B and (C xor D)))); A := A shl 7 or A shr 25 + B; + Inc(D, Buffer[ 1] + $E8C7B756 + (C xor (A and (B xor C)))); D := D shl 12 or D shr 20 + A; + Inc(C, Buffer[ 2] + $242070DB + (B xor (D and (A xor B)))); C := C shl 17 or C shr 15 + D; + Inc(B, Buffer[ 3] + $C1BDCEEE + (A xor (C and (D xor A)))); B := B shl 22 or B shr 10 + C; + Inc(A, Buffer[ 4] + $F57C0FAF + (D xor (B and (C xor D)))); A := A shl 7 or A shr 25 + B; + Inc(D, Buffer[ 5] + $4787C62A + (C xor (A and (B xor C)))); D := D shl 12 or D shr 20 + A; + Inc(C, Buffer[ 6] + $A8304613 + (B xor (D and (A xor B)))); C := C shl 17 or C shr 15 + D; + Inc(B, Buffer[ 7] + $FD469501 + (A xor (C and (D xor A)))); B := B shl 22 or B shr 10 + C; + Inc(A, Buffer[ 8] + $698098D8 + (D xor (B and (C xor D)))); A := A shl 7 or A shr 25 + B; + Inc(D, Buffer[ 9] + $8B44F7AF + (C xor (A and (B xor C)))); D := D shl 12 or D shr 20 + A; + Inc(C, Buffer[10] + $FFFF5BB1 + (B xor (D and (A xor B)))); C := C shl 17 or C shr 15 + D; + Inc(B, Buffer[11] + $895CD7BE + (A xor (C and (D xor A)))); B := B shl 22 or B shr 10 + C; + Inc(A, Buffer[12] + $6B901122 + (D xor (B and (C xor D)))); A := A shl 7 or A shr 25 + B; + Inc(D, Buffer[13] + $FD987193 + (C xor (A and (B xor C)))); D := D shl 12 or D shr 20 + A; + Inc(C, Buffer[14] + $A679438E + (B xor (D and (A xor B)))); C := C shl 17 or C shr 15 + D; + Inc(B, Buffer[15] + $49B40821 + (A xor (C and (D xor A)))); B := B shl 22 or B shr 10 + C; + + Inc(A, Buffer[ 1] + $F61E2562 + (C xor (D and (B xor C)))); A := A shl 5 or A shr 27 + B; + Inc(D, Buffer[ 6] + $C040B340 + (B xor (C and (A xor B)))); D := D shl 9 or D shr 23 + A; + Inc(C, Buffer[11] + $265E5A51 + (A xor (B and (D xor A)))); C := C shl 14 or C shr 18 + D; + Inc(B, Buffer[ 0] + $E9B6C7AA + (D xor (A and (C xor D)))); B := B shl 20 or B shr 12 + C; + Inc(A, Buffer[ 5] + $D62F105D + (C xor (D and (B xor C)))); A := A shl 5 or A shr 27 + B; + Inc(D, Buffer[10] + $02441453 + (B xor (C and (A xor B)))); D := D shl 9 or D shr 23 + A; + Inc(C, Buffer[15] + $D8A1E681 + (A xor (B and (D xor A)))); C := C shl 14 or C shr 18 + D; + Inc(B, Buffer[ 4] + $E7D3FBC8 + (D xor (A and (C xor D)))); B := B shl 20 or B shr 12 + C; + Inc(A, Buffer[ 9] + $21E1CDE6 + (C xor (D and (B xor C)))); A := A shl 5 or A shr 27 + B; + Inc(D, Buffer[14] + $C33707D6 + (B xor (C and (A xor B)))); D := D shl 9 or D shr 23 + A; + Inc(C, Buffer[ 3] + $F4D50D87 + (A xor (B and (D xor A)))); C := C shl 14 or C shr 18 + D; + Inc(B, Buffer[ 8] + $455A14ED + (D xor (A and (C xor D)))); B := B shl 20 or B shr 12 + C; + Inc(A, Buffer[13] + $A9E3E905 + (C xor (D and (B xor C)))); A := A shl 5 or A shr 27 + B; + Inc(D, Buffer[ 2] + $FCEFA3F8 + (B xor (C and (A xor B)))); D := D shl 9 or D shr 23 + A; + Inc(C, Buffer[ 7] + $676F02D9 + (A xor (B and (D xor A)))); C := C shl 14 or C shr 18 + D; + Inc(B, Buffer[12] + $8D2A4C8A + (D xor (A and (C xor D)))); B := B shl 20 or B shr 12 + C; + + Inc(A, Buffer[ 5] + $FFFA3942 + (B xor C xor D)); A := A shl 4 or A shr 28 + B; + Inc(D, Buffer[ 8] + $8771F681 + (A xor B xor C)); D := D shl 11 or D shr 21 + A; + Inc(C, Buffer[11] + $6D9D6122 + (D xor A xor B)); C := C shl 16 or C shr 16 + D; + Inc(B, Buffer[14] + $FDE5380C + (C xor D xor A)); B := B shl 23 or B shr 9 + C; + Inc(A, Buffer[ 1] + $A4BEEA44 + (B xor C xor D)); A := A shl 4 or A shr 28 + B; + Inc(D, Buffer[ 4] + $4BDECFA9 + (A xor B xor C)); D := D shl 11 or D shr 21 + A; + Inc(C, Buffer[ 7] + $F6BB4B60 + (D xor A xor B)); C := C shl 16 or C shr 16 + D; + Inc(B, Buffer[10] + $BEBFBC70 + (C xor D xor A)); B := B shl 23 or B shr 9 + C; + Inc(A, Buffer[13] + $289B7EC6 + (B xor C xor D)); A := A shl 4 or A shr 28 + B; + Inc(D, Buffer[ 0] + $EAA127FA + (A xor B xor C)); D := D shl 11 or D shr 21 + A; + Inc(C, Buffer[ 3] + $D4EF3085 + (D xor A xor B)); C := C shl 16 or C shr 16 + D; + Inc(B, Buffer[ 6] + $04881D05 + (C xor D xor A)); B := B shl 23 or B shr 9 + C; + Inc(A, Buffer[ 9] + $D9D4D039 + (B xor C xor D)); A := A shl 4 or A shr 28 + B; + Inc(D, Buffer[12] + $E6DB99E5 + (A xor B xor C)); D := D shl 11 or D shr 21 + A; + Inc(C, Buffer[15] + $1FA27CF8 + (D xor A xor B)); C := C shl 16 or C shr 16 + D; + Inc(B, Buffer[ 2] + $C4AC5665 + (C xor D xor A)); B := B shl 23 or B shr 9 + C; + + Inc(A, Buffer[ 0] + $F4292244 + (C xor (B or not D))); A := A shl 6 or A shr 26 + B; + Inc(D, Buffer[ 7] + $432AFF97 + (B xor (A or not C))); D := D shl 10 or D shr 22 + A; + Inc(C, Buffer[14] + $AB9423A7 + (A xor (D or not B))); C := C shl 15 or C shr 17 + D; + Inc(B, Buffer[ 5] + $FC93A039 + (D xor (C or not A))); B := B shl 21 or B shr 11 + C; + Inc(A, Buffer[12] + $655B59C3 + (C xor (B or not D))); A := A shl 6 or A shr 26 + B; + Inc(D, Buffer[ 3] + $8F0CCC92 + (B xor (A or not C))); D := D shl 10 or D shr 22 + A; + Inc(C, Buffer[10] + $FFEFF47D + (A xor (D or not B))); C := C shl 15 or C shr 17 + D; + Inc(B, Buffer[ 1] + $85845DD1 + (D xor (C or not A))); B := B shl 21 or B shr 11 + C; + Inc(A, Buffer[ 8] + $6FA87E4F + (C xor (B or not D))); A := A shl 6 or A shr 26 + B; + Inc(D, Buffer[15] + $FE2CE6E0 + (B xor (A or not C))); D := D shl 10 or D shr 22 + A; + Inc(C, Buffer[ 6] + $A3014314 + (A xor (D or not B))); C := C shl 15 or C shr 17 + D; + Inc(B, Buffer[13] + $4E0811A1 + (D xor (C or not A))); B := B shl 21 or B shr 11 + C; + Inc(A, Buffer[ 4] + $F7537E82 + (C xor (B or not D))); A := A shl 6 or A shr 26 + B; + Inc(D, Buffer[11] + $BD3AF235 + (B xor (A or not C))); D := D shl 10 or D shr 22 + A; + Inc(C, Buffer[ 2] + $2AD7D2BB + (A xor (D or not B))); C := C shl 15 or C shr 17 + D; + Inc(B, Buffer[ 9] + $EB86D391 + (D xor (C or not A))); B := B shl 21 or B shr 11 + C; + + Inc(FDigest[0], A); + Inc(FDigest[1], B); + Inc(FDigest[2], C); + Inc(FDigest[3], D); +end; +{$Q+} +(********************************************************************************************************************************) + +procedure signal_proc(signal_number: integer); cdecl; +var pid, status: integer; +begin +// !!!!!!!!!! Warning +// There should be no debug outputs in this function because it probably cause program freezes after fork +// I mean REALLY NO outputs to console + +// DebugMsg(['SIGCHLD signal received']); +// DebugMsg(['Signal received: ', signal_number]); +// DebugMsg(['*** Signal received: ', signal_number, ' = ', GetSignalString(signal_number)]); + case signal_number of +{ SIGUSR1: begin + DebugMsg(['begin wait']); + wait(@status); + DebugMsg(['end wait']); + ChildExitStatus := status; + end;} + SIGCHLD, SIGUSR1: begin +// DebugMsg(['begin wait']); +// wait(@status); + pid := waitpid(-1, @status, WNOHANG); +// DebugMsg(['**** waitpid result: pid = ', pid, ', status = ', status]); +// DebugMsg(['end wait']); + if signal_number = SIGUSR1 then ChildExitStatus := status; + end; + end; +end; + +procedure SetupSignals; +var sigchld_action: __sigaction; +begin + Libc.memset(@sigchld_action, 0, SizeOf(__sigaction)); + sigchld_action.__sigaction_handler := @signal_proc; + sigaction(SIGUSR1, @sigchld_action, nil); + sigaction(SIGCHLD, @sigchld_action, nil); +end; + +procedure SetupColors; +var Color: TGDKColor; + LocalListView: TGTKListView; +begin + LocalListView := TGTKListView.Create(Application); + try + if ConfNormalItemDefaultColors then begin + NormalItemGDKColor := GetDefaultTextColor(LocalListView, GTK_STATE_NORMAL); + NormalItemGDKBackground := GetDefaultBaseColor(LocalListView, GTK_STATE_NORMAL); + end else begin + StringToGDKColor(ConfNormalItemFGColor, Color); + NormalItemGDKColor := GDKColorToPGdkColor(Color); + StringToGDKColor(ConfNormalItemBGColor, Color); + NormalItemGDKBackground := GDKColorToPGdkColor(Color); + end; + if ConfCursorDefaultColors then begin + ActiveItemGDKColor := GetDefaultTextColor(LocalListView, GTK_STATE_SELECTED); + ActiveItemGDKBackground := GetDefaultBaseColor(LocalListView, GTK_STATE_SELECTED); + end else begin + StringToGDKColor(ConfActiveItemFGColor, Color); + ActiveItemGDKColor := GDKColorToPGdkColor(Color); + StringToGDKColor(ConfActiveItemBGColor, Color); + ActiveItemGDKBackground := GDKColorToPGdkColor(Color); + end; + if ConfInactiveItemDefaultColors then begin + InactiveItemGDKColor := GetDefaultTextColor(LocalListView, GTK_STATE_ACTIVE); + InactiveItemGDKBackground := GetDefaultBaseColor(LocalListView, GTK_STATE_ACTIVE); + end else begin + StringToGDKColor(ConfInactiveItemFGColor, Color); + InactiveItemGDKColor := GDKColorToPGdkColor(Color); + StringToGDKColor(ConfInactiveItemBGColor, Color); + InactiveItemGDKBackground := GDKColorToPGdkColor(Color); + end; + StringToGDKColor(ConfSelectedItemFGColor, Color); + SelectedItemGDKColor := GDKColorToPGdkColor(Color); + StringToGDKColor(ConfDotFileItemFGColor, Color); + DotFileItemGDKColor := GDKColorToPGdkColor(Color); + StringToGDKColor(ConfLinkItemFGColor, Color); + LinkItemGDKColor := GDKColorToPGdkColor(Color); + try + InactiveItemBGColorNum := $FF + (InactiveItemGDKBackground^.red div 256) shl 24 + + (InactiveItemGDKBackground^.green div 256) shl 16 + + (InactiveItemGDKBackground^.blue div 256) shl 8; + except InactiveItemBGColorNum := $D0D0D0FF; end; + finally + LocalListView.Free; + end; +end; + +procedure ReportGTKVersion; +begin + if Application.GTKVersion_2_8_0_Up then DebugMsg(['Using GTK+ version >= 2.8.0']) else + if Application.GTKVersion_2_6_0_Up then DebugMsg(['Using GTK+ version >= 2.6.0']) else + if Application.GTKVersion_2_4_0_Up then DebugMsg(['Using GTK+ version >= 2.4.0']) else + if Application.GTKVersion_2_2_0_Up then DebugMsg(['Using GTK+ version >= 2.2.0']) else + if Application.GTKVersion_2_0_5_Up then DebugMsg(['Using GTK+ version >= 2.0.5']) else + DebugMsg(['Using GTK+ version < 2.0.5']); +end; + + +(********************************************************************************************************************************) +var InternalLockVar: integer; +procedure InternalLock; +begin + Inc(InternalLockVar); + DebugMsg(['Lock']); +end; + +procedure InternalUnLock; +begin + Dec(InternalLockVar); + if InternalLockVar < 0 then InternalLockVar := 0; + DebugMsg(['Unlock']); +end; + +function InternalLockUnlocked: boolean; +begin + Result := InternalLockVar = 0; +end; + +procedure InternalLockInit(Locked: boolean); +begin + InternalLockVar := Ord(Locked); +end; + + +(********************************************************************************************************************************) +procedure GetFirstLastPanelColumn(var FirstColumn, LastColumn: integer); +var i: integer; +begin + FirstColumn := 1; + LastColumn := ConstNumPanelColumns; + for i := 1 to ConstNumPanelColumns do + if ConfColumnVisible[i] then begin + FirstColumn := i; + Break; + end; + for i := ConstNumPanelColumns downto 1 do + if ConfColumnVisible[i] then begin + LastColumn := i; + Break; + end; +end; + +(********************************************************************************************************************************) + + + + +(********************************************************************************************************************************) +{$IFDEF __FPC__} +function StrToDateDef(const S: string; const Default: TDateTime): TDateTime; +begin + try + Result := StrToDate(S); + except + Result := Default; + end; +end; + + +function UnixToDateTime(const AValue: Int64): TDateTime; +begin + Result := AValue / SecsPerDay + UnixDateDelta; +end; +{$ENDIF} + +(********************************************************************************************************************************) +procedure SaveItemToHistory(s: string; History: TStringList); +var i: integer; +begin + s:= Trim(s); + if Length(s) > 0 then begin + if History.IndexOf(s) > -1 then + History.Delete(History.IndexOf(s)); + History.Insert(0, s); + if History.Count > ConfNumHistoryItems then + for i := History.Count downto ConfNumHistoryItems do + History.Delete(i - 1); + end; +end; + + +(********************************************************************************************************************************) + + + + + + + + + + +initialization + InternalLockInit(True); + SetupSignals; + AppPath := IncludeTrailingPathDelimiter(GetHomePath); + IconPath := IncludeTrailingPathDelimiter(GetHomePath); +end. |