testdll.pp 1.2 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768
  1. {
  2. $Id$
  3. Copyright (c) 1998 by Pierre Muller
  4. Win32 DLL usage example. It needs dlltest.pp
  5. }
  6. library testdll;
  7. function GetModuleFileName(hModule:longint;lpszPath:pchar;cchPath:longint):longint;
  8. external 'kernel32' name 'GetModuleFileNameA';
  9. procedure beep(ID:longint);
  10. external 'user32' name 'MessageBeep';
  11. var
  12. teststr : string;
  13. procedure P1(var s:string);export;
  14. var
  15. p:array[0..255] of char;
  16. begin
  17. length(s);
  18. getmodulefilename(Hinstance,@p,255);
  19. writeln('DLL: Hello, I''m DLL ',pchar(@p));
  20. end;
  21. procedure P2(x:longint);export;
  22. begin
  23. writeln('DLL: Argument X=',x);
  24. writeln('DLL: New teststr="',teststr,'"');
  25. end;
  26. procedure P3(var t);export;
  27. var
  28. p : pointer;
  29. begin
  30. p:=Addr(T);
  31. p:=p;
  32. end;
  33. procedure P4(x1:pointer);export;
  34. begin
  35. Inc(x1);
  36. end;
  37. procedure NewExit;
  38. begin
  39. beep(0);
  40. writeln('DLL: Exit from testdll');
  41. end;
  42. exports
  43. P1 index 1,
  44. P2 name 'Proc2',
  45. P3,
  46. P4 resident,
  47. teststr name 'FPC_string';
  48. begin
  49. writeln('DLL: HInstance ',Hinstance,' PrevInst ',Hprevinst,' DLLReason ',DLLreason,' DLLParam ',DLLparam);
  50. teststr:='DLL init done';
  51. exitproc:=@newExit;
  52. end.
  53. {
  54. $Log$
  55. Revision 1.2 2002-09-07 15:06:35 peter
  56. * old logs removed and tabs fixed
  57. }