{==============================================================================| | Project : Ararat Synapse | 001.004.000 | |==============================================================================| | Content: Utils for FreePascal compatibility | |==============================================================================| | Copyright (c)1999-2022, Lukas Gebauer | | All rights reserved. | | | | Redistribution and use in source and binary forms, with or without | | modification, are permitted provided that the following conditions are met: | | | | Redistributions of source code must retain the above copyright notice, this | | list of conditions and the following disclaimer. | | | | Redistributions in binary form must reproduce the above copyright notice, | | this list of conditions and the following disclaimer in the documentation | | and/or other materials provided with the distribution. | | | | Neither the name of Lukas Gebauer nor the names of its contributors may | | be used to endorse or promote products derived from this software without | | specific prior written permission. | | | | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | | ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | | DAMAGE. | |==============================================================================| | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| | Portions created by Lukas Gebauer are Copyright (c)2003-2013. | | All Rights Reserved. | |==============================================================================| | Contributor(s): | | Tomas Hajny (OS2 support) | | Projeto ACBr | |==============================================================================| | History: see HISTORY.HTM from distribution package | | (Found at URL: http://www.ararat.cz/synapse/) | |==============================================================================} {:@exclude} {$INCLUDE 'jedi.inc'} {$H+} //old Delphi does not have MSWINDOWS define. {$IFDEF WIN32} {$IFNDEF MSWINDOWS} {$DEFINE MSWINDOWS} {$ENDIF} {$ENDIF} {$IFDEF NEXTGEN} {$LEGACYIFEND ON} {$ZEROBASEDSTRINGS OFF} {$ENDIF} {$IfDef DELPHI2009_UP} {$DEFINE HAS_CHARINSET} {$EndIf} {$IfDef FPC} {$DEFINE HAS_CHARINSET} {$EndIf} unit synafpc; interface uses {$IFDEF FPC} dynlibs, {$ELSE} {$IFDEF DELPHIXE4_UP} {$IFNDEF NEXTGEN} System.AnsiStrings, {$ENDIF} {$ENDIF} {$IFDEF MSWINDOWS} Windows, {$ENDIF} {$ENDIF} SysUtils; {$IFDEF FPC} type TLibHandle = dynlibs.TLibHandle; function LoadLibrary(ModuleName: PChar): TLibHandle; function FreeLibrary(Module: TLibHandle): LongBool; function GetProcAddress(Module: TLibHandle; Proc: PChar): Pointer; function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer): Integer; {$ELSE} //not FPC type {$IFDEF CIL} TLibHandle = Integer; PtrInt = Integer; {$ELSE} TLibHandle = HModule; {$IFDEF WIN64} PtrInt = NativeInt; {$ELSE} PtrInt = Integer; {$ENDIF} {$ENDIF} {$IFDEF DELPHI3} LongWord = DWord; {$ENDIF} {$IFDEF NEXTGEN} // Android FMX AnsiString = RawByteString; AnsiChar = UTF8Char; PAnsiChar = PUTF8Char; WideString = String; {$ENDIF} {$ENDIF} function StrLCopy(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; function StrLComp(const Str1, Str2: PANSIChar; MaxLen: Cardinal): Integer; procedure Sleep(milliseconds: Cardinal); {$IfNDef HAS_CHARINSET} function CharInSet(C: AnsiChar; const CharSet: TSysCharSet): Boolean; {$EndIf} implementation {==============================================================================} {$IFDEF FPC} function LoadLibrary(ModuleName: PChar): TLibHandle; begin Result := dynlibs.LoadLibrary(Modulename); end; function FreeLibrary(Module: TLibHandle): LongBool; begin Result := dynlibs.UnloadLibrary(Module); end; function GetProcAddress(Module: TLibHandle; Proc: PChar): Pointer; begin {$IFDEF OS2GCC} Result := dynlibs.GetProcedureAddress(Module, '_' + Proc); {$ELSE OS2GCC} Result := dynlibs.GetProcedureAddress(Module, Proc); {$ENDIF OS2GCC} end; function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer): Integer; begin Result := 0; end; {$ELSE} {$ENDIF} function StrLCopy(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; begin {$IfDef FPC} Result := SysUtils.StrLCopy(Dest, Source, MaxLen); {$Else} {$IFDEF DELPHIXE4_UP} {$IfDef NEXTGEN} Result := PAnsiChar( System.SysUtils.StrLCopy(PWideChar(Dest^), PWideChar(Source^), MaxLen)^ ); {$Else} Result := System.AnsiStrings.StrLCopy(Dest, Source, MaxLen); {$EndIf} {$Else} Result := SysUtils.StrLCopy(Dest, Source, MaxLen); {$ENDIF} {$EndIf} end; function StrLComp(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer; begin {$IfDef FPC} Result := SysUtils.strlcomp(Str1, Str2, MaxLen); {$Else} {$IFDEF DELPHIXE4_UP} {$IfDef NEXTGEN} Result := System.SysUtils.StrLComp(PWideChar(Str1^), PWideChar(Str2^), MaxLen); {$Else} Result := System.AnsiStrings.StrLComp(Str1, Str2, MaxLen); {$EndIf} {$Else} Result := SysUtils.StrLComp(Str1, Str2, MaxLen); {$ENDIF} {$EndIf} end; procedure Sleep(milliseconds: Cardinal); begin {$IFDEF MSWINDOWS} {$IFDEF FPC} sysutils.sleep(milliseconds); {$ELSE} windows.sleep(milliseconds); {$ENDIF} {$ELSE} sysutils.sleep(milliseconds); {$ENDIF} end; {$IfNDef HAS_CHARINSET} function CharInSet(C: AnsiChar; const CharSet: TSysCharSet): Boolean; begin result := C in CharSet; end; {$EndIf} end.