码迷,mamicode.com
首页 > 其他好文 > 详细

dll通用操作单元

时间:2019-03-10 09:18:13      阅读:179      评论:0      收藏:0      [点我收藏+]

标签:pch   init   stdcall   array   ons   list   procedure   dll   cad   

dll通用操作单元

/// <author>cxg 2019-3-4</author>
/// 装载(释放)DLL
/// 适用于Delphi所有版本

unit ynDLL;

interface

uses
  Classes, Windows, SysUtils;

type
  TDll = record
    dllName: string;
    dllHandle: Cardinal;
  end;

var
  dllList: array of TDll;

type
  TynFun = function(params: string): string; stdcall;
/// <summary>
/// 执行指名DLL里面的指名函数
/// </summary>
/// <param name="dllName">DLL文件名</param>
/// <param name="procName">函数名</param>
/// <param name="inParams">函数入参</param>
/// <returns>结果</returns>

function ExecDllProc(const dllName, procName, inParams: string): string;
/// <summary>
/// 释放所有加载的DLL
/// </summary>

procedure FreeDllList;
/// <summary>
/// 获取指定文件夹里面的所有文件名,不包括其子文件夹
/// </summary>
/// <param name="path">文件夹</param>
/// <param name="ext">文件扩展名,默认是所有类型</param>
/// <returns></returns>

function SearchFiles(path: string; ext: string = ‘*.*‘): TStringList;
/// <summary>
/// 加载指名文件夹里面的所有DLL
/// </summary>
/// <param name="path">文件夹</param>

procedure LoadAllDll(path: string);

implementation

function SearchFiles(path: string; ext: string = ‘*.*‘): TStringList;
var
  SearchRec: TSearchRec;
  found: integer;
begin
  Result := TStringList.Create;
  found := FindFirst(path + ‘\‘ + ext, faAnyFile, SearchRec);
  while found = 0 do
  begin
    if (SearchRec.Name <> ‘.‘) and (SearchRec.Name <> ‘..‘) and (SearchRec.Attr <> faDirectory) then
      Result.Add(SearchRec.Name);
    found := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
end;

procedure FreeDllList;
var
  i: integer;
begin
  for i := Low(dllList) to High(dllList) do
  begin
    FreeLibrary(dllList[i].dllHandle);
  end;
end;

procedure LoadAllDll(path: string);
var
  list: TStringList;
  fullName: string;
  i: integer;
  handle: Cardinal;
  dll: TDll;
begin
  list := SearchFiles(path, ‘*.dll‘);
  SetLength(dllList, list.Count);
  for i := 0 to list.Count - 1 do
  begin
    fullName := path + ‘\‘ + list[i];
    handle := LoadLibrary(PChar(fullName));
    if handle <> 0 then
    begin
      dll.dllName := list[i];
      dll.dllHandle := handle;
      dllList[i] := dll;
    end;    
  end;  
  if Assigned(list) then
    list.Free;
end;

function ExecDllProc(const dllName, procName, inParams: string): string;
var
  LHandle: Cardinal;
  LPointer: Pointer;
  LDll: TDll;
  LSize: Integer;

  function ExistDll(const dll: string): Cardinal;
  var
    i: Integer;
    s: string;
  begin
    result := 0;
    s := ExtractFileName(dll);
    for i := 0 to High(dllList) do
    begin
      if SameText(s, dllList[i].dllName) then
      begin
        result := dllList[i].dllHandle;
        Exit;
      end;
    end;
  end;

begin
  Result := ‘‘;
  if (dllName = ‘‘) or (procName = ‘‘) then
    Exit;
  LHandle := ExistDll(dllName);
  if LHandle = 0 then
  begin
    if LHandle = 0 then                         // dll not loaded
    try
      LHandle := LoadLibrary(PChar(dllName));     // load dll
      LDll.dllName := ExtractFileName(dllName);
      LDll.dllHandle := LHandle;
      LSize := High(dllList);
      if LSize = -1 then             // dllList not init
      begin
        SetLength(dllList, 1);
        dllList[0] := LDll;
      end
      else
      begin
        SetLength(dllList, LSize + 2);
        dllList[LSize] := LDll;
      end;
      LPointer := GetProcAddress(LHandle, PChar(procName)); // load function
      if LPointer <> nil then
      begin
        Result := TynFun(LPointer)(inParams)            // execute function and get result
      end;
    except
      FreeLibrary(LHandle);
    end;
  end
  else
  begin                                                   // dll is loaded
    LPointer := GetProcAddress(LHandle, PChar(procName)); // load function
    if LPointer <> nil then
    begin
      Result := TynFun(LPointer)(inParams)                // execute function and get result
    end;
  end;
end;

end.

  

dll通用操作单元

标签:pch   init   stdcall   array   ons   list   procedure   dll   cad   

原文地址:https://www.cnblogs.com/hnxxcxg/p/10504130.html

(0)
(0)
   
举报
评论 一句话评论(0
登录后才能评论!
© 2014 mamicode.com 版权所有  联系我们:gaon5@hotmail.com
迷上了代码!