synafpc.pas 5.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151
  1. {==============================================================================|
  2. | Project : Ararat Synapse | 001.004.000 |
  3. |==============================================================================|
  4. | Content: Utils for FreePascal compatibility |
  5. |==============================================================================|
  6. | Copyright (c)1999-2022, Lukas Gebauer |
  7. | All rights reserved. |
  8. | |
  9. | Redistribution and use in source and binary forms, with or without |
  10. | modification, are permitted provided that the following conditions are met: |
  11. | |
  12. | Redistributions of source code must retain the above copyright notice, this |
  13. | list of conditions and the following disclaimer. |
  14. | |
  15. | Redistributions in binary form must reproduce the above copyright notice, |
  16. | this list of conditions and the following disclaimer in the documentation |
  17. | and/or other materials provided with the distribution. |
  18. | |
  19. | Neither the name of Lukas Gebauer nor the names of its contributors may |
  20. | be used to endorse or promote products derived from this software without |
  21. | specific prior written permission. |
  22. | |
  23. | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
  24. | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
  25. | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
  26. | ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
  27. | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
  28. | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
  29. | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
  30. | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
  31. | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
  32. | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
  33. | DAMAGE. |
  34. |==============================================================================|
  35. | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
  36. | Portions created by Lukas Gebauer are Copyright (c)2003-2013. |
  37. | All Rights Reserved. |
  38. |==============================================================================|
  39. | Contributor(s): |
  40. | Tomas Hajny (OS2 support) |
  41. | Projeto ACBr |
  42. |==============================================================================|
  43. | History: see HISTORY.HTM from distribution package |
  44. | (Found at URL: http://www.ararat.cz/synapse/) |
  45. |==============================================================================}
  46. {:@exclude}
  47. {$IFDEF FPC}
  48. {$MODE DELPHI}
  49. {$ENDIF}
  50. {$H+}
  51. //old Delphi does not have MSWINDOWS define.
  52. {$IFDEF WIN32}
  53. {$IFNDEF MSWINDOWS}
  54. {$DEFINE MSWINDOWS}
  55. {$ENDIF}
  56. {$ENDIF}
  57. unit synafpc;
  58. interface
  59. uses
  60. {$IFDEF FPC}
  61. {$IFNDEF ULTIBO}dynlibs,{$ENDIF} sysutils;
  62. {$ELSE}
  63. {$IFDEF MSWINDOWS}
  64. Windows;
  65. {$ELSE}
  66. SysUtils;
  67. {$ENDIF}
  68. {$ENDIF}
  69. {$IFDEF FPC}
  70. type
  71. TLibHandle = {$IFNDEF ULTIBO}dynlibs.TLibHandle;{$ELSE}THandle;{$ENDIF}
  72. function LoadLibrary(ModuleName: PChar): TLibHandle;
  73. function FreeLibrary(Module: TLibHandle): LongBool;
  74. function GetProcAddress(Module: TLibHandle; Proc: PChar): Pointer;
  75. function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer): Integer;
  76. {$ELSE} //not FPC
  77. type
  78. {$IFDEF CIL}
  79. TLibHandle = Integer;
  80. PtrInt = Integer;
  81. {$ELSE}
  82. TLibHandle = HModule;
  83. {$IFDEF WIN64}
  84. PtrInt = NativeInt;
  85. {$ELSE}
  86. PtrInt = Integer;
  87. {$ENDIF}
  88. {$ENDIF}
  89. {$IFDEF VER100}
  90. LongWord = DWord;
  91. {$ENDIF}
  92. {$ENDIF}
  93. procedure Sleep(milliseconds: Cardinal);
  94. implementation
  95. {==============================================================================}
  96. {$IFDEF FPC}
  97. function LoadLibrary(ModuleName: PChar): TLibHandle;
  98. begin
  99. Result := {$IFNDEF ULTIBO}dynlibs.LoadLibrary(Modulename);{$ELSE}-1;{$ENDIF}
  100. end;
  101. function FreeLibrary(Module: TLibHandle): LongBool;
  102. begin
  103. Result := {$IFNDEF ULTIBO}dynlibs.UnloadLibrary(Module);{$ELSE}False;{$ENDIF}
  104. end;
  105. function GetProcAddress(Module: TLibHandle; Proc: PChar): Pointer;
  106. begin
  107. {$IFNDEF ULTIBO}
  108. {$IFDEF OS2GCC}
  109. Result := dynlibs.GetProcedureAddress(Module, '_' + Proc);
  110. {$ELSE OS2GCC}
  111. Result := dynlibs.GetProcedureAddress(Module, Proc);
  112. {$ENDIF OS2GCC}
  113. {$ELSE}
  114. Result := nil;
  115. {$ENDIF}
  116. end;
  117. function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer): Integer;
  118. begin
  119. Result := 0;
  120. end;
  121. {$ELSE}
  122. {$ENDIF}
  123. procedure Sleep(milliseconds: Cardinal);
  124. begin
  125. {$IFDEF MSWINDOWS}
  126. {$IFDEF FPC}
  127. sysutils.sleep(milliseconds);
  128. {$ELSE}
  129. windows.sleep(milliseconds);
  130. {$ENDIF}
  131. {$ELSE}
  132. sysutils.sleep(milliseconds);
  133. {$ENDIF}
  134. end;
  135. end.