mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-13 10:29:17 +02:00
+ dll example
This commit is contained in:
parent
7e7e30d9d3
commit
cef9fc7b2b
32
install/demo/win32/dlltest.pp
Normal file
32
install/demo/win32/dlltest.pp
Normal file
@ -0,0 +1,32 @@
|
|||||||
|
{
|
||||||
|
$Id$
|
||||||
|
Copyright (c) 1998 by Pierre Muller
|
||||||
|
|
||||||
|
Win32 DLL usage example. It needs testdll.pp
|
||||||
|
}
|
||||||
|
program dlltest;
|
||||||
|
|
||||||
|
procedure p1(x:pointer);
|
||||||
|
external 'testdll' name 'P1';
|
||||||
|
procedure proc2(x:longint);
|
||||||
|
external 'testdll' name 'Proc2';
|
||||||
|
|
||||||
|
var
|
||||||
|
s : string;external 'testdll' name 'FPC_string';
|
||||||
|
|
||||||
|
begin
|
||||||
|
writeln('Main: Hello!');
|
||||||
|
p1(nil);
|
||||||
|
writeln('Main: ',Hinstance,' ',Hprevinst);
|
||||||
|
writeln('Main: testdll s string = ',s);
|
||||||
|
s:='Changed by program';
|
||||||
|
proc2(1234);
|
||||||
|
writeln('Main: press enter');
|
||||||
|
readln;
|
||||||
|
end.
|
||||||
|
{
|
||||||
|
$Log$
|
||||||
|
Revision 1.1 1999-01-12 14:20:36 peter
|
||||||
|
+ dll example
|
||||||
|
|
||||||
|
}
|
62
install/demo/win32/testdll.pp
Normal file
62
install/demo/win32/testdll.pp
Normal file
@ -0,0 +1,62 @@
|
|||||||
|
{
|
||||||
|
$Id$
|
||||||
|
Copyright (c) 1998 by Pierre Muller
|
||||||
|
|
||||||
|
Win32 DLL usage example. It needs dlltest.pp
|
||||||
|
}
|
||||||
|
library testdll;
|
||||||
|
|
||||||
|
function GetModuleFileName(hModule:longint;lpszPath:pchar;cchPath:longint):longint;
|
||||||
|
external 'kernel32' name 'GetModuleFileNameA';
|
||||||
|
procedure beep(ID:longint);
|
||||||
|
external 'user32' name 'MessageBeep';
|
||||||
|
|
||||||
|
var
|
||||||
|
teststr : string;
|
||||||
|
|
||||||
|
procedure P1(var s:string);export;
|
||||||
|
var
|
||||||
|
p:array[0..255] of char;
|
||||||
|
begin
|
||||||
|
getmodulefilename(Hinstance,@p,255);
|
||||||
|
writeln('DLL: Hello, I''m DLL ',pchar(@p));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure P2(x:longint);export;
|
||||||
|
begin
|
||||||
|
writeln('DLL: Argument X=',x);
|
||||||
|
writeln('DLL: New teststr="',teststr,'"');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure P3(var t);export;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure P4(x1:pointer);export;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure NewExit;
|
||||||
|
begin
|
||||||
|
beep(0);
|
||||||
|
writeln('DLL: Exit from testdll');
|
||||||
|
end;
|
||||||
|
|
||||||
|
exports
|
||||||
|
P1 index 1,
|
||||||
|
P2 name 'Proc2',
|
||||||
|
P3,
|
||||||
|
P4 resident,
|
||||||
|
teststr name 'FPC_string';
|
||||||
|
|
||||||
|
begin
|
||||||
|
writeln('DLL: HInstance ',Hinstance,' PrevInst ',Hprevinst,' DLLReason ',DLLreason,' DLLParam ',DLLparam);
|
||||||
|
teststr:='DLL init done';
|
||||||
|
exitproc:=@newExit;
|
||||||
|
end.
|
||||||
|
{
|
||||||
|
$Log$
|
||||||
|
Revision 1.1 1999-01-12 14:20:36 peter
|
||||||
|
+ dll example
|
||||||
|
|
||||||
|
}
|
Loading…
Reference in New Issue
Block a user