home *** CD-ROM | disk | FTP | other *** search
/ Prima Shareware 3 / DuCom_Prima-Shareware-3_cd1.bin / PROGRAMO / PASCAL / JANUSW / DYNLINK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-05-15  |  10.6 KB  |  398 lines
  1. { Unit:      DynLink
  2.   Version:   1.10
  3.   Purpose:   DYNAMIC link to DLLs
  4.  
  5.   Developer: Peter Sawatzki (ps)
  6.              Buchenhof 3, 58091 Hagen, Germany
  7.  CompuServe: 100031,3002
  8.  
  9.   Date:    Author:
  10.   09/09/93 ps     initial release by PS
  11.  
  12.   Copyright (c) 1994 Peter Sawatzki. All Rights Reserved.
  13.  
  14. }
  15. {$A+,B-,F-,G+,I-,K+,P-,Q-,R-,S-,T-,V-,X+}
  16. Unit DynLink;
  17. Interface
  18. Uses
  19.   Objects,
  20.   oWindows,
  21.   WinTypes,
  22.   WinProcs;
  23. Const
  24.   DefWarnUser: Boolean = True;
  25. Type
  26.   pFunctionCollection = ^tFunctionCollection;
  27.   tFunctionCollection = Object(tCollection)
  28.     Procedure FreeItem (Item: Pointer); Virtual;
  29.   End;
  30.  
  31.   pPointer = ^Pointer;
  32.   pFunction = ^tFunction;
  33.   tFunction = Record
  34.     Name: pChar;
  35.     FuncVarAdr: pPointer;
  36.   End;
  37.  
  38.   tDll = Object(tObject)
  39.     ModuleHandle: tHandle;
  40.     ModuleName: pChar;
  41.     JumpSeg: tHandle;
  42.     FunctionCollection: pFunctionCollection;
  43.     Linked, WarnUser: Boolean;
  44.     Constructor Init (aName: pChar);
  45.     Destructor Done; Virtual;
  46.     Procedure InitProcs; Virtual;
  47.     Procedure BuildProcsInfo;
  48.     Procedure AddFunction (anAddr: Pointer; aName: pChar);
  49.     Procedure Link (Index: Word);
  50.     Procedure RemoveLinkInfo;
  51.     Function  LibLink: Bool; Virtual;
  52.     Procedure LibUnLink;     Virtual;
  53.     Function  LibPresent: Bool; Virtual;
  54.     Procedure LibError; Virtual;
  55.   End;
  56.  
  57.   tBWCC = Object(tDll)
  58.     DialogBox: Function (Instance: tHandle; Templatename: pChar;
  59.                          WndParent: hWnd; DialogFunc: tFarProc): Integer;
  60.     DialogBoxParam: Function (Instance: tHandle; TemplateName: pChar;
  61.                          WndParent: hWnd; DialogFunc: tFarProc; InitParam: LongInt): Integer;
  62.     CreateDialog: Function (Instance: THandle; TemplateName: PChar;
  63.                          WndParent: hWnd; DialogFunc: tFarProc): hWnd;
  64.     CreateDialogParam: Function (Instance: tHandle; TemplateName: pChar;
  65.                          WndParent: hWnd; DialogFunc: tFarProc; InitParam: LongInt): hWnd;
  66.     MessageBox: Function (WndParent: HWnd; Txt, Caption: pChar; TextType: Word): Integer;
  67.     GetPattern: Function: HBrush;
  68.     GetVersion: Function: Longint;
  69.     SpecialLoadDialog: Function (hResMod: tHandle; Templatename: pChar; DialogFunc: tFarProc): tHandle;
  70.     MangleDialog: Function (hDlg: tHandle; hResMod: tHandle; DialogFunc: tFarProc): tHandle;
  71.     DefMdiChildProc,
  72.     DefWindowProc,
  73.     DefDlgProc: tDefaultProc;
  74.     Procedure InitProcs; Virtual;
  75.   End;
  76.  
  77. Const
  78.   BorDialog = 'BorDlg';
  79.   BorDialogGray = 'BorDlg_Gray'; {Borland's new gray BorDlg}
  80.   BorButton = 'BorBtn';
  81.   BorRadio  = 'BorRadio';
  82.   BorCheck  = 'BorCheck';
  83.   BorShade  = 'BorShade';
  84.   BorStatic = 'BorStatic';
  85.  
  86.   bss_Group = 1; {group box}
  87.   bss_Hdip  = 2; {horizontal border}
  88.   bss_Vdip  = 3; {hertical border}
  89.   bss_Hbump = 4; {horizontal speed bump}
  90.   bss_Vbump = 5; {vertical speed bump}
  91.  
  92. Type
  93.   tCtl3D = Object(tDll)
  94.     SubclassDlg:   Function (aDialog: hWnd; grbit: Word): Bool;
  95.     SubClassDlgEx: Function (aDialog: hWnd; grbit: LongInt): Bool;
  96.     GetVer:        Function: Word;
  97.     Enabled:       Function: Bool;
  98.     CtlColor:      Function (aDC: hDC; lParam: LongInt): hBrush;
  99.     CtlColorEx:    Function (Message, wParam: Word; lParam: LongInt): hBrush;
  100.     ColorChange:   Function: Bool;
  101.     SubclassCtl:   Function (aCtl: hWnd): Bool;
  102.     DlgFramePaint: Function (aDialog: hWnd; Message, wParam: Word; lParam: LongInt): LongInt;
  103.     AutoSubclass:  Function (hInstApp: tHandle): Bool;
  104.     Register:      Function (hInstApp: tHandle): Bool;
  105.     Unregister:    Function (hInstApp: tHandle): Bool;
  106.     Procedure InitProcs;     Virtual;
  107.     Function  LibLink: Bool; Virtual;
  108.     Procedure LibUnLink;     Virtual;
  109.   End;
  110.  
  111. Const
  112.   {SubClassDlg3d flags}
  113.   Ctl3D_Buttons     = $0001;
  114.   Ctl3D_ListBoxes   = $0002;
  115.   Ctl3D_Edits       = $0004;
  116.   Ctl3D_Combos      = $0008;
  117.   Ctl3D_StaticTexts = $0010;
  118.   Ctl3D_StaticFrames= $0020;
  119.   Ctl3D_NoDlgWindow =$10000;
  120.   Ctl3D_All         = $FFFF;
  121.  
  122.   wm_DlgBorder      = wm_User+3567;
  123.   {wm_DlgBorder return codes}
  124.   Ctl3D_NoBorder    = 0;
  125.   Ctl3D_Border      = 1;
  126.  
  127.   wm_DlgSubClass    = wm_User+3568;
  128.   {wm_DlgSubClass return codes}
  129.   Ctl3D_NoSubClass  = 0;
  130.   Ctl3D_SubClass    = 1;
  131.  
  132. Var
  133.   dBWCC: tBWCC;
  134.   dCtl3D: tCtl3D;
  135.  
  136. Implementation
  137. Uses
  138. {$IfDef Debug} Debug, {$EndIf}
  139.   Strings;
  140.  
  141. Procedure tFunctionCollection.FreeItem (Item: Pointer);
  142. Begin
  143.   With pFunction(Item)^ Do Begin
  144.     If PtrRec(Name).Seg<>0 Then
  145.       StrDispose(Name);
  146.   End;
  147.   Dispose(pFunction(Item))
  148. End;
  149.  
  150. Constructor tDll.Init (aName: pChar);
  151. Begin
  152.   Inherited Init;
  153.   FillChar(pChar(pChar(@Self)+2)^, SizeOf(Self) - SizeOf(tObject), 0);
  154.   ModuleName:= StrNew(aName);
  155.   ModuleHandle:= 0;
  156.   JumpSeg:= 0;
  157.   FunctionCollection:= New(pFunctionCollection, Init(10, 5));
  158.   Linked:= False;
  159.   WarnUser:= DefWarnUser;
  160.   InitProcs;
  161.   BuildProcsInfo
  162. End;
  163.  
  164. Destructor tDll.Done;
  165. Begin
  166.   LibUnLink;
  167.   If Assigned(ModuleName) Then Begin
  168.     StrDispose(ModuleName);
  169.     ModuleName:= Nil
  170.   End;
  171.   If Assigned(FunctionCollection) Then
  172.     Dispose(FunctionCollection, Done);
  173.   Inherited Done
  174. End;
  175.  
  176. Procedure tDLL.AddFunction (anAddr: Pointer; aName: pChar);
  177. Var
  178.   aFunction: pFunction;
  179. Begin
  180.   If Not Assigned(anAddr) Then
  181.     Exit;
  182.   aFunction:= New(pFunction);
  183.   With aFunction^ Do Begin
  184.     If PtrRec(aName).Seg<>0 Then
  185.       Name:= StrNew(aName)
  186.     Else
  187.       Name:= aName;
  188.     FuncVarAdr:= anAddr
  189.   End;
  190.   FunctionCollection^.Insert(aFunction)
  191. End;
  192.  
  193. Procedure tDLL.InitProcs;
  194. Begin
  195.   Abstract
  196. End;
  197.  
  198. Procedure tDLL.BuildProcsInfo;
  199. Var
  200.   p: pByte;
  201.   Count, o: Word;
  202.   i: Integer;
  203. Begin
  204.   Count:= FunctionCollection^.Count;
  205.   If Not Assigned(FunctionCollection) Or (Count<=0) Then
  206.     Exit;
  207.   p:= GlobalLock(GlobalAlloc(gMem_Fixed, Count*3+11));
  208.   If Not Assigned(p) Then
  209.     Exit;
  210.  
  211.   JumpSeg:= PtrRec(p).Seg;
  212.   o:= Count*3-3;
  213.   For i:= 0 To Count-1 Do Begin
  214.     pFunction(FunctionCollection^.At(i))^.FuncVarAdr^:= p;
  215.     p^:= $E8; Inc(p); pWord(p)^:= o; Inc(p,2);             {Call Label}
  216.     Dec(o, 3)
  217.   End;
  218.   {Label:}
  219.   {Push Seg(Self)} p^:= $68; Inc(p); pWord(p)^:= Seg(Self); Inc(p,2);
  220.   {Push Ofs(Self)} p^:= $68; Inc(p); pWord(p)^:= Ofs(Self); Inc(p,2);
  221.   {Call tDll.Link} p^:= $9A; Inc(p); pPointer(p)^:= @tDll.Link; Inc(p,4);
  222.   ChangeSelector(JumpSeg, JumpSeg)
  223. End;
  224.  
  225. Procedure tDll.Link (Index: Word);
  226. Var
  227.   LinkFunc: pPointer;
  228.   Tmp: Array[0..100] Of Char;
  229. Begin
  230.   Index:= (Index-3) Div 3;
  231.   If Linked Then Begin
  232. {$IfDef Debug} WriteLn('err ', StrPasEx(ModuleName),': method ',
  233.                        StrPasEx(pFunction(FunctionCollection^.At(Index))^.Name),
  234.                        ' not found.');
  235. {$EndIf}
  236.     StrCat(StrCat(StrCopy(Tmp, 'A function in module '), ModuleName),
  237.            #13' was not found. The file is probably'+
  238.            #13'missing or out of date.');
  239.     MessageBox(0, Tmp, 'Fatal Error', mb_IconExclamation+mb_Ok);
  240.     Halt
  241.   End;
  242.   LinkFunc:= pFunction(FunctionCollection^.At(Index))^.FuncVarAdr;
  243.   LibLink;
  244.   Linked:= True;
  245.   Asm
  246.     Les Di, LinkFunc
  247.     Mov Ax, Es:[Di]
  248.     Mov Dx, Es:[Di+2]
  249.     Mov [Bp+2], Ax     {change return offset}
  250.     Mov [Bp+4], Dx     {change return segment}
  251.   End
  252. End;
  253.  
  254. Procedure tDLL.RemoveLinkInfo;
  255. Begin
  256.   If Assigned(FunctionCollection) Then
  257.     Dispose(FunctionCollection, Done);
  258.   FunctionCollection:= Nil;
  259.   If JumpSeg<>0 Then Begin
  260.     ChangeSelector(JumpSeg, JumpSeg);
  261.     JumpSeg:= GlobalHandle(JumpSeg);
  262.     If JumpSeg<>0 Then Begin
  263.       GlobalUnLock(JumpSeg);
  264.       GlobalFree(JumpSeg)
  265.     End
  266.   End;
  267.   JumpSeg:= 0
  268. End;
  269.  
  270. Function tDll.LibLink: Bool;
  271. Var
  272.   prevMode: Word;
  273.   DiscardLinkInfo: Boolean;
  274.  
  275.   Procedure GetAddr (Item: pFunction); Far;
  276.   Var
  277.     Addr: Pointer;
  278.   Begin With Item^ Do Begin
  279.     Addr:= GetProcAddress(ModuleHandle, Name);
  280.     If Assigned(Addr) Then
  281.       FuncVarAdr^:= Addr
  282.     Else Begin
  283.       {$IfDef Debug} WriteLn('wn ', StrPasEx(ModuleName),': unable to link to ',StrPasEx(Name)); {$EndIf}
  284.       DiscardLinkInfo:= False
  285.     End;
  286.   End End;
  287. Begin
  288.   If ModuleHandle=0 Then Begin
  289.     prevMode:= SetErrorMode($8000); {SEM_NoOpenFileErrorBox}
  290.     ModuleHandle:= LoadLibrary(ModuleName);
  291.     SetErrorMode(prevMode);
  292.     If ModuleHandle<32 Then Begin
  293.       LibLink:= False;
  294.       ModuleHandle:= 0;
  295.       LibError;
  296.       Exit
  297.     End;
  298.     DiscardLinkInfo:= True;
  299.     FunctionCollection^.ForEach(@GetAddr);
  300.     If DiscardLinkInfo Then
  301.       RemoveLinkInfo
  302.   End;
  303.   LibLink:= LibPresent
  304. End;
  305.  
  306. Procedure tDll.LibUnLink;
  307. Begin
  308.   If ModuleHandle<>0 Then Begin
  309.     FreeLibrary(ModuleHandle);
  310.     ModuleHandle:= 0;
  311.     RemoveLinkInfo
  312.   End
  313. End;
  314.  
  315. Function tDll.LibPresent: Bool;
  316. Begin
  317.   LibPresent:= ModuleHandle<>0
  318. End;
  319.  
  320. Procedure tDll.LibError;
  321. Var
  322.   Tmp: Array[0..79] Of Char;
  323. Begin
  324.   {$IfDef Debug} WriteLn('wn ', StrPasEx(ModuleName),': unable to load DLL'); {$EndIf}
  325.   If WarnUser Then Begin
  326.     StrCopy(Tmp, 'Unable to load file ');
  327.     StrCat(Tmp, ModuleName);
  328.     MessageBox(0, Tmp, 'Warning', mb_IconHand+mb_Ok)
  329.   End
  330. End;
  331.  
  332. {- tBWCC}
  333.  
  334. Procedure tBWCC.InitProcs;
  335. Begin
  336.   AddFunction(@@SpecialLoadDialog,pChar(1));
  337.   AddFunction(@@DialogBox,        pChar(2));
  338.   AddFunction(@@DialogBoxParam,   pChar(3));
  339.   AddFunction(@@CreateDialog,     pChar(4));
  340.   AddFunction(@@CreateDialogParam,pChar(5));
  341.   AddFunction(@@DefDlgProc,       pChar(6));
  342.   AddFunction(@@MessageBox,       pChar(9));
  343.   AddFunction(@@GetPattern,       pChar(10));
  344.   AddFunction(@@GetVersion,       pChar(11));
  345.   AddFunction(@@MangleDialog,     pChar(12));
  346.   AddFunction(@@DefWindowProc,    pChar(14));
  347.   AddFunction(@@DefMdiChildProc,  pChar(15));
  348. End;
  349.  
  350. {- tCtl3D}
  351.  
  352. Procedure tCtl3D.InitProcs;
  353. Begin
  354.   AddFunction(@@GetVer,        pChar(1));
  355.   AddFunction(@@SubclassDlg,   pChar(2));
  356.   AddFunction(@@SubclassCtl,   pChar(3));
  357.   AddFunction(@@CtlColor,      pChar(4));
  358.   AddFunction(@@Enabled,       pChar(5));
  359.   AddFunction(@@ColorChange,   pChar(6));
  360.   AddFunction(@@Register,      pChar(12));
  361.   AddFunction(@@Unregister,    pChar(13));
  362.   AddFunction(@@AutoSubclass,  pChar(16));
  363.   AddFunction(@@CtlColorEx,    pChar(18));
  364.   AddFunction(@@DlgFramePaint, pChar(20));
  365.   AddFunction(@@SubClassDlgEx, pChar(21));
  366. End;
  367.  
  368. Function tCtl3D.LibLink: Bool;
  369. Begin
  370.   If Inherited LibLink Then
  371.     LibLink:= Register(System.hInstance)
  372.   Else
  373.     LibLink:= False
  374. End;
  375.  
  376. Procedure tCtl3D.LibUnLink;
  377. Begin
  378.   If ModuleHandle<>0 Then
  379.     UnRegister(System.hInstance);
  380.   Inherited LibUnLink
  381. End;
  382.  
  383. Var
  384.   PrevExit: Pointer;
  385. Procedure DynLinkExit; Far;
  386. Begin
  387.   ExitProc:= PrevExit;
  388.   dBWCC.Done;
  389.   dCtl3D.Done;
  390. End;
  391.  
  392. Begin
  393.   PrevExit:= ExitProc;
  394.   ExitProc:= @DynLinkExit;
  395.   dBWCC.Init('BWCC.DLL');
  396.   dCtl3D.Init('CTL3DV2.DLL');
  397. End.
  398.