📄 tdmpjgcom.pas
字号:
adoConn.ConnectionString := 'Provider=SQLOLEDB.1;Password=' + sPwd +
';User ID=' + sUid + ';Initial Catalog=' + sDB + ';Data Source=' +
sSrv;
end;
4: //Sybase
begin
adoConn.ConnectionString :=
'Provider=MSDASQL.1;Extended Properties="DRIVER={sybase system 11};UID=' +
sUid + ';PWD=' + sPwd + ';SRVR=' + sSrv + ';DB=' + sDB + '"';
end;
else
adoConn.ConnectionString := '';
end;
if adoConn.ConnectionString <> '' then
begin
try
adoConn.Open;
Result := 0;
except
Result := -1;
end;
end;
end;
procedure TPJgComServer.MtsDataModuleActivate(Sender: TObject);
{var
sSrv, sDB: String;
iLx: Smallint;
}
begin
// ReadDBMSInfo(_JGSYSTEM, sSrv, sDB, iLx);
// ConnectDB(sSrv, sDB, iLx, _DBUSER, _DBPASSWORD);
end;
function TPJgComServer.UserDelete(const sUid: WideString): Smallint;
begin
Result := -1;
if adoConn.Connected then
begin
try
adoSpUserDel.Close;
adoSpUserDel.Parameters.ParamByName('@userid').Value := sUid;
adoSpUserDel.ExecProc;
Result := adoSpUserDel.Parameters.ParamByName('@nret').Value;
SetComplete;
except
SetAbort;
end;
end;
end;
function TPJgComServer.UserSave(const sUid, sPwd, sName, sQx,
sSsds: WideString; lSys: WordBool): Smallint;
begin
Result := -1;
if adoConn.Connected then
begin
try
adoSpUserSave.Close;
with adoSpUserSave.Parameters do
begin
ParamByName('@userid').Value := sUid;
ParamByName('@username').Value := sName;
ParamByName('@userpwd').Value := sPwd;
ParamByName('@userqx').Value := sQx;
ParamByName('@ssds').Value := sSsds;
ParamByName('@usersys').Value := lSys;
end;
adoSpUserSave.ExecProc;
Result := adoSpUserSave.Parameters.ParamByName('@nret').Value;
SetComplete;
except
SetAbort;
end;
end;
end;
function TPJgComServer.UserInfo(out vRec: OleVariant): Smallint;
begin
Result := -1;
cds.Active := False;
cds.CommandText := 'select * from bm_user order by userid';
try
try
cds.Active := True;
vRec := cds.XMLData;
Result := 0;
finally
cds.Active := False;
end;
SetComplete;
except
SetAbort;
end;
end;
function TPJgComServer.ReadMainMap(out sCaption: WideString;
out vData: OleVariant): Smallint;
var
BlobF: TBlobField;
DataS: TAdoDataSet;
aMS: TMemoryStream;
p: pointer;
L: integer;
begin
Result := -1;
DataS := TAdoDataSet.Create(nil);
BlobF := TBlobField.Create(DataS);
ams := TMemoryStream.Create;
try
DataS.Connection := adoConn;
DataS.CommandType := cmdText;
DataS.CommandText := 'select caption,image from bm_map';
BlobF.FieldName := 'image';
BlobF.DataSet := DataS;
DataS.Open;
BlobF.Index := DataS.FieldCount - 1;
if BlobF.IsNull then
Result := 5
else
begin
try
BlobF.SaveToStream(ams);
L := ams.Size;
vData := varArrayCreate([0, L - 1], varByte);
p := VarArrayLock(vData);
Move(ams.memory^, P^, L);
Result := 0;
finally
VarArrayUnlock(vData);
ams.Free;
end;
end;
DataS.Close;
{ DataS.CommandText := 'select caption from bm_map';
DataS.Open;
sCaption := DataS.FieldByName('caption').AsString;
DataS.Close;
}except
Result := -1;
end;
BlobF.Free;
DataS.Free;
sCaption := MainCaption;
end;
function TPJgComServer.ReadMap(const sDsbh: WideString;
out vData: OleVariant): Smallint;
var
BlobF: TBlobField;
DataS: TAdoDataSet;
aMS: TMemoryStream;
p: pointer;
L: integer;
begin
Result := -1;
DataS := TAdoDataSet.Create(nil);
BlobF := TBlobField.Create(DataS);
ams := TMemoryStream.Create;
try
DataS.Connection := adoConn;
DataS.CommandType := cmdText;
DataS.CommandText := 'select dsbh,image from bm_dsbmb where dsbh=''' + sDsbh
+ '''';
BlobF.FieldName := 'image';
BlobF.DataSet := DataS;
DataS.Open;
BlobF.Index := DataS.FieldCount - 1;
if BlobF.IsNull then
Result := 5
else
begin
try
BlobF.SaveToStream(ams);
L := ams.Size;
vData := varArrayCreate([0, L - 1], varByte);
p := VarArrayLock(vData);
Move(ams.memory^, P^, L);
Result := 0;
finally
VarArrayUnlock(vData);
ams.Free;
end;
end;
DataS.Close;
except
Result := -1;
end;
BlobF.Free;
DataS.Free;
end;
function TPJgComServer.WriteMainMap(const sCaption: WideString;
vData: OleVariant): Smallint;
var
BlobF: TBlobField;
DataS: TAdoDataSet;
aMS: TMemoryStream;
sStr: string;
p: pointer;
L: integer;
begin
Result := -1;
if adoQry.Active = true then
adoQry.Active := false;
adoQry.SQL.Clear;
sStr := 'if not exists(select 1 from bm_map) ' +
' insert bm_map(caption) values(''' + sCaption + ''') ' +
' else update bm_map set caption = ''' + sCaption + '''';
adoQry.SQL.Add(sStr);
adoQry.ExecSQL;
adoQry.Active := false;
DataS := TAdoDataSet.Create(nil);
BlobF := TBlobField.Create(DataS);
try
ams := TMemoryStream.Create;
DataS.Connection := adoConn;
DataS.CommandType := cmdText;
DataS.CommandText := 'select caption,image from bm_map ';
BlobF.FieldName := 'image';
BlobF.DataSet := DataS;
DataS.Open;
BlobF.Index := DataS.FieldCount - 1;
DataS.Edit;
try
L := VarArrayHighBound(vData, 1) - VarArrayLowBound(vData, 1) + 1;
p := VarArrayLock(vData);
aMS.SetSize(L);
Move(p^, ams.memory^, L);
BlobF.LoadFromStream(ams);
DataS.Post;
Result := 0;
finally
VarArrayUnlock(vData);
ams.Free;
end;
DataS.Close;
except
Result := -1;
end;
BlobF.Free;
DataS.Free;
end;
function TPJgComServer.WriteMap(const sDsbh: WideString;
vData: OleVariant): Smallint;
var
BlobF: TBlobField;
DataS: TAdoDataSet;
aMS: TMemoryStream;
// sStr: string;
p: pointer;
L: integer;
begin
Result := -1;
DataS := TAdoDataSet.Create(nil);
BlobF := TBlobField.Create(DataS);
ams := TMemoryStream.Create;
try
DataS.Connection := adoConn;
DataS.CommandType := cmdText;
DataS.CommandText := 'select dsbh,image from bm_dsbmb where dsbh=''' + sDsbh
+ '''';
BlobF.FieldName := 'image';
BlobF.DataSet := DataS;
DataS.Open;
BlobF.Index := DataS.FieldCount - 1;
DataS.Edit;
try
L := VarArrayHighBound(vData, 1) - VarArrayLowBound(vData, 1) + 1;
p := VarArrayLock(vData);
aMS.SetSize(L);
Move(p^, ams.memory^, L);
BlobF.LoadFromStream(ams);
DataS.Post;
Result := 0;
finally
VarArrayUnlock(vData);
ams.Free;
end;
DataS.Close;
except
Result := -1;
end;
BlobF.Free;
DataS.Free;
end;
procedure TPJgComServer.fZcfzbGjjInf(const sDsbh, sNy: WideString;
var vData: OleVariant);
begin
self.cds_Cx.Active := false;
if sDsbh = '' then
self.cds_Cx.CommandText := 'select * from V_ZCFZB_GJJ where NY=''' + sNy +
''''
else
self.cds_Cx.CommandText := 'select * from V_ZCFZB_GJJ where NY=''' + sNy +
''' and dsbh='''+ sDsbh +'''';
try
try
self.cds_Cx.Active := true;
vData := self.cds_Cx.XMLData;
finally
self.cds_Cx.Active := false;
end;
SetComplete;
except
on Exception do
SetAbort;
end;
end;
procedure TPJgComServer.fZcfzbGjjSav(const sDsbh, sNy: WideString;
aAry: OleVariant; var lResult: Integer);
var
i: smallint;
begin
try
if SP_Cx.Active = true then
SP_Cx.Close;
with SP_Cx do
begin
ProcedureName := 'p_ZCFZBGJJ_save';
Parameters.Refresh;
Parameters.ParamByName('@dsbh').Value := sDsbh;
Parameters.ParamByName('@NY').Value := sNy;
for i := 0 to 34 do
begin
Parameters[i + 3].DataType := ftFloat;
Parameters[i + 3].Value := double(aAry[i]);
end;
Parameters.ParamByName('@nret').Direction := pdInputOutput;
Parameters.ParamByName('@nret').Value := -1;
end;
SP_Cx.ExecProc;
lresult := SP_Cx.Parameters.ParamByName('@nret').Value;
SP_Cx.Close;
SetComplete;
except
on Exception do
SetAbort;
end;
end;
procedure TPJgComServer.fZzsybGjjInf(const sDsbh, sNy: WideString;
var vData: OleVariant);
begin
self.cds_Cx.Active := false;
if sDsbh = '' then
self.cds_Cx.CommandText := 'select * from V_ZZSYB_GJJ where NY=''' + sNy +
''''
else
self.cds_Cx.CommandText := 'select * from V_ZZSYB_GJJ where NY=''' + sNy +
''' and dsbh='''+ sDsbh +'''';
try
try
self.cds_Cx.Active := true;
vData := self.cds_Cx.XMLData;
finally
self.cds_Cx.Active := false;
end;
SetComplete;
except
on Exception do
SetAbort;
end;
end;
procedure TPJgComServer.fZzsybGjjSav(const sDsbh, sNy: WideString;
aAry: OleVariant; var lResult: Integer);
var
i: smallint;
begin
try
if SP_Cx.Active = true then
SP_Cx.Close;
with SP_Cx do
begin
ProcedureName := 'p_ZZSYBGJJ_save';
Parameters.Refresh;
Parameters.ParamByName('@dsbh').Value := sDsbh;
Parameters.ParamByName('@NY').Value := sNy;
for i := 0 to 15 do
begin
Parameters[i + 3].DataType := ftFloat;
Parameters[i + 3].Value := double(aAry[i]);
end;
Parameters.ParamByName('@nret').Direction := pdInputOutput;
Parameters.ParamByName('@nret').Value := -1;
end;
SP_Cx.ExecProc;
lresult := SP_Cx.Parameters.ParamByName('@nret').Value;
SP_Cx.Close;
SetComplete;
except
on Exception do
SetAbort;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -