标签: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.
标签:pch init stdcall array ons list procedure dll cad
原文地址:https://www.cnblogs.com/hnxxcxg/p/10504130.html