delphi6直连redis服务(用lua脚本redis模块)

news2024/11/26 7:31:48

一、创建一个exe程序

        创建一个exe程序,引用LuaRedis.pas单元(此单元自己封装的代码,目前主要封装了获取key和设置key/value功能),代码如下:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    btn2: TButton;
    Memo1: TMemo;
    edt1: TEdit;
    edt2: TEdit;
    edt3: TEdit;
    btn3: TButton;
    edt4: TEdit;
    procedure btn2Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses
  LuaRedis;
  
{$R *.dfm}

procedure TForm1.btn2Click(Sender: TObject);
var
  sTmp, sErrorMsg: string;
begin
  Memo1.Text := '';
  try
    sTmp := getValue(Trim(edt1.Text), sErrorMsg);    // value111
    Memo1.Text := sTmp + '->' + sErrorMsg;
  except
    on e:Exception do begin
      ShowMessage('【异常】' + e.Message);
      Exit;
    end;
  end;
end;

procedure TForm1.btn3Click(Sender: TObject);
var
  sKey, sValue, sErrorMsg: string;
begin
  Memo1.Text := '';
  try
    sKey := Trim(edt2.Text);
    if setKeyValue(sKey, Trim(edt3.Text), StrToIntDef(Trim(edt4.Text), 0), sErrorMsg) then begin   // key111  value111
      sValue := getValue(Trim(edt2.Text), sErrorMsg);
    end;
    Memo1.Text := sKey + ':' + sValue + '->' + sErrorMsg;
  except
    on e:Exception do begin
      ShowMessage('【异常】' + e.Message);
      Exit;
    end;
  end;
end;

end.

二、封装LuaRedis.pas单元代码

        上面说的封装LuaRedis.pas单元(通过registerLuaState()和destroyLuaState()来加载和销毁lua的状态机),同时引用Lua.pas, LuaLib.pas单元,代码如下:

unit LuaRedis;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Lua, LuaLib;

const
  C_LuaPathFileName = './luaScript/mytest.lua';

function getValue(myKey: string; var sErrorMsg: string): string;

function setKeyValue(myKey, myValue: string; myExpire: Integer; var sErrorMsg: string): Boolean;

var
  LuaObj: TLua;
  L: TLuaState;

implementation

function loadLuaScript(sLuaPathFileName: String; var sErrorMsg: string): Boolean;
var
  nTmp: Integer;
begin
  Result := False;
  try
    sErrorMsg := '默认提示消息(loadLuaScript)!';
    if not FileExists(sLuaPathFileName) then begin
      sErrorMsg := '未查到路径中此Lua脚本文件(' + sLuaPathFileName + ')';
      Exit;
    end;
    nTmp := LuaObj.DoFile(sLuaPathFileName);
    case nTmp of
      LUA_OK : begin
        sErrorMsg := '成功加载路径中此Lua脚本文件!';
        Result := True;
      end;
      LUA_ERRSYNTAX : sErrorMsg := '在预编译Lua文件时发现了语法错误!';
      LUA_ERRMEM : sErrorMsg := '在执行Lua文件时内存分配错误!';
      LUA_ERRRUN : sErrorMsg := '在执行Lua文件中在调用函数时发生了运行时错误!';
      else
      sErrorMsg := '加载失败路径中此Lua脚本文件!';
    end;
  except
    on e:Exception do begin
      Result := False;
      sErrorMsg := '【异常】方法(loadLuaScript):' + e.Message;
      Exit;
    end;
  end;
end;

function getValue(myKey: string; var sErrorMsg: string): string;
var
  nRet: Integer;
begin
  try
    sErrorMsg := '默认提示消息(getValue)!';
    if not loadLuaScript(C_LuaPathFileName, sErrorMsg) then begin
      Exit;
    end;
    lua_getglobal(L, 'getValue');
    lua_pushstring(L, PAnsiChar(myKey));
    nRet := lua_pcall(L, 1, 1, 0);
    if nRet = 0 then begin
      Result := lua_toString(L, -1);
      sErrorMsg := 'Lua脚本正常执行';
      Exit;
    end else
      sErrorMsg := 'Lua脚本执行失败!';
  except
    on e:Exception do begin
      Result := '';
      sErrorMsg := '【异常】方法(getValue):' + e.Message;
      Exit;
    end;
  end;
end;

function setKeyValue(myKey, myValue: string; myExpire: Integer; var sErrorMsg: string): Boolean;
var
  nRet: Integer;
begin
  Result := False;
  try
    sErrorMsg := '默认提示消息(setKeyValue)!';
    if not loadLuaScript(C_LuaPathFileName, sErrorMsg) then begin
      Exit;
    end;
   
    lua_getglobal(L, 'setKeyValue');
    lua_pushstring(L, PAnsiChar(myKey));
    lua_pushstring(L, PAnsiChar(myValue));
    lua_pushinteger(L, myExpire);
    nRet := lua_pcall(L, 3, 1, 0);
    if nRet = 0 then begin
      Result := (lua_toInteger(L, -1) = 1);
      sErrorMsg := 'Lua脚本正常执行';
      Exit;
    end else
      sErrorMsg := 'Lua脚本执行失败!';
  except
    on e:Exception do begin
      Result := False;
      sErrorMsg := '【异常】方法(setKeyValue):' + e.Message;
      Exit;
    end;
  end;
end;

procedure registerLuaState();
begin
  if LuaObj = nil then begin
    LuaObj := TLua.Create;
    if L = nil then begin
      L := LuaObj.LuaInstance;
    end;
    // luaL_openlibs 是一个由 luaL(Lua 实用程序库)提供的函数,它用于打开一组标准的Lua库。
    // 这些库通常包括基础库(base)、字符串处理库(string)、表操作库(table)、数学函数库(math)、I/O库(io)、操作系统库(os)等。
    // 这个函数通常在你的C/C++程序中与Lua交互时使用,以提供完整的Lua标准库功能。
    luaL_openlibs(L);
  end;
end;

procedure destroyLuaState();
begin
  if LuaObj <> nil then begin
    if L <> nil then begin
      L := nil;
    end;
    LuaObj.Free;
  end;
end;

initialization
  registerLuaState();

finalization
  destroyLuaState();

end.

三、封装的Lua, LuaLib单元

        封装的Lua, LuaLib单元,代码如下:

{ 
/** 
 * @package     Delphi Lua 
 * @copyright   Copyright (c) 2009 Dennis D. Spreen (http://www.spreendigital.de/blog) 
 * @license     http://opensource.org/licenses/gpl-license.php GNU Public License 
 * @author      Dennis D. Spreen <dennis@spreendigital.de> 
 * @version     1.3 
 * @revision    $Id: Lua.pas 102 2009-09-30 11:39:41Z dennis.spreen $ 
 */ 
 
History 
1.3     DS      Improved Callback, now uses pointer instead of object index 
                Modified RegisterFunctions to allow methods from other class 
                to be registered, moved object table into TLua class 
1.2 DS  Added example on how to extend lua with a delphi dll 
1.1     DS      Improved global object table, this optimizes the delphi 
                function calls 
1.0     DS      Initial Release 
 
Copyright 2009  Dennis D. Spreen (email : dennis@spreendigital.de) 
 
This program is free software; you can redistribute it and/or modify 
it under the terms of the GNU General Public License as published by 
the Free Software Foundation; either version 2 of the License, or 
(at your option) any later version. 
 
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.  See the 
GNU General Public License for more details. 
 
You should have received a copy of the GNU General Public License 
along with this program; if not, write to the Free Software 
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA 
}  
  
unit Lua;  
  
interface  
  
uses  
  Classes,  
  LuaLib;  
  
type  
  TLuaState = Lua_State;  
  
  TLua = class(TObject)  
  private  
    fAutoRegister: Boolean;  
    CallbackList: TList;  // internal callback list  
  public  
    LuaInstance: TLuaState;  // Lua instance  
    constructor Create(AutoRegister: Boolean = True); overload; virtual;  
    destructor Destroy; override;  
    function DoFile(Filename: String): Integer; virtual;// load file and execute  
    procedure RegisterFunction(FuncName: AnsiString; MethodName: AnsiString = ''; Obj: TObject = NIL); virtual; //register function  
    procedure AutoRegisterFunctions(Obj: TObject);  // register all published functions  
    procedure UnregisterFunctions(Obj: TObject); // unregister all object functions  
  end;  
  
implementation  
  
type  
  TProc = function(L: TLuaState): Integer of object; // Lua Function  
  
  TCallback = class  
    Routine: TMethod;  // Code and Data for the method  
    Exec: TProc;       // Resulting execution function  
  end;  
  
//  
// This function is called by Lua, it extracts the object by  
// pointer to the objects method by name, which is then called.  
//  
// @param       Lua_State   L   Pointer to Lua instance  
// @return      Integer         Number of result arguments on stack  
//  
function LuaCallBack(L: Lua_State): Integer; cdecl;  
var  
  CallBack: TCallBack;       // The Object stored in the Object Table  
begin  
  // Retrieve first Closure Value (=Object Pointer)  
  CallBack := lua_topointer(L, lua_upvalueindex(1));  
  
  // Execute only if Object is valid  
  if (assigned(CallBack) and assigned(CallBack.Exec)) then  
    Result := CallBack.Exec(L)  
  else  
    Result := 0;  
end;  
  
{ TLua }  
  
//  
// Create a new Lua instance and optionally create Lua functions  
//  
// @param       Boolean      AutoRegister       (optional)  
// @return      TLua                            Lua Instance  
//  
constructor TLua.Create(AutoRegister: Boolean = True);
begin  
  inherited Create;  
  // Load Lua Lib if not already done  
  if (not LuaLibLoaded) then  
    LoadLuaLib();  
  
  // Open Library  
  LuaInstance := Lua_Open();  
  luaopen_base(LuaInstance);  
  
  fAutoRegister := AutoRegister;  
  
  // Create Object List on initialization  
  CallBackList := TList.Create;  
  
  // if set then register published functions  
  if (AutoRegister) then  
    AutoRegisterFunctions(self);  
end;  
  
//  
// Dispose Lua instance  
//  
destructor TLua.Destroy;  
begin  
  // Unregister all functions if previously autoregistered  
  if (fAutoRegister) then  
    UnregisterFunctions(Self);  
  
  // dispose Object List on finalization  
  CallBackList.Free;  
  
  // Close instance  
  Lua_Close(LuaInstance);  
  inherited;  
end;  
  
//  
// Wrapper for Lua File load and Execution  
//  
// @param       String  Filename        Lua Script file name  
// @return      Integer  
//  
function TLua.DoFile(Filename: String): Integer;  
begin  
  Result := lual_dofile(LuaInstance, PAnsiChar(AnsiString(Filename)));  
end;  
  
//  
// Register a new Lua Function and map it to the Objects method name  
//  
// @param       AnsiString      FuncName        Lua Function Name  
// @param       AnsiString      MethodName      (optional) Objects Method name  
//  
procedure TLua.RegisterFunction(FuncName: AnsiString; MethodName: AnsiString = ''; Obj: TObject = NIL);  
var  
  CallBack: TCallBack; // Callback Object  
begin  
  // if method name not specified use Lua function name  
  if (MethodName = '') then  
    MethodName := FuncName;  
  
  // if not object specified use this object  
  if (Obj = NIL) then  
    Obj := Self;  
  
  // Add Callback Object to the Object Index  
  CallBack := TCallBack.Create;  
  CallBack.Routine.Data := Obj;  
  CallBack.Routine.Code := Obj.MethodAddress(String(MethodName));  
  CallBack.Exec := TProc(CallBack.Routine);  
  CallbackList.Add(CallBack);  
  
  // prepare Closure value (Method Name)  
  lua_pushstring(LuaInstance, PAnsiChar(FuncName));  
  
  // prepare Closure value (CallBack Object Pointer)  
  lua_pushlightuserdata(LuaInstance, CallBack);  
  
  // set new Lua function with Closure value  
  lua_pushcclosure(LuaInstance, LuaCallBack, 1);  
  lua_settable(LuaInstance, LUA_GLOBALSINDEX);  
end;  
  
//  
// UnRegister all new Lua Function  
//  
// @param       TObject     Object      Object with prev registered lua functions  
//  
procedure TLua.UnregisterFunctions(Obj: TObject);  
var  
  I: Integer;  
  CallBack: TCallBack;  
begin  
  // remove obj from object list  
  for I := CallBackList.Count downto 1 do  
  begin  
    CallBack := CallBackList[I-1];  
    if (assigned(CallBack)) and (CallBack.Routine.Data = Obj) then  
    begin  
      CallBack.Free;  
      CallBackList.Items[I-1] := NIL;  
      CallBackList.Delete(I-1);  
    end;  
  end;  
end;  
  
//  
// Registe

本文来自互联网用户投稿,该文观点仅代表作者本人,不代表本站立场。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如若转载,请注明出处:http://www.coloradmin.cn/o/1652265.html

如若内容造成侵权/违法违规/事实不符,请联系多彩编程网进行投诉反馈,一经查实,立即删除!

相关文章

gitee分支代码推送失败>> error: failed to push some refs to ‘https://gitee.com/xxx/xxx.git‘

错误 将代码推送到gitee时候出现下面的报错&#xff0c;终端输出 remote: Powered by GITEE.COM [GNK-6.4] remote: error: GE007: Your push would publish a private email address. remote: You can make your email public or disable this protection by visiting: remo…

自动驾驶主流芯片及平台架构(三)低算力平台

前面有提到&#xff0c;自动驾驶等级每增加一级&#xff0c;所需要的芯片算力就会呈现十数倍的上升&#xff0c;L2级自动驾驶的算力需求仅要求2-2.5TOPS&#xff0c;但是L3级自动驾驶算力需求就需要20-30TOPS,到L4级需要200TOPS以上&#xff0c;L5级别算力需求则超过2000TOPS。…

Rabbit延迟队列实现---插件实现

自行百度如何安装rabbitmq 点击链接下载rabbitmq插件找到rabbitmq_delayed_message_exchange&#xff0c;点击Releases 找到自己mq版本对应下载 移动到rabbitmq目录下plugins 执行命令rabbitmq-plugins.bat enable rabbitmq_delayed_message_exchange安装插件 此时就会出现x-d…

【mysql】mysql单表查询、多表查询、分组查询、子查询等案例详细解析

✨✨ 欢迎大家来到景天科技苑✨✨ &#x1f388;&#x1f388; 养成好习惯&#xff0c;先赞后看哦~&#x1f388;&#x1f388; &#x1f3c6; 作者简介&#xff1a;景天科技苑 &#x1f3c6;《头衔》&#xff1a;大厂架构师&#xff0c;华为云开发者社区专家博主&#xff0c;…

红帽发布Red Hat Enterprise Linux AI(RHEL AI)

红帽 2024 峰会正在科罗拉多州丹佛市举行…鉴于当前的时代背景&#xff0c;人工智能&#xff08;AI&#xff09;在此次峰会上占据了重要位置&#xff0c;因此红帽公司&#xff08;Red Hat&#xff09;也不甘人后宣布推出 RHEL AI。 红帽公司今天发布了 Red Hat Enterprise Lin…

Pytorch入门—Tensors张量的学习

Tensors张量的学习 张量是一种特殊的数据结构&#xff0c;与数组和矩阵非常相似。在PyTorch中&#xff0c;我们使用张量来编码模型的输入和输出&#xff0c;以及模型的参数。 张量类似于NumPy的ndarrays&#xff0c;只是张量可以在GPU或其他硬件加速器上运行。事实上&#xf…

QT7_视频知识点笔记_2_对话框,布局,按钮,控件(查看帮助文档找功能函数)

第二天&#xff1a; 对话框&#xff0c;布局&#xff0c;按钮 QMainWindow&#xff1a;菜单下拉框添加之后可通过ui->actionXXX&#xff08;自定义的选项名&#xff09;访问&#xff0c;用信号triggered发出信号&#xff0c;槽函数可以使用lambda表达式进行 //菜单栏&am…

JavaEE概述 + Maven

文章目录 一、JavaEE 概述二、工具 --- Maven2.1 Maven功能 仓库 坐标2.2 Maven之项目构建2.3 Maven之依赖管理 三、插件 --- Maven Helper 一、JavaEE 概述 Java SE、JavaEE&#xff1a; Java SE&#xff1a;指Java标准版&#xff0c;适用于各行各业&#xff0c;主要是Java…

【Python】机器学习之Sklearn基础教程大纲

机器学习之Sklearn基础教程大纲 1. 引言 机器学习简介Scikit-learn&#xff08;Sklearn&#xff09;库介绍安装和配置Sklearn 2. 数据预处理 2.1 数据加载与查看 - 加载CSV、Excel等格式的数据- 查看数据的基本信息&#xff08;如形状、数据类型等&#xff09;2.2 数据清洗…

3套Matplotlib主题

分享3套Matplotlib主题&#xff0c;让图表更好看 seaborn默认主题 import seaborn as sns import pandas as pd import matplotlib as mpltips pd.read_csv(./sns_data/tips.csv)sns.relplot(datatips,x"消费金额 ($)",y"小费金额 ($)",hue"客人性…

风速变送器

风速变送器&#xff08;脉冲型&#xff09; 变送器转1圈&#xff0c;输出20个脉冲。 例如&#xff0c;当风速变送器1S转一圈时&#xff0c;此时变送器1S输出20个脉冲&#xff0c;代表风速为1.75m/S。

Mitmproxy 抓包工具安装使用

简介 Mitmproxy是一个使用python编写的中间人代理工具&#xff0c;跟Fiddle、Charles等等的抓包工具是差不多的&#xff0c;同样可以用于拦截、修改、保存http/https请求。比起Fiddle、Charles&#xff0c;mitmproxy有一个最大的特点是支持python自定义脚本。 安装 Win 官网…

Llama3-Tutorial之Llama3 Agent能力体验+微调(Lagent版)

Llama3-Tutorial之Llama3 Agent能力体验微调&#xff08;Lagent版&#xff09; 参考&#xff1a; https://github.com/SmartFlowAI/Llama3-Tutorial 1. 微调过程 使用XTuner在Agent-FLAN数据集上微调Llama3-8B-Instruct&#xff0c;以让 Llama3-8B-Instruct 模型获得智能体能力…

WinForm中防页面假死的loading提示

如果在WinForm中执行一个长时间操作时&#xff0c;窗体就会被锁死&#xff0c;直到操作完成&#xff0c;对于操作者的体验就是死锁状态&#xff0c;那在.NET&#xff08;.net 5以后&#xff09;中&#xff0c;怎么实现一个并发&#xff0c;等待&#xff0c;且同步操作信息窗口呢…

PLM系统推荐:产品全生命周期管理最佳解决方案

PLM系统推荐&#xff1a;产品全生命周期管理最佳解决方案 在当今日益竞争激烈的市场环境中&#xff0c;企业如何高效管理其产品设计、开发和生命周期变得尤为重要。产品生命周期管理&#xff08;PLM&#xff09;系统正是为解决这一难题而诞生的。本文将为您详细介绍几款值得推荐…

unreal engine5.3.2 Quixel bridge无法登陆

UE5系列文章目录 文章目录 UE5系列文章目录前言一、问题定位二、解决方法 前言 这几天unreal engine5.3.2 Quixel bridge无法登陆&#xff0c;输入epic 账号和密码&#xff0c;然后在输入epic发送的验证码&#xff0c;总是提示登录失败。就算是使用科学上网依然无法登录。而且…

【Linux进程间通信(五)】System V 信号量

&#xff08;一&#xff09;什么是信号量 互斥相关概念 1、并发&#xff1a; 2、互斥 3、临界资源&临界区 4、原子性 &#xff08;二&#xff09;信号量的理解 &#xff08;三&#xff09;信号量的两种基本操作 P / V &#xff08;四&#xff09;信号量的内核数据结…

列表、字典推导式介绍和用法|lambda的介绍和用法

列表、字典推导式介绍和用法|lambda的介绍和用法 列表推导式示例应用与传统写法代码行数直观比较 字典推导式示例应用 lambda示例应用 列表推导式、字典推导式、lambda使用简洁语法进行代码的编写 列表推导式 用于快速创建新的列表&#xff0c;通过对现有列表进行迭代和筛选。…

pytest(二):关于pytest自动化脚本编写中,初始化方式setup_class与fixture的对比

一、自动化脚本实例对比 下面是一条用例,使用pytest框架,放在一个类中,两种实现方式: 1.1 setup_class初始化方式 1. 优点: 代码结构清晰,setup_class 和 teardown_class 看起来像传统的类级别的 setup 和 teardown 方法。2. 缺点: 使用 autouse=True 的 fixture 作为…

文件夹名称大小写转换:名称首字母转大写,一种高效的文件管理方法

在日常生活和工作中&#xff0c;电脑文件夹的管理对于提高工作效率和文件检索的便捷性至关重要。文件夹名称的命名规则直接影响到文件组织的有序性和查找的速度。其中&#xff0c;将文件夹名称的首字母转换为大写是一种简单而高效的管理方法&#xff0c;下面我们就来详细探讨实…