unit uDjcClass;
interface
uses Forms, Classes, SysUtils, DB, ADODB, DateUtils, StrUtils, uCellPrintInterface,
uCellPrintLoader, uListComboBox, Sys_ADOQ_Interface, uInterface, uDjcGlobal, uLisPublicVar;
type
TData = class(TObject)
end;
TMyField = class(TObject)
end;
TBiz = class(TObject)
private
FQuery: TADOQuery;
ADOConn, ADOConnRemote, ADODocRemote: TADOConnection;
protected
function Delete(DataRec: TData): Integer; virtual;
function Modify(DataRec: TData): Integer; virtual;
function Append(DataRec: TData): Integer; virtual;
public
function ExecuteSQL(ASQLTXT: string; Mode: TRemoteLocal; ReturnData: Boolean = True): Boolean;
procedure GetDepartmentListInListCombobox(AListCombobox: TListCombobox;
bDefaultValue: Boolean = True);
procedure GetYfListInListCombobox(AListCombobox: TListCombobox; XT_GENERAL_NAME_TableName:
string = 'XT_GENERAL_NAME';
bDefaultValue: Boolean = True);
procedure SetConn(Form: TForm); overload;
procedure SetConn(Mode: TDataModule); overload;
procedure CloseCon(Form: TForm); overload;
procedure CloseCon(Mode: TDataModule); overload;
property Conn: TADOConnection read ADOConn;
property ConnRemote: TADOConnection read ADOConnRemote;
property ConnDocRemote: TADOConnection read ADODocRemote;
property Query: TADOQuery read FQuery;
procedure GetClassNo(ItemType, Xmcode: Integer; var ClassNo: Integer; var ClassName: string);
constructor Create; virtual;
destructor Destroy; override;
function SortDownUp(DownOrUp: Integer; qry: TADOQuery; SortField, TbName, KeyNo, KeyValue:
string;var PSortCode: Integer): Boolean; overload;
function SortDownUp(DownOrUp: Integer; qry: TADOQuery; SortField,
TbName: string; OrderDoctor: Integer; var PSortCode: Integer): Boolean; overload;
end;
TMyString = class(TObject)
private
FStrBeginTran: string;
FStrEndTran: string;
protected
function GetData(myData: TMyField): string; virtual;
function GetFields(myData: TData): string; virtual;
public
property StrBeginTran: string read FStrBeginTran;
property StrEndTran: string read FStrEndTran;
class procedure Split(const A, OldPattern: string; var Str: TStringList);
class function SetInsert(tbName, strData, strFields: string): string;
class function SetUpdate(tbName, strData, strFields: string): string;
class function SetDelete(tbName, strData, strFields: string): string;
class function GetStrUnion(str: TStringList): string;
class procedure StrListCompare(s1, s2: TStringList; var s3, s4: TStringList);
procedure SetInsertList(tbName: string; strDataList: TStringList; strFields: string; var
strList: TStringList); virtual;
procedure SetUpdateList(tbName: string; strDataList: TStringList; strFields: string; var
strList: TStringList); virtual;
procedure SetDeleteList(tbName: string; strDataList: TStringList; strFields: string; var
strList: TStringList); virtual;
procedure SetInsertListByDept(tbName: string; strDataList: TStringList; strFields: string; var
strList: TStringList; Dept: string); virtual;
procedure SetInsertListByDept1(tbName: string; strDataList: TStringList; strFields: string; var
strList: TStringList; DeptNo, DeptName: string); virtual;
procedure SetUpdateListByDept(tbName: string; strDataList: TStringList; strFields: string; var
strList: TStringList; Dept: string); virtual;
procedure SetDeleteListByDept(tbName: string; strDataList: TStringList; strFields: string; var
strList: TStringList; Dept: string); virtual;
constructor Create; virtual;
end;
implementation
uses
uLisSDK, BizProcess;
{ TBiz }
function TBiz.Append(DataRec: TData): Integer;
begin
//
end;
procedure TBiz.CloseCon(Form: TForm);
var
i: Integer;
begin
for i := 0 to Form.ComponentCount - 1 do
begin
if Form.Components[i] is TADOQuery then
begin
(Form.Components[i] as TADOQuery).Active := False;
(Form.Components[i] as TADOQuery).Close;
end;
end;
end;
procedure TBiz.CloseCon(Mode: TDataModule);
var
i: Integer;
begin
for i := 0 to Mode.ComponentCount - 1 do
begin
if Mode.Components[i] is TADOQuery then
begin
(Mode.Components[i] as TADOQuery).Active := False;
(Mode.Components[i] as TADOQuery).Close;
end;
end;
end;
constructor TBiz.Create;
begin
FQuery := TADOQuery.Create(nil);
ADOConn := TSJDbToolKit.GetLocalAdoConnection;
ADOConnRemote := TSJDbToolKit.GetRemoteAdoConnection;
ADOConn.LoginPrompt := False;
ADOConnRemote.LoginPrompt := False;
inherited;
end;
///
/// 删除数据
///
///
///
///
function TBiz.Delete(DataRec: TData): Integer;
begin
//
end;
destructor TBiz.Destroy;
begin
FreeAndNil(FQuery);
inherited;
end;
///
/// 执行SQL语句
///
/// SQL语句
/// 方式（Local:本地 Remote:远程）
/// 是执行还是显示
///
function TBiz.ExecuteSQL(ASQLTXT: string; Mode: TRemoteLocal;
ReturnData: Boolean): Boolean;
//var
// FQuery:TADOQuery;
begin
//FQuery :=TADOQuery.Create(nil);
if FQuery.Active then
FQuery.Close;
{重建连接}
FQuery.Connection := nil;
if Mode = rlRemote then
FQuery.Connection := ADOConnRemote
else
FQuery.Connection := ADOConn;
FQuery.SQL.Text := ASQLTXT;
try
if ReturnData = True then
FQuery.Open
else
FQuery.ExecSQL;
Result := True;
except
Result := False;
end;
//FQuery.Free;
end;
///
/// 获得药房下拉列表数据
///
/// 下拉列表控件名称
/// 设置默认值
procedure TBiz.GetClassNo(ItemType, Xmcode: Integer; var ClassNo: Integer;
var ClassName: string);
begin
ClassNo := 0;
ClassName := '自费';
FQuery.Connection := ADOConn;
ShowQuery(FQuery, 'select ClassNo,ClassName from ZYJS_YB_COMPARE where ItemType=' +
IntToStr(ItemType)
+ ' and SelfCode=' + IntToStr(Xmcode));
if not FQuery.IsEmpty then
begin
ClassNo := FQuery.FieldByName('ClassNo').AsInteger;
ClassName := FQuery.FieldByName('ClassName').AsString;
end;
end;
procedure TBiz.GetDepartmentListInListCombobox(
AListCombobox: TListCombobox; bDefaultValue: Boolean);
var
TempQuery: TADOQuery;
begin
AListCombobox.DeleteAllItem;
TempQuery := TADOQuery.Create(nil);
TempQuery.Connection := ADOConn;
ShowQuery(TempQuery,
'Select DepartmentNo,DepartmentName,dt,StationNo from XT_Department Order by DepartmentNo');
with TempQuery do
try
First;
while not Eof do
begin
AListCombobox.InsertItem(Trim(FieldByName('DepartmentName').AsString),
FieldByName('DepartmentNo').AsInteger, FieldByName('DepartmentNo').AsString);
Next;
end;
if bDefaultValue then
if AListCombobox.Items.Count > 1 then
AListCombobox.ItemIndex := 1;
finally
Free;
end;
end;
///
/// 获得用法下拉列表数据
///
/// 下拉列表控件名称
/// 设置默认值
procedure TBiz.GetYfListInListCombobox(AListCombobox: TListCombobox; XT_GENERAL_NAME_TableName:
string;
bDefaultValue: Boolean);
var
TempQuery: TADOQuery;
begin
AListCombobox.DeleteAllItem;
TempQuery := TADOQuery.Create(nil);
TempQuery.Connection := ADOConn;
ShowQuery(TempQuery,
'Select Code,Name,SubMark from ' + XT_GENERAL_NAME_TableName +
' where SysName = ''BQGL'' and Cmark=''使用方法'' Order by Code');
with TempQuery do
try
First;
while not Eof do
begin
AListCombobox.InsertItem(Trim(FieldByName('Name').AsString),
FieldByName('Code').AsInteger, Trim(FieldByName('Code').AsString));
Next;
end;
if bDefaultValue then
if AListCombobox.Items.Count > 1 then
AListCombobox.ItemIndex := 1;
finally
Free;
end;
end;
///
/// 修改数据
///
///
///
///
function TBiz.Modify(DataRec: TData): Integer;
begin
//
end;
///
/// 设置连接
///
///
procedure TBiz.SetConn(Form: TForm);
var
i: Integer;
begin
for i := 0 to Form.ComponentCount - 1 do
begin
if Form.Components[i] is TADOQuery then
begin
(Form.Components[i] as TADOQuery).Connection := ADOConn;
end;
end;
end;
procedure TBiz.SetConn(Mode: TDataModule);
var
i: Integer;
begin
for i := 0 to Mode.ComponentCount - 1 do
begin
if Mode.Components[i] is TADOQuery then
begin
if Mode.Components[i].Tag = 0 then
(Mode.Components[i] as TADOQuery).Connection := ADOConnRemote
else
(Mode.Components[i] as TADOQuery).Connection := ADOConn;
end;
end;
end;
///
/// 排序
///
/// 1：上移 2：下移
/// 主表
/// 排序字段
/// 表名
/// 关键字段
/// 关键字段值
/// 输出的定位值
///
function TBiz.SortDownUp(DownOrUp: Integer; qry: TADOQuery; SortField, TbName, KeyNo,
KeyValue: string; var PSortCode: Integer): Boolean;
var
NSortCode, PID, NID, FMediaType: Integer;
sSQL: string;
qryTemp, qryMain, qryRemoteUp: TADOQuery;
begin
Result := False;
qryTemp := TADOQuery.Create(nil);
qryRemoteUp := TADOQuery.Create(nil);
qryTemp.Connection := ConnRemote;
qryRemoteUp.Connection := ConnRemote;
if qry.State <> dsEdit then
qry.Edit;
NSortCode := qry.FieldByName(SortField).AsInteger;
NID := qry.FieldByName('OnlyID').AsInteger;
if DownOrUp = 1 then
begin
sSQL := 'select SortCode,OnlyID from ' + TbName +
' WHERE sortcode<' + IntToStr(NSortCode) + ' and ' + KeyNo + '=' + KeyValue +
' order by ' + SortField + ' desc';
ShowQuery(qryTemp, sSQL);
if qryTemp.IsEmpty then
begin
qry.Cancel;
Exit;
end;
end
else if DownOrUp = 2 then
begin
sSQL := 'select ' + SortField + ',OnlyID from ' + TbName +
' WHERE ' + SortField + '>' + IntToStr(NSortCode) + ' and ' + KeyNo + '=' + KeyValue +
' order by ' + SortField;
ShowQuery(qryTemp, sSQL);
if qryTemp.FieldByName(SortField).AsInteger <= 0 then
begin
qry.Cancel;
Exit;
end;
end;
PSortCode := qryTemp.FieldByName(SortField).AsInteger;
{$IFDEF Test}codesite.SendInteger('PSortCode: ', PSortCode); {$ENDIF}
PID := qryTemp.FieldByName('OnlyID').AsInteger;
{$IFDEF Test}codesite.SendInteger('PID: ', PID); {$ENDIF}
try
try
sSQL := 'update ' + TbName + ' set SortCode=' + IntToStr(NSortCode) +
' where OnlyID=' + IntToStr(PID);
{$IFDEF Test}codesite.SendMsg(sSQL); {$ENDIF}
ExecQuery(qryRemoteUp, 'update ' + TbName + ' set ' + SortField + '=' + IntToStr(NSortCode)
+
' where OnlyID=' + IntToStr(PID));
sSQL := 'update ' + TbName + ' set SortCode=' + IntToStr(PSortCode) +
' where OnlyID=' + IntToStr(NID);
{$IFDEF Test}codesite.SendMsg(sSQL); {$ENDIF}
ExecQuery(qryRemoteUp, 'update ' + TbName + ' set SortCode=' + IntToStr(PSortCode)
+
' where OnlyID=' + IntToStr(NID));
except
end;
finally
qryRemoteUp.Free;
qryTemp.Free;
end;
Result := True;
end;
///
/// 排序
///
/// 1：上移 2：下移
/// 主表
/// 排序字段
/// 表名
/// 医生编号
/// 类型
/// 剂型
///
///
function TBiz.SortDownUp(DownOrUp: Integer; qry: TADOQuery; SortField,
TbName: string; OrderDoctor: Integer;
var PSortCode: Integer): Boolean;
var
qryTemp, qryRemoteUp: TADOQuery;
NSortCode, PID, NID, FMediaType, FOrderType: Integer;
sSQL: string;
begin
if qry.State <> dsEdit then
qry.Edit;
qryTemp := TADOQuery.Create(nil);
qryRemoteUp := TADOQuery.Create(nil);
qryTemp.Connection := ConnRemote;
qryRemoteUp.Connection := ConnRemote;
NSortCode := qry.FieldByName('SortCode').AsInteger;
NID := qry.FieldByName('OnlyID').AsInteger;
FMediaType := qry.FieldByName('MedicalType').AsInteger;
FOrderType := qry.FieldByName('OrderType').AsInteger;
if DownOrUp = 1 then
begin
sSQL := 'select * from ' + TbName +
' WHERE ' + SortField + '<' + IntToStr(NSortCode) + ' and OrderDoctor=' +
IntToStr(OrderDoctor) + ' and MedicalType=' +
IntToStr(FMediaType) + ' and OrderType=' + IntToStr(FOrderType) + ' order by ' + SortField +
' desc';
ShowQuery(qryTemp, sSQL);
if qryTemp.IsEmpty then
begin
qry.Cancel;
Exit;
end;
end
else if DownOrUp=2 then
begin
sSQL := 'select * from ' + TbName +
' WHERE sortcode>' + IntToStr(NSortCode) + ' and OrderDoctor=' + IntToStr(OrderDoctor) +
' and MedicalType=' +
IntToStr(FMediaType) + ' and OrderType=' + IntToStr(FOrderType) + ' order by sortcode';
ShowQuery(qryTemp, sSQL);
if qryTemp.IsEmpty then
begin
qry.Cancel;
Exit;
end;
end;
PSortCode := qryTemp.FieldByName('SortCode').AsInteger;
PID := qryTemp.FieldByName('OnlyID').AsInteger;
try
try
ExecQuery(qryRemoteUp, 'update ' + TbName + ' set SortCode=' + IntToStr(NSortCode) +
' where OnlyID=' + IntToStr(PID));
ExecQuery(qryRemoteUp, 'update ' + TbName + ' set SortCode=' + IntToStr(PSortCode) +
' where OnlyID=' + IntToStr(NID));
except
end;
finally
qryTemp.Free;
qryRemoteUp.Free;
end;
end;
{ TMyString }
constructor TMyString.Create;
begin
FStrBeginTran := 'Begin Tran';
FStrEndTran := 'Commit Tran';
end;
///
/// 获得数据
///
///
/// 数据
function TMyString.GetData(myData: TMyField): string;
begin
Result := '';
end;
///
/// 获得字段
///
///
/// 字段值
function TMyString.GetFields(myData: TData): string;
begin
Result := '';
end;
class function TMyString.GetStrUnion(str: TStringList): string;
var
i: Integer;
stlTemp, stlTemp1: TStringList;
s, temp: string;
begin
s := '';
stlTemp := TStringList.Create;
stlTemp1 := TStringList.Create;
for i := 0 to str.Count - 1 do
begin
if Trim(str[i]) = '' then
Continue;
s := s + str[i] + ',';
end;
s := copy(s, 1, Length(s) - 1);
stlTemp.CommaText := s;
stlTemp.Sorted := True;
for i := 0 to stlTemp.Count - 1 do
begin
temp := stlTemp[i];
if stlTemp1.IndexOf(temp) = -1 then
stlTemp1.Add(temp);
end;
Result := stlTemp1.CommaText;
stlTemp.Free;
stlTemp1.Free;
end;
class function TMyString.SetDelete(tbName, strData, strFields: string): string;
var
i: Integer;
DataList, FieldsList: TStringList;
str: string;
begin
DataList := TStringList.Create;
FieldsList := TStringList.Create;
Split(strData, ',', DataList);
Split(strFields, ',', FieldsList);
str := 'Delete from ' + tbName + ' where 1=1 ';
for i := 0 to DataList.Count - 1 do
begin
str := str + ' and ' + FieldsList[i] + '=' + DataList[i];
end;
//str :=Copy(str,1,Length(str)-1);
DataList.Free;
FieldsList.Free;
Result := str;
end;
procedure TMyString.SetDeleteList(tbName: string; strDataList: TStringList;
strFields: string; var strList: TStringList);
var
i: Integer;
begin
for i := 0 to strDataList.Count - 1 do
begin
strList.Add(SetDelete(tbName, strDataList[i], strFields));
end;
end;
procedure TMyString.SetDeleteListByDept(tbName: string;
strDataList: TStringList; strFields: string; var strList: TStringList;
Dept: string);
var
i: Integer;
begin
for i := 0 to strDataList.Count - 1 do
begin
strList.Add(SetDelete(tbName, strDataList[i], strFields));
end;
end;
class function TMyString.SetInsert(tbName, strData, strFields: string): string;
var
str: string;
begin
str := 'insert into ' + tbName + '(' + strFields + ') values(' + strData + ')';
Result := str;
end;
procedure TMyString.SetInsertList(tbName: string; strDataList: TStringList;
strFields: string; var strList: TStringList);
var
i: Integer;
begin
for i := 0 to strDataList.Count - 1 do
begin
strList.Add(SetInsert(tbName, strDataList[i], strFields));
end;
end;
procedure TMyString.SetInsertListByDept(tbName: string;
strDataList: TStringList; strFields: string; var strList: TStringList;
Dept: string);
var
i: Integer;
sList: TStringList;
begin
for i := 0 to strDataList.Count - 1 do
begin
strDataList[0] := Dept;
strList.Add(SetInsert(tbName, strDataList[i], strFields));
end;
end;
procedure TMyString.SetInsertListByDept1(tbName: string;
strDataList: TStringList; strFields: string; var strList: TStringList;
DeptNo, DeptName: string);
var
i: Integer;
sList: TStringList;
begin
for i := 0 to strDataList.Count - 1 do
begin
strDataList[0] := DeptNo;
strDataList[1] := DeptName;
strList.Add(SetInsert(tbName, strDataList[i], strFields));
end;
end;
class function TMyString.SetUpdate(tbName, strData, strFields: string): string;
var
i: Integer;
DataList, FieldsList: TStringList;
str: string;
begin
DataList := TStringList.Create;
FieldsList := TStringList.Create;
Split(strData, ',', DataList);
Split(strFields, ',', FieldsList);
str := 'update ' + tbName + ' set ';
for i := 0 to DataList.Count - 1 do
begin
str := str + FieldsList[i] + '=' + DataList[i] + ',';
end;
str := Copy(str, 1, Length(str) - 1);
DataList.Free;
FieldsList.Free;
Result := str;
end;
procedure TMyString.SetUpdateList(tbName: string; strDataList: TStringList;
strFields: string; var strList: TStringList);
var
i: Integer;
begin
//strList.Add(StrBeginTran);
for i := 0 to strDataList.Count - 1 do
begin
strList.Add(SetUpdate(tbName, strDataList[i], strFields));
end;
//strList.Add(StrEndTran);
end;
procedure TMyString.SetUpdateListByDept(tbName: string;
strDataList: TStringList; strFields: string; var strList: TStringList;
Dept: string);
begin
end;
class procedure TMyString.Split(const A, OldPattern: string; var Str: TStringList);
begin
Str.Text := Stringreplace(A, OldPattern, sLineBreak, [rfReplaceAll]);
end;
class procedure TMyString.StrListCompare(s1, s2: TStringList; var s3,
s4: TStringList);
var
i: Integer;
begin
s1.Sort;
s2.Sort;
if s3.Count > 0 then
s3.Clear;
if s4.Count > 0 then
s4.Clear;
for i := 0 to s1.Count - 1 do
begin
if s2.IndexOf(s1[i]) = -1 then
s3.Add(s1[i]);
end;
for i := 0 to s2.Count - 1 do
begin
if s1.IndexOf(s2[i]) = -1 then
s4.Add(s2[i]);
end;
end;
end.
