dllistdyn.pp 3.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107
  1. {
  2. Call InitialiseDllist before using any of the calls, and call ReleaseDllist
  3. when finished.
  4. }
  5. unit DllistDyn;
  6. {$mode objfpc}{$H+}
  7. interface
  8. uses
  9. dynlibs, SysUtils;
  10. {$PACKRECORDS C}
  11. {$i dllisttypes.inc}
  12. var
  13. DLNewList : function : PDllist;cdecl;
  14. DLFreeList : procedure (_para1:PDllist);cdecl;
  15. DLNewElem : function (val : pointer) :PDlelem;cdecl;
  16. DLFreeElem : procedure (_para1:PDlelem);cdecl;
  17. DLGetHead : function (_para1:PDllist):PDlelem;cdecl;
  18. DLGetTail : function (_para1:PDllist):PDlelem;cdecl;
  19. DLRemTail : function (l:PDllist):PDlelem;cdecl;
  20. DLGetPred : function (_para1:PDlelem):PDlelem;cdecl;
  21. DLGetSucc : function (_para1:PDlelem):PDlelem;cdecl;
  22. DLRemove : procedure (_para1:PDlelem);cdecl;
  23. DLAddHead : procedure (list:PDllist; node:PDlelem);cdecl;
  24. DLAddTail : procedure (list:PDllist; node:PDlelem);cdecl;
  25. DLRemHead : function (list:PDllist):PDlelem;cdecl;
  26. { Macro translated }
  27. Function DLE_VAL(elem : PDlelem) : pointer;
  28. Procedure InitialiseDllist(libpath:string);
  29. Procedure ReleaseDllist;
  30. var DllistLibraryHandle : TLibHandle;
  31. var libpgCriticalSection: TRTLCriticalSection;
  32. implementation
  33. var RefCount : integer;
  34. Procedure InitialiseDllist(libpath:string);
  35. begin
  36. EnterCriticalsection(libpgCriticalSection);
  37. try
  38. inc(RefCount);
  39. if RefCount = 1 then
  40. begin
  41. DllistLibraryHandle := loadlibrary(libpath);
  42. if DllistLibraryHandle = nilhandle then
  43. begin
  44. RefCount := 0;
  45. Raise EInOutError.Create('Can not load PosgreSQL client. Is it installed? ('+libpath+')');
  46. end;
  47. pointer(DLNewList) := GetProcedureAddress(DllistLibraryHandle,'DLNewList');
  48. pointer(DLFreeList) := GetProcedureAddress(DllistLibraryHandle,'DLFreeList');
  49. pointer( DLNewElem) := GetProcedureAddress(DllistLibraryHandle,' DLNewElem');
  50. pointer(DLFreeElem) := GetProcedureAddress(DllistLibraryHandle,'DLFreeElem');
  51. pointer( DLGetHead) := GetProcedureAddress(DllistLibraryHandle,' DLGetHead');
  52. pointer( DLGetTail) := GetProcedureAddress(DllistLibraryHandle,' DLGetTail');
  53. pointer( DLRemTail) := GetProcedureAddress(DllistLibraryHandle,' DLRemTail');
  54. pointer( DLGetPred) := GetProcedureAddress(DllistLibraryHandle,' DLGetPred');
  55. pointer( DLGetSucc) := GetProcedureAddress(DllistLibraryHandle,' DLGetSucc');
  56. pointer(DLRemove) := GetProcedureAddress(DllistLibraryHandle,'DLRemove');
  57. pointer(DLAddHead) := GetProcedureAddress(DllistLibraryHandle,'DLAddHead');
  58. pointer(DLAddTail) := GetProcedureAddress(DllistLibraryHandle,'DLAddTail');
  59. pointer( DLRemHead) := GetProcedureAddress(DllistLibraryHandle,' DLRemHead');
  60. end;
  61. finally
  62. LeaveCriticalsection(libpgCriticalSection);
  63. end;
  64. end;
  65. Procedure ReleaseDllist;
  66. begin
  67. EnterCriticalsection(libpgCriticalSection);
  68. try
  69. if RefCount > 0 then dec(RefCount);
  70. if RefCount = 0 then
  71. begin
  72. if not UnloadLibrary(DllistLibraryHandle) then inc(RefCount);
  73. end;
  74. finally
  75. LeaveCriticalsection(libpgCriticalSection);
  76. end;
  77. end;
  78. // This function is also defined in Dllist!
  79. Function DLE_VAL(elem : PDlelem) : pointer;
  80. begin
  81. DLE_VAL:=elem^.dle_val
  82. end;
  83. initialization
  84. InitCriticalSection(libpgCriticalSection);
  85. finalization
  86. DoneCriticalsection(libpgCriticalSection);
  87. end.