浏览代码

+ win16 implementation of a dynlib manager in the system unit

git-svn-id: trunk@31893 -
nickysn 9 年之前
父节点
当前提交
01257267b8
共有 4 个文件被更改,包括 130 次插入0 次删除
  1. 2 0
      .gitattributes
  2. 101 0
      rtl/win16/sysdl.inc
  3. 24 0
      rtl/win16/sysdlh.inc
  4. 3 0
      rtl/win16/system.pp

+ 2 - 0
.gitattributes

@@ -9719,6 +9719,8 @@ rtl/win16/prt0s.asm svneol=native#text/plain
 rtl/win16/registers.inc svneol=native#text/plain
 rtl/win16/rtldefs.inc svneol=native#text/plain
 rtl/win16/sysdir.inc svneol=native#text/plain
+rtl/win16/sysdl.inc svneol=native#text/plain
+rtl/win16/sysdlh.inc svneol=native#text/plain
 rtl/win16/sysfile.inc svneol=native#text/plain
 rtl/win16/sysheap.inc svneol=native#text/plain
 rtl/win16/sysos.inc svneol=native#text/plain

+ 101 - 0
rtl/win16/sysdl.inc

@@ -0,0 +1,101 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    Implements OS dependent part for loading of dynamic libraries.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+var
+  LastLoadLibraryError: 0..HINSTANCE_ERROR;
+
+
+function SysLoadLibraryU(const Name : UnicodeString) : TlibHandle;
+begin
+  Result:=LoadLibrary(LPCSTR(AnsiString(Name)));
+  if Result<=HINSTANCE_ERROR then
+  begin
+    LastLoadLibraryError:=Result;
+    Result:=0;
+  end;
+end;
+
+function SysLoadLibraryA(const Name: RawByteString) : TLibHandle;
+begin
+  Result:=LoadLibrary(LPCSTR(Name));
+  if Result<=HINSTANCE_ERROR then
+  begin
+    LastLoadLibraryError:=Result;
+    Result:=0;
+  end;
+end;
+
+function SysGetProcedureAddress(Lib : TLibHandle; const ProcName : AnsiString) : FarPointer;
+begin
+  Result:=GetProcAddress(Lib,LPCSTR(ProcName));
+end;
+
+{$push}
+{$warn 4056 off}
+function SysGetProcedureAddressOrdinal(Lib : TLibHandle; Ordinal : TOrdinalEntry) : FarPointer;
+begin
+  Result:=GetProcAddress(Lib,LPCSTR(Ordinal));
+end;
+{$pop}
+
+function SysUnloadLibrary(Lib : TLibHandle) : Boolean;
+begin
+  FreeLibrary(Lib);
+  Result:=true;
+end;
+
+function SysGetLoadErrorStr: string;
+var
+  rc,c : integer;
+  temp: WideString;
+begin
+  case LastLoadLibraryError of
+    0: Result := 'System out of memory, executable file is corrupt, or contains invalid relocations';
+    2: Result := 'File not found';
+    3: Result := 'Path not found';
+    5: Result := 'Attempt was made to dynamically link to a task, or there was a sharing or network-protection error';
+    6: Result := 'Library requires separate data segments for each task';
+    8: Result := 'Insufficient memory to start the application';
+    10: Result := 'Incorrect Windows version';
+    11: Result := 'Invalid executable file. Either it is not a Windows application or there is an error in the .EXE image';
+    12: Result := 'Application is designed for a different operating system';
+    13: Result := 'Application is designed for MS-DOS 4.0';
+    14: Result := 'Type of executable is unknown';
+    15: Result := 'Cannot load a real-mode application (developed for an earlier version of Windows)';
+    16: Result := 'Cannot load a second instance of an executable file containing multiple data segments that are not marked read-only';
+    19: Result := 'Cannot load a compressed executable file. The file must be decompressed before it can be loaded';
+    20: Result := 'One of the DLLs required to run this application is corrupt';
+    21: Result := 'Application requires Microsoft Windows 32-bit extensions';
+    else
+      Result := 'Unknown error code';
+  end;
+  WriteStr(Result, '(', LastLoadLibraryError, ') - ', Result);
+end;
+
+const
+  SysDynLibsManager: TDynLibsManager = (
+    LoadLibraryU: @SysLoadLibraryU;
+    LoadLibraryA: @SysLoadLibraryA;
+    GetProcAddress: @SysGetProcedureAddress;
+    GetProcAddressOrdinal: @SysGetProcedureAddressOrdinal;
+    UnloadLibrary: @SysUnloadLibrary;
+    GetLoadErrorStr: @SysGetLoadErrorStr;
+  );
+
+procedure InitSystemDynLibs;
+begin
+  SetDynLibsManager(SysDynLibsManager);
+end;

+ 24 - 0
rtl/win16/sysdlh.inc

@@ -0,0 +1,24 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    Implements OS dependent part for loading of dynamic libraries.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+type
+  TLibHandle = THandle;
+  TOrdinalEntry = word;
+
+const
+  NilHandle = 0;
+// these are for easier crossplatform construction of dll names in dynloading libs.
+  SharedSuffix = 'DLL';
+

+ 3 - 0
rtl/win16/system.pp

@@ -15,6 +15,9 @@ interface
 
 {$DEFINE HAS_CMDLINE}
 
+{$DEFINE DISABLE_NO_DYNLIBS_MANAGER}
+{$DEFINE FPC_SYSTEM_HAS_SYSDLH}
+
 {$I systemh.inc}
 {$IFDEF FPC_X86_DATA_NEAR}
 {$I locheaph.inc}