mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-05 07:22:01 +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