synafpc.pas 5.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148
  1. {==============================================================================|
  2. | Project : Ararat Synapse | 001.003.001 |
  3. |==============================================================================|
  4. | Content: Utils for FreePascal compatibility |
  5. |==============================================================================|
  6. | Copyright (c)1999-2013, 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. |==============================================================================|
  42. | History: see HISTORY.HTM from distribution package |
  43. | (Found at URL: http://www.ararat.cz/synapse/) |
  44. |==============================================================================}
  45. {:@exclude}
  46. {$IFDEF FPC}
  47. {$MODE DELPHI}
  48. {$ENDIF}
  49. {$H+}
  50. //old Delphi does not have MSWINDOWS define.
  51. {$IFDEF WIN32}
  52. {$IFNDEF MSWINDOWS}
  53. {$DEFINE MSWINDOWS}
  54. {$ENDIF}
  55. {$ENDIF}
  56. unit synafpc;
  57. interface
  58. uses
  59. {$IFDEF FPC}
  60. dynlibs, sysutils;
  61. {$ELSE}
  62. {$IFDEF MSWINDOWS}
  63. Windows;
  64. {$ELSE}
  65. SysUtils;
  66. {$ENDIF}
  67. {$ENDIF}
  68. {$IFDEF FPC}
  69. type
  70. TLibHandle = dynlibs.TLibHandle;
  71. function LoadLibrary(ModuleName: PChar): TLibHandle;
  72. function FreeLibrary(Module: TLibHandle): LongBool;
  73. function GetProcAddress(Module: TLibHandle; Proc: PChar): Pointer;
  74. function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer): Integer;
  75. {$ELSE} //not FPC
  76. type
  77. {$IFDEF CIL}
  78. TLibHandle = Integer;
  79. PtrInt = Integer;
  80. {$ELSE}
  81. TLibHandle = HModule;
  82. {$IFDEF WIN64}
  83. PtrInt = NativeInt;
  84. {$ELSE}
  85. PtrInt = Integer;
  86. {$ENDIF}
  87. {$ENDIF}
  88. {$IFDEF VER100}
  89. LongWord = DWord;
  90. {$ENDIF}
  91. {$ENDIF}
  92. procedure Sleep(milliseconds: Cardinal);
  93. implementation
  94. {==============================================================================}
  95. {$IFDEF FPC}
  96. function LoadLibrary(ModuleName: PChar): TLibHandle;
  97. begin
  98. Result := dynlibs.LoadLibrary(Modulename);
  99. end;
  100. function FreeLibrary(Module: TLibHandle): LongBool;
  101. begin
  102. Result := dynlibs.UnloadLibrary(Module);
  103. end;
  104. function GetProcAddress(Module: TLibHandle; Proc: PChar): Pointer;
  105. begin
  106. {$IFDEF OS2GCC}
  107. Result := dynlibs.GetProcedureAddress(Module, '_' + Proc);
  108. {$ELSE OS2GCC}
  109. Result := dynlibs.GetProcedureAddress(Module, Proc);
  110. {$ENDIF OS2GCC}
  111. end;
  112. function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer): Integer;
  113. begin
  114. Result := 0;
  115. end;
  116. {$ELSE}
  117. {$ENDIF}
  118. procedure Sleep(milliseconds: Cardinal);
  119. begin
  120. {$IFDEF MSWINDOWS}
  121. {$IFDEF FPC}
  122. sysutils.sleep(milliseconds);
  123. {$ELSE}
  124. windows.sleep(milliseconds);
  125. {$ENDIF}
  126. {$ELSE}
  127. sysutils.sleep(milliseconds);
  128. {$ENDIF}
  129. end;
  130. end.