diff options
Diffstat (limited to 'UCoreUtils.pas')
| -rw-r--r-- | UCoreUtils.pas | 86 |
1 files changed, 49 insertions, 37 deletions
diff --git a/UCoreUtils.pas b/UCoreUtils.pas index ed43589..0bccb8b 100644 --- a/UCoreUtils.pas +++ b/UCoreUtils.pas @@ -112,10 +112,7 @@ 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} +function StrTotimetDef(const S: string; const Default: time_t): time_t; procedure SaveItemToHistory(s: string; History: TStringList); @@ -1053,6 +1050,9 @@ begin vtCurrency: Write(ErrOutput, CurrToStr(VCurrency^)); vtVariant: Write(ErrOutput, string(VVariant^)); vtInt64: Write(ErrOutput, IntToStr(VInt64^)); +{$IFDEF FPC} + vtQWord: Write(ErrOutput, IntToStr(VQWord^)); +{$ENDIF} end; WriteLn(ErrOutput); end; @@ -1061,9 +1061,8 @@ end; (********************************************************************************************************************************) function SpawnProcess(const AppPath: string; var Running: boolean; const Parameters: array of string): Cardinal; var child_pid: __pid_t; - args_list: System.PPChar; + args_list: PPChar; i: integer; - Temp: string; sv: sigval_t; begin Result := 0; @@ -1073,16 +1072,12 @@ begin // Make the args_list array args_list := nil; if Length(Parameters) > 0 then begin - args_list := malloc((Length(Parameters) + 1) * SizeOf(PChar)); - memset(args_list, 0, (Length(Parameters) + 1) * SizeOf(PChar)); + args_list := malloc((Length(Parameters) + 1) * sizeof(PChar)); + 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] := malloc(Length(Temp)+1); -// memset(PCharArray(args_list^)[I], 0, Length(Temp)+1); -// StrCopy(PCharArray(args_list^)[I], PChar(Temp)); - PCharArray(args_list^)[I] := strdup(PChar(Temp)); + PCharArray(args_list^)[I] := strdup(PChar(Parameters[i])); {$R+} end; {$R-} @@ -1095,6 +1090,11 @@ begin if child_pid <> 0 then begin Result := child_pid; Sleep(100); + //* FIXME: strange behaviour when freed +{ for i := 0 to Length(Parameters) - 1 do + if PCharArray(args_list^)[i] <> nil then + libc_free(PCharArray(args_list^)[i]); } + if args_list <> nil then libc_free(args_list); Application.ProcessMessages; Running := ChildExitStatus < 0; if not Running then Result := 0; @@ -1211,7 +1211,7 @@ end; (********************************************************************************************************************************) function IsItX11App(const Application: string): boolean; -const BSize = 32768; +const BSize = 65536; What = 'libX11.so'; var stream: PFILE; Buffer: Pointer; @@ -1242,6 +1242,8 @@ begin end; end; pclose(stream); + libc_free(Buffer); + SetLength(str, 0); end; // unsetenv('LD_TRACE_LOADED_OBJECTS'); @@ -1252,7 +1254,7 @@ begin end; function HandleSystemCommand(const Command, ErrorText: string): boolean; -const BSize = 32768; +const BSize = 65536; var stream: PFILE; Buffer: Pointer; i, NumRead: integer; @@ -1277,9 +1279,9 @@ begin libc_close(fds[1]); stream := fdopen(fds[0], 'r'); Buffer := malloc(BSize); - DebugMsg(['x0']); +// DebugMsg(['x0']); memset(Buffer, 0, BSize); - DebugMsg(['x1']); +// DebugMsg(['x1']); if buffer = nil then Writeln('buffer nil: ', integer(errno)); if stream = nil then Writeln('stream nil'); @@ -1293,12 +1295,12 @@ begin end; end; libc_close(fds[0]); - DebugMsg(['x2']); +// DebugMsg(['x2']); TrimCRLFESC(s); - DebugMsg(['x3']); +// DebugMsg(['x3']); - free(Buffer); - DebugMsg(['x4']); + libc_free(Buffer); +// DebugMsg(['x4']); end // forked PID @@ -1338,6 +1340,7 @@ begin Result := Length(s) = 0; if not Result then Application.MessageBox(Format('%s%s', [ErrorText, StrToUTF8(s)]), [mbOK], mbError, mbOK, mbOK); + SetLength(s, 0); except on E: Exception do DebugMsg(['***** function HandleSystemCommand(''', Command, '''):Exception: ', E.Message]); end; @@ -1549,6 +1552,12 @@ begin Result := 0; end; {$ELSE} +{$IFDEF CPUPOWERPC} +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 @@ -1639,6 +1648,7 @@ asm DD 06E656761h, 064655220h, 06E616D64h, 06FBBA36Eh end; {$ENDIF} +{$ENDIF} (********************************************************************************************************************************) constructor THash_MD5.Create; begin @@ -1738,6 +1748,12 @@ begin Result := nil; end; {$ELSE} +{$IFDEF CPUPOWERPC} +function THash_MD5.TestVector: Pointer; +begin + Result := nil; +end; +{$ELSE} function THash_MD5.TestVector: Pointer; asm MOV EAX,OFFSET @Vector @@ -1746,6 +1762,7 @@ asm DB 075h,05Dh,04Bh,0C9h,0FEh,0DCh,0C2h,0C6h end; {$ENDIF} +{$ENDIF} {$Q-} procedure THash_MD5.Transform(Buffer: PIntArray); @@ -1921,12 +1938,15 @@ 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']); +{$IFDEF FPC} + DebugMsg(['Reported GTK version: ', gtk_major_version, '.', gtk_minor_version, '.', gtk_micro_version]); +{$ENDIF} + if Application.GTKVersion_2_8_0_Up then DebugMsg(['Using quirks for GTK+ >= 2.8.0']) else + if Application.GTKVersion_2_6_0_Up then DebugMsg(['Using quirks for GTK+ >= 2.6.0']) else + if Application.GTKVersion_2_4_0_Up then DebugMsg(['Using quirks for GTK+ >= 2.4.0']) else + if Application.GTKVersion_2_2_0_Up then DebugMsg(['Using quirks for GTK+ >= 2.2.0']) else + if Application.GTKVersion_2_0_5_Up then DebugMsg(['Using quirks for GTK+ >= 2.0.5']) else + DebugMsg(['Using quirks for GTK+ < 2.0.5']); end; @@ -1980,23 +2000,15 @@ end; (********************************************************************************************************************************) -{$IFDEF __FPC__} -function StrToDateDef(const S: string; const Default: TDateTime): TDateTime; +function StrTotimetDef(const S: string; const Default: time_t): time_t; begin try - Result := StrToDate(S); + Result := DateTimeToUnix(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; |