testdll.pp 1.3 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273
  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. end;
  32. procedure P4(x1:pointer);export;
  33. begin
  34. x1:=Nil;
  35. end;
  36. procedure NewExit;
  37. begin
  38. beep(0);
  39. writeln('DLL: Exit from testdll');
  40. end;
  41. exports
  42. P1 index 1,
  43. P2 name 'Proc2',
  44. P3,
  45. P4 resident,
  46. teststr name 'FPC_string';
  47. begin
  48. writeln('DLL: HInstance ',Hinstance,' PrevInst ',Hprevinst,' DLLReason ',DLLreason,' DLLParam ',DLLparam);
  49. teststr:='DLL init done';
  50. exitproc:=@newExit;
  51. end.
  52. {
  53. $Log$
  54. Revision 1.3 1999-10-26 12:33:53 peter
  55. * fixed illegal expr
  56. Revision 1.2 1999/06/30 22:04:56 michael
  57. * Added code to remove warnings
  58. Revision 1.1 1999/01/12 14:20:36 peter
  59. + dll example
  60. }