📄 tkglserver_p.pas
字号:
unit tkglserver_p;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,
DBClient, tkglsvr_TLB, StdVcl, DB, ADODB, newadodb, Provider, forms;
type
Ttkglserver = class(TRemoteDataModule, Itkglserver)
adodb: Tnewadodb;
qry1: TADOQuery;
qry2: TADOQuery;
qry3: TADOQuery;
qry4: TADOQuery;
qry5: TADOQuery;
qry6: TADOQuery;
qry7: TADOQuery;
qry8: TADOQuery;
qry9: TADOQuery;
qry10: TADOQuery;
qry11: TADOQuery;
qry12: TADOQuery;
qry13: TADOQuery;
qry14: TADOQuery;
qry15: TADOQuery;
qry16: TADOQuery;
dsp1: TDataSetProvider;
dsp2: TDataSetProvider;
dsp3: TDataSetProvider;
dsp4: TDataSetProvider;
dsp5: TDataSetProvider;
dsp6: TDataSetProvider;
dsp7: TDataSetProvider;
dsp8: TDataSetProvider;
dsp9: TDataSetProvider;
dsp10: TDataSetProvider;
dsp11: TDataSetProvider;
dsp12: TDataSetProvider;
dsp13: TDataSetProvider;
dsp14: TDataSetProvider;
cds: TClientDataSet;
CDS1: TClientDataSet;
procedure addksmd(tkbh: Integer; ksbh: Integer; const zkzh: WideString; const xm: WideString;
xb: Integer; const sfzh: WideString; const lxfs: WideString;const lxdz: WideString;
var err: OleVariant); safecall; //添加考生
procedure adddfjl(tkbh: Integer; sjbh: Integer; const dfjl: WideString; qsfw: Integer;
jzfw: Integer; var err: OleVariant); safecall; //添加得分结论
procedure RemoteDataModuleCreate(Sender: TObject);
procedure RemoteDataModuleDestroy(Sender: TObject);
procedure getdata(const sSQL: WideString; var vData: OleVariant); safecall;//获取数据
procedure ExecSqls(const sSql: WideString); safecall; //执行SQL
procedure chkusr(const usrid: WideString; const usrpwd: WideString; var usrrgts: OleVariant); safecall;//检查用户
procedure isreged(const usrid: WideString; var betrue: OleVariant); safecall; //检查用户登录名称是否注册
procedure addtree(tkbh: Integer; const parentid: WideString; const nodetext: WideString; var isok: OleVariant); safecall;
procedure addlib(const dlmc:WideString;tklx:Integer;const tkmc:WideString;var tkbh:OleVariant;var err:OleVariant);safecall;
procedure addst(df1: Integer; df2: Integer; df3: Integer; df4: Integer;var stnr: OleVariant;
var err: OleVariant); safecall;//添加、修改试题
procedure scst(tkbh: Integer; stbh: Integer; var err: OleVariant); safecall;//删除试题
private
{ Private declarations }
protected
class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
public
{ Public declarations }
end;
implementation
uses svrmain_p;
{$R *.DFM}
class procedure Ttkglserver.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
begin
if Register then
begin
inherited UpdateRegistry(Register, ClassID, ProgID);
EnableSocketTransport(ClassID);
EnableWebTransport(ClassID);
end else
begin
DisableSocketTransport(ClassID);
DisableWebTransport(ClassID);
inherited UpdateRegistry(Register, ClassID, ProgID);
end;
end;
procedure Ttkglserver.RemoteDataModuleCreate(Sender: TObject);
var vrt:olevariant;
begin
adodb.AutoLoadCfg:=false;
adodb.AutoLoadCfg:=true;
try
adodb.Open;
except
on e:exception do
begin
application.MessageBox(pchar('无法连接数据库！'+#13+#13+e.Message),'错误信息',16);
abort;
end;
end;
end;
procedure Ttkglserver.RemoteDataModuleDestroy(Sender: TObject);
begin
adodb.Close;
end;
procedure Ttkglserver.getdata(const sSQL: WideString; var vData: OleVariant); safecall;
begin
qry1.Close;
qry1.SQL.Text:=sSql;
try
qry1.Open;
cds.Active:=false;
cds.Active:=true;
vData:=cds.Data;
finally
cds.Close;
qry1.Close;
end;
end;
procedure Ttkglserver.ExecSqls(const sSql: WideString); safecall;
begin
if sSql='' then
begin
exit;
end;
try
qry15.Close;
qry15.SQL.Text:=sSQl;
qry15.ExecSQL;
except
on e:exception do
begin
application.MessageBox(pchar('数据处理失败！'+#13+#13+e.Message),'错误信息',16);
end;
end;
end;
procedure Ttkglserver.chkusr(const usrid: WideString; const usrpwd: WideString; var usrrgts: OleVariant); safecall;
begin
qry15.Close;
qry15.SQL.Text:='select ryqx from x_yhb where dlmc='''+usrid+''' and dlmm='''+usrpwd+''' and sybj=0';
usrrgts:=-1;
try
qry15.Open;
if not qry15.IsEmpty then usrrgts:=qry15.Fields[0].asinteger;
finally
qry15.Close;
end;
end;
procedure Ttkglserver.isreged(const usrid: WideString; var betrue: OleVariant); safecall;
begin
qry15.Close;
qry15.SQL.Text:='select dlmc from x_yhb where dlmc='''+usrid+'''';
try
qry15.Open;
if not qry15.IsEmpty then betrue:=1 else betrue:=0;
finally
qry15.Close;
end;
end;
procedure Ttkglserver.addtree(tkbh:Integer; const parentid: WideString; const nodetext: WideString; var isok: OleVariant); safecall;
//添加章节、知识点
var zjbh:string;
i,n:integer;
begin
isok:=-1;
qry15.close;
qry15.SQL.Text:='select kcfw from k_stfwb where kcfw like :bh and len(kcfw)=:cd order by kcfw';
qry15.Parameters.ParamByName('bh').Value:=parentid+'%';
n:=length(parentid);
qry15.Parameters.ParamByName('cd').Value:=n+2;
try
qry15.Open;
if qry15.RecordCount>99 then abort;//每级编号从 00到99共100个，超过之后就不允许再建
if not qry15.IsEmpty then
begin
i:=0;
while not qry15.Eof do
begin
zjbh:=copy(trim(qry15.Fields[0].asstring),n+1,2);
if i<>strtoint(zjbh) then break;
inc(i);
qry15.Next;
end;
if i>99 then abort;
if i<10 then zjbh:=parentid+'0'+inttostr(i)
else zjbh:=parentid+inttostr(i);
end
else zjbh:=parentid+'00';
qry16.Close;
qry16.SQL.Text:='insert into k_stfwb values(:tkbh,:zjbh,:zjmc)';
qry16.Parameters.ParamByName('tkbh').Value:=tkbh;
qry16.Parameters.ParamByName('zjbh').Value:=zjbh;
qry16.Parameters.ParamByName('zjmc').Value:=nodetext;
try
qry16.ExecSQL;
except
abort;
end;
isok:=zjbh;
finally
qry15.Close;
end;
end;
procedure Ttkglserver.addlib(const dlmc: WideString; tklx: Integer; const tkmc: WideString;
var tkbh: OleVariant; var err: OleVariant); safecall;
begin
tkbh:=-1;
err:='';
qry15.Close;
qry15.SQL.Text:='select tkbh from k_tkmcb where tkmc='''+tkmc+'''';
try
qry15.Open;
if not qry15.IsEmpty then
begin
err:='该题库名称已经存在，请修改！';
qry15.Close;
exit;
end;
except
on e:exception do
begin
err:='无法读取数据！'+#13+#13+e.Message;
exit;
end;
end;
qry15.SQL.Text:='select isnull(max(tkbh),0)+1 from k_tkmcb';
try
qry15.Open;
tkbh:=qry15.Fields[0].AsInteger;
qry15.Close;
qry15.SQL.Text:='insert into k_tkmcb values(:tkbh,:tkmc,:tklx,:dlmc)';
qry15.Parameters.ParamByName('tkbh').Value:=tkbh;
qry15.Parameters.ParamByName('tkmc').Value:=tkmc;
qry15.Parameters.ParamByName('tklx').Value:=tklx;
qry15.Parameters.ParamByName('dlmc').Value:=dlmc;
qry15.ExecSQL;
except
on e:exception do err:='数据处理失败！'+#13+#13+e.Message;
end;
end;
procedure Ttkglserver.adddfjl(tkbh: Integer; sjbh: Integer; const dfjl: WideString; qsfw: Integer;
jzfw: Integer; var err: OleVariant); safecall;
var i:integer;
begin
err:='-1';
try
qry16.Close;
qry16.SQL.Text:='select dfjl from k_ksjlb where tkbh='+inttostr(tkbh)
+' and sjbh='+inttostr(sjbh)+' and dfjl='''+dfjl+'''';
qry16.Open;
if not qry16.IsEmpty then
begin
qry16.Close;
err:='该得分结论已经存在，请修改！';
exit;
end;
qry16.Close;
qry16.SQL.Text:='select isnull(max(jlxh),0)+1 from k_ksjlb where tkbh='
+inttostr(tkbh)+' and sjbh='+inttostr(sjbh);
qry16.Open;
i:=qry16.Fields[0].AsInteger;
qry16.Close;
qry16.SQL.Text:='insert into k_ksjlb values(:tkbh,:sjbh,:xh,:qsfw,:jzfw,:jl)';
qry16.Parameters.ParamByName('tkbh').Value:=tkbh;
qry16.Parameters.ParamByName('sjbh').Value:=sjbh;
qry16.Parameters.ParamByName('xh').Value:=i;
qry16.Parameters.ParamByName('qsfw').Value:=qsfw;
qry16.Parameters.ParamByName('jzfw').Value:=jzfw;
qry16.Parameters.ParamByName('jl').Value:=dfjl;
qry16.ExecSQL;
err:='0';
except
on e:exception do err:='数据处理失败！'+#13+#13+e.Message;
end;
end;
procedure Ttkglserver.addksmd(tkbh: Integer; ksbh: Integer; const zkzh: WideString; const xm: WideString;
xb: Integer; const sfzh: WideString; const lxfs: WideString;const lxdz: WideString; var err: OleVariant); safecall;
var i:integer;
begin
err:='-';
qry15.Close;
if ksbh=-1 then//添加新考生
begin
qry15.SQL.Text:='select isnull(max(ksbh),0)+1 from k_ksmdb where tkbh='+inttostr(tkbh);
try
qry15.Open;
i:=qry15.Fields[0].AsInteger;
qry15.Close;
except
on e:exception do
begin
err:=err+'数据处理失败！'+#13+#13+e.Message;
exit;
end;
end;
qry15.SQL.Text:='insert into k_ksmdb values(:tkbh,:ksbh,:zkzh,:sfzh,:xm,:xb,:lxfs,:lxdz)';
qry15.Parameters.ParamByName('ksbh').Value:=i;
end
else
begin
qry15.SQL.Text:='update k_ksmdb set zkzh=:zkzh,sfzh=:sfzh,xm=:xm,xb=:xb,lxfs=:lxfs,lxdz=:lxdz'
+' where tkbh=:tkbh and ksbh=:ksbh';
qry15.Parameters.ParamByName('ksbh').Value:=ksbh;
end;
qry15.Parameters.ParamByName('tkbh').Value:=tkbh;
qry15.Parameters.ParamByName('zkzh').Value:=zkzh;
qry15.Parameters.ParamByName('sfzh').Value:=sfzh;
qry15.Parameters.ParamByName('xm').Value:=xm;
qry15.Parameters.ParamByName('xb').Value:=xb;
qry15.Parameters.ParamByName('lxfs').Value:=lxfs;
qry15.Parameters.ParamByName('lxdz').Value:=lxdz;
try
qry15.ExecSQL;
err:=inttostr(i);
except
on e:exception do
begin
err:=err+'无法保存数据！'+#13+#13+e.Message;
end;
end;
end;
procedure Ttkglserver.addst(df1: Integer; df2: Integer; df3: Integer; df4: Integer;
var stnr: OleVariant;var err: OleVariant); safecall; //如果不出错，err返回的是'0'或者新添加的试题编号
var xh:integer;
stm:tstream;
begin
try
cds1.Close;
cds1.Data:=stnr;
qry16.Close;
qry15.Close;
if cds1.FieldByName('stbh').AsInteger=0 then
begin
qry14.Close;
qry14.SQL.Text:='select isnull(max(stbh),0)+1 from k_stb where tkbh='+cds1.FieldByName('tkbh').Asstring;
qry14.Open;
xh:=qry14.Fields[0].AsInteger;
qry14.Close;
qry16.SQL.Text:='insert into k_stb values(:tkbh,:stbh,:kcfw,:stnd,:stnr)';
qry16.Parameters.ParamByName('stbh').Value:=xh;
qry15.SQL.Text:='insert into k_fzb values(:tkbh,:stbh,:df1,:df2,:df3,:df4)';
qry15.Parameters.ParamByName('stbh').Value:=xh;
end
else
begin
qry16.sql.Text:='update k_stb set stnd=:stnd,stnr=:stnr,kcfw=:kcfw where tkbh=:tkbh and stbh=:stbh';
qry16.Parameters.ParamByName('stbh').Value:=cds1.FieldByName('stbh').AsInteger;
qry15.SQL.Text:='update k_fzb set da1=:df1,da2=:df2,da3=:df3,da4=:df4 where tkbh=:tkbh and stbh=:stbh';
qry15.Parameters.ParamByName('stbh').Value:=cds1.FieldByName('stbh').AsInteger;
end;
qry16.Parameters.ParamByName('tkbh').Value:=cds1.FieldByName('tkbh').AsInteger;
qry16.Parameters.ParamByName('kcfw').Value:=cds1.fieldbyname('kcfw').AsString;
qry16.Parameters.ParamByName('stnd').Value:=cds1.fieldbyname('stnd').AsInteger;
stm:=cds1.CreateBlobStream(cds1.FieldByName('stnr'),bmread);
stm.Position:=0;
qry16.Parameters.ParamByName('stnr').LoadFromStream(stm,ftblob);
// qry16.Parameters.ParamByName('stnr').Value:=cds1.fieldbyname('stnr').Value;
qry15.Parameters.ParamByName('tkbh').Value:=cds1.FieldByName('tkbh').AsInteger;
qry15.Parameters.ParamByName('df1').Value:=df1;
qry15.Parameters.ParamByName('df2').Value:=df2;
qry15.Parameters.ParamByName('df3').Value:=df3;
qry15.Parameters.ParamByName('df4').Value:=df4;
cds1.Close;
adodb.BeginTrans;
try
qry16.ExecSQL;
qry15.ExecSQL;
adodb.CommitTrans;
err:=inttostr(xh);
stm.Free;
except
on e:exception do
begin
adodb.RollbackTrans;
stm.Free;
err:='-'+'保存数据失败！'+#13+#13+e.Message;
exit;
end;
end;
except
on e:exception do
begin
qry14.Close;
err:='-'+'无法读取数据！'+#13+#13+e.Message;
end;
end;
end;
procedure Ttkglserver.scst(tkbh: Integer; stbh: Integer; var err: OleVariant); safecall;
begin
err:='-';
adodb.BeginTrans;
try
qry15.close;
qry16.close;
qry15.SQL.Text:='delete from k_stb where tkbh='+inttostr(tkbh)+' and stbh='+inttostr(stbh);
qry16.SQL.Text:='delete from k_fzb where tkbh='+inttostr(tkbh)+' and stbh='+inttostr(stbh);
qry15.ExecSQL;
qry16.ExecSQL;
adodb.CommitTrans;
err:='0';
except
on e:exception do
begin
adodb.RollbackTrans;
err:=err+'数据处理失败！'+#13+#13+e.Message;
end;
end;
end;
initialization
TComponentFactory.Create(ComServer, Ttkglserver,
Class_tkglserver, ciMultiInstance, tmApartment);
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -