前端代码:
var
vParam:TParams;
sMsg:string;
sKindStr:string;
I:Integer;
begin
vParam:=TParams.Create;
try
AddParam(vParam,'THE_CNT',ftInteger,ptInput,kmtb_Check.RecordCount);
AddParam(vParam,'KIND_STR',ftString,ptInput,sKindStr);
try
ExcuteMySQLProcedure('AddArticlepreferential',vParam,sMsg);
except
on e: Exception do
begin
Application.MessageBox(PChar(sMsg),PChar('gevraagd'),MB_ICONERROR);
exit;
end;
end;
finally
freeAndNil(vParam);
end;
end;
function ExcuteMySQLProcedure(sProcedureName:string;var vParam:TParams;var sMsg:string):Boolean;
var
oleParam:OleVariant;
vData:Binary;
I:Integer;
begin
if trim(sProcedureName)='' then exit;
vData:=Binary.Create;
result:=false;
try
oleParam:=ParamsToVariant(vParam);
vData:=BinaryFromVariant(oleParam);
FService := (acsStdFuncDataModule.rmsMain as IacsDataService); // rest of the run on the server
//Call a stored procedure and return value
FService.ExecuteProcedure(sProcedureName,vData,sMsg);
vParam.Clear;
oleParam:=ReadVariantFromBinary(vData);
VariantToParams(oleParam,vParam);
result:=true;
finally
freeAndnil(vData);
end;
end;
服务端代码:
function ExecuteProcedure(const procedureName: AnsiString; var pParam: Binary; var sMsg: AnsiString): Boolean;
var
I:Integer;
vParam:TParams;
vData:OleVariant;
begin
Result := false;
if Trim(procedureName)='' then
begin
Result := false;
sMsg := GloRs_IDsSQLStrIsEmpty;
_WriteError(tLogError,GloRs_DataBaseErrorCode + GloRs_IDsSQLStrIsEmpty);
Exit;
end;
vParam:=TParams.Create;
try
vData:=ReadVariantFromBinary(pParam);
VariantToParams(vData,vParam);
with MyStoredProc1 do begin
try
Close;
StoredProcName:=procedureName;
Params.Clear;
for I:=0 to vParam.Count-1 do
begin
Params.CreateParam(vParam.Items[I].DataType,vParam.Items[I].Name,vParam.Items[I].ParamType);
ParamByName(vParam.Items[I].Name).Value:=vParam.Items[I].Value;
end;
ExecProc;
for I:=0 to vParam.Count-1 do
begin
if (vParam.Items[I].ParamType=ptOutput) or (vParam.Items[I].ParamType=ptInputOutput) then
begin
vParam.Items[I].Value :=ParamByName(vParam.Items[I].Name).AsString;
end;
end;
pParam.Clear;
vData:=ParamsToVariant(vParam);
WriteVariantToBinary(vData,pParam);
finally
MyStoredProc1.Close;
end;
end;
Result := true;
sMsg := GloRs_IDsSQLDSSuccess;
Except
on e: Exception do
begin
sMsg := GloRs_IDsGetData;
_WriteError(tLogError,GloRs_DataBaseErrorCode + GloRs_IDsGetData + e.Message);
_WriteError(tLogError,GloRs_IDsSQLError + procedureName);
Result := false;
end;
end;
end;
用到的函数:
procedure VariantToParams(input:OleVariant;par:TParams);
// TParam 's property: fieldType, paramName, ParamType, value, size
// paramType default value ptinput
// size = sizeof(value)
var
n, i:integer;
begin
try
n:=0;
i:=0;
par.Clear;
while VarArrayHighBound(input,1)>=(n+4)do
begin
par.CreateParam(TFieldType(input[n+1]),input[n+2],input[n+4]);
par.Items[i].Value := input[n+3];
par.Items[i].Size :=SizeOf(input[n+3]);
n:=n+4;
i:=i+1;
end;
except
Exit;
end;
end;
function ParamsToVariant(par:TParams): OleVariant;
// TParam 's property: fieldType, paramName, ParamType, value, size
// paramType default value ptinput
// size = sizeof(value)
var
tmpv:OleVariant;
n,i:integer;
begin
try
tmpv:=VarArrayCreate([1,par.Count*4],VarVariant);
n:=0;
i:=0;
while par.Count>i do
begin
tmpv[n+1]:=Ord(par.Items[i].DataType);
tmpv[n+2]:=par.Items[i].Name;
tmpv[n+3]:=par.Items[i].Value;
tmpv[n+4]:=par.Items[i].ParamType;
i:=i+1;
n:=n+4;
end;
result:=tmpv;
except
Exit;
end;
end;
procedure AddParam(Params: TParams; const ParamName: string;
DataType: TFieldType;ParamType:TParamType;Value: OleVariant);
// only for client load
var
p: TParam;
begin
try
p := Params.CreateParam(DataType, ParamName, ParamType);
p.Value := Value;
p.Size := SizeOf(Value);
except
exit;
end;
end;
其中ReadVariantFromBinary、WriteVariantToBinary、BinaryFromVariant函数用到RemObjects 的uROBinaryHelpers单元
分享到:
相关推荐
Delphi多层sql服务端实例 多线程 多实例 多层 初学者很有用处
最给力的Delphi多层分布式架构资料.chm
本代码介绍了如何给线程传递参数,以及用参数在主线程中显示数据
收集几个多层和SQL服务端与客户端开发实例,都挺简单,多层服务器在数据库系统开发中占有重要的地位,一些大型的软件系统基本都是建立在多层数据库基础上,你可通过这些简单的多层实例,为自己身更高深的方向发展做...
delphi的CreateAnonymousThreadX传递参数的匿名线程
使用Delphi实现的WebSocket服务端,完成了握手和数据的收发,没有处理除数据帧外的其他类型帧,可作为实现WebSocket服务器的参考。
Delphi多层分布式架构资料,值得学习参考,对于delphi三层开发很有帮助。
Delphi多层架构的ERP管理系统,运行时先运行服务端,配置好数据库服务器,然后再运行客户端,登录后即可进入ERP客户管理系统界面,本套系统采用MSSQL数据库。调试运行截图如上所示,为登录界面。
该文档实现DELPHI和.Net参数传递
自己的TCP/IP测试程序,Delphi XE10.2下可用,TCP/IP服务端及客户端程序。
一个实例让你明白什么是值传递和引用传递的!
完整源码 delphi客户端+JAVA服务端
Delphi多层开发方案比较 方案-> Midas DCOM COM+ ASTA RemoteObject .NET
Delphi多层开发解决方案 RemoteAdo
Delphi多层一对一数据库服务器、客户端程序示例集,包括服务器端和客户端程序,服务器端与客户端实现查询、别名集、客户计数、一对多表的服务器程序等,由于某些应用程序执行模式是 Multiple Instance执行模式,所以...
DELPHI多层分布式开发 分布式多层数据库开发简介 Delphi提出的MIDAS(Multi-Tier distributed Application Services Suite多层分布式应用服务器组),是把原来Two- Tier数据连接放到了服务器端的COM组件上,...
传奇服务端代码
DELPHI用参数传递函数的实例..rar
Delphi程序间消息传递 使用该消息涉及一个TcopyDataStruct结构类型的指针。该结构中有三个成员: dwData 是一个32位的附加参数 cbData 表示要传递的数据区的大小 lpData 表示要传递的数据区的指针 下面举个例子。该...