.#dbfuncs.pas.1.15

群星医药系统源码

unit DbFuncs;

interface

uses Windows, SysUtils, DB, DBClient, Variants, DBGrids, Controls, Forms,MConnect,iMainFrm,
    uGlobal,Classes,Dialogs,ckDBClient;

function GetFieldMaxInt(DataSet: TDataSet; sField: String): Integer;
Function CopyRecSelf(DataSet: TDataSet; IgnoreFields: String; bPost: Boolean): Boolean;
//IgnoreFields：要忽略的字段，在多个字段名之间用";"号分隔
procedure ViewDataSet(DataSet: TDataSet);
Function GetGoodsInfo(DataSet:TDataSet;sGoodsID,sSetFields:String;Var LogText:String):String; OverLoad;
Procedure SysFieldXml(FieldsData:TClientDataSet;FiltStr:String;FileName:String);   //下载XML文件;
//获取某常用参考资料
procedure GetInfoValues(DataSet: TckClientDataSet; InfoType: String; Values: TStrings);
procedure GetValueList(DataSet: TDataSet; sField: String; Values: TStrings; bAutoClear: Boolean=true);
Procedure ShowFieldDisp(CdsFields,CdsCust:TClientDataSet;sTableNames:String);      //显示字段的DispLabel;
Function IsFieldPass(CdsFields,CdsCust:TClientDataSet;sTableName:String;sTitle:String=''):Boolean;          //检查字段的合法性


implementation

function GetFieldMaxInt(DataSet: TDataSet; sField: String): Integer;
const
  sErr_FieldNotFound = '找不到指定的字段';
	sErr_FieldNotIsNumField = '指定的字段不是数值型字段：';
var Field: TField;
    iMax, i: Integer;
    sIdxFld: String;
begin
  with DataSet do begin
    Field := FindField(sField);
    if Field=nil then
      raise Exception.Create(sErr_FieldNotFound);
    if not (Field is TNumericField) then
      raise Exception.Create(sErr_FieldNotIsNumField);
    iMax := -1;
    DisableControls;
    if DataSet is TClientDataSet then begin
      sIdxFld := (DataSet as TClientDataSet).IndexFieldNames;
      if (sIdxFld=sField)or(AnsiPos(sField+';', sIdxFld)=1) then begin
        Last;
        iMax := Field.AsInteger;
      end;
    end;
    if iMax=-1 then begin
      First;
      iMax := 0;
      while not Eof do begin
        i := Field.AsInteger;
        If iMax<i Then
          iMax := Field.AsInteger;
        Next;
      End;
    end;
    EnableControls;
  end;
  Result := iMax;
end;

Function CopyRecSelf(DataSet: TDataSet; IgnoreFields: String; bPost: Boolean): Boolean;
var Values: Variant;
    i, k: Integer;
    IgnFieldIdx: set of byte;
begin
  Result := false;
  if (DataSet=nil)or not DataSet.Active then
    Exit;
  if DataSet.State in dsEditModes then begin
	  MessageBox(0, 'The dataset is in EditModes!', '消息', 64);
    Exit;
  end;
  IgnoreFields := IgnoreFields+';';
  with DataSet do begin
    k := FieldCount-1;
    Values := VarArrayCreate([0, k], varVariant);
    for i:=0 to k do begin
      if AnsiPos(Fields[i].FieldName+';', IgnoreFields)>0 then
        Include(IgnFieldIdx, i)
      else
        Values[i] := Fields[i].Value;
    end;
    Append;
    for i:=0 to k do begin
      if not(i in IgnFieldIdx) then
        Fields[i].Value := Values[i];
    end;
    if bPost then
      DataSet.Post;
    Result := true;
  end;
end;

procedure ViewDataSet(DataSet: TDataSet);
var Form: TForm;
    Ds: TDataSource;
    Grid: TDBGrid;
begin
  Form := TForm.Create(nil);
  Ds := TDataSource.Create(Form);
  Ds.DataSet := DataSet;
  Grid := TDBGrid.Create(form);
  Grid.Parent := Form;
  Grid.Align := alClient;
  Grid.DataSource := ds;
  Form.ShowModal;
  Form.Free;
end;

Function GetGoodsInfo(DataSet:TDataSet;sGoodsID,sSetFields:String;Var LogText:String):String; 
Var
  vField:TField;
  iClientID,I,iLow,J,Flag,iFieldCount:Integer;
  SvrGoods:TDispatchConnection;
  IFmMain: IMainForm;
  sFieldList:TStrings;
  NeedValue:Variant;
  GoodsID:String;
begin
   Try
    Result:='';
    sFieldList:=TStringList.Create;
    xStrSplit(sSetFields, [','],sFieldList);
    iFieldCount:=sFieldList.Count;
    IFmMain := (Application.MainForm As IMainForm);
    IClientID:=IFmMain.IFmMainEx.ClientID;
    GoodsID:=sGoodsID;
    If Copy(Trim(sGoodsId),1,1)='-' Then Begin
      Delete(GoodsID,1,1);
      Flag:=1;
    End;
    SvrGoods := IFmMain.GetConnection(Application.MainForm.Handle, '', 'CommonSvr.CommonRDM');
    NeedValue:=SvrGoods.AppServer.GetGoodsInfo(IClientID,GoodsID,sSetFields,Flag,LogText);
    If LogText<>'' Then
      Result:=LogText
    Else Begin
      with DataSet Do Begin
        iLow := VarArrayLowBound(NeedValue,1);
        J := iLow+iFieldCount-1;
        for i:=iLow to J do begin
          vField := DataSet.FindField(sFieldList[i]);
          if vField<>nil then Begin
            vField.AsVariant:=NeedValue[i];
          End;
        End;
      End;
      LogText:=GoodsID;
    End;
  Except
    On E:Exception Do ;
  End;
End;

procedure GetValueList(DataSet: TDataSet; sField: String; Values: TStrings; bAutoClear: Boolean);
var Field: TField;
    str: String;
begin
  if sField='' then Exit;
  if bAutoClear then Values.Clear;
  with DataSet do
  begin
    if (not Active) or IsEmpty then Exit;
    Field := DataSet.FindField(sField);
    if Field=nil then Exit;
    First;
    while not Eof do
    begin
      str := Field.AsString;
      if Values.IndexOf(str)<0 then
        Values.Add(str);
      Next;
    end;
  end;
end;

procedure GetInfoValues(DataSet: TckClientDataSet; InfoType: String; Values: TStrings);
const
  sTypes = 'HypoKind'#13'Departs'#13'Dosetype'#13'Dutys'#13'Trades'#13'Units'#13'Words';
  sTables= 'HypoKinds'#13'Info_Departs'#13'Info_DoseType'#13'Info_Dutys'#13'Info_Trades'#13'Info_Units'#13'Info_Words';
  sqStr = 'select Value from %s';
var sList1, sList2: TStrings;
    sTable, xmlPath, str: String;
    i: integer;
begin
  sList1 := TStringList.Create;
  sList1.Text := sTypes;
  i := sList1.IndexOf(InfoType);
  sList1.Free;
  if i>=0 then
  begin
    sList2 := TStringList.Create;
    sList2.Text := sTables;
    sTable := sList2[i];
    sList2.Free;
  end
  else Exit;
  xmlPath := ExtractFilePath(Application.ExeName)+'XML\';
  str := xmlPath+sTable+'.xml';
  if FileExists(str) then
  begin
    try
      DataSet.LoadFromFile(str);
    Except
      DeleteFile(PChar(str));
      Raise;
    end;
  end
  else
  begin
    DataSet.Close;
    DataSet.CommandText := Format(sqStr, [sTable]);
    DataSet.Open;
    if i>0 then//第一项普通分类不要保存到本地文件，因为它被修改的可能性相对要高
      DataSet.SaveToFile(str, dfXMLUTF8);
  end;
  GetValueList(DataSet, 'Value', Values);
end;

procedure SysFieldXml(FieldsData: TClientDataSet;
  FiltStr, FileName: String);
Var
  FilePath,sFileNames:String;
Begin
  FilePath:=ExtractFilePath(ParamStr(0))+'Xml\';
  if not DirectoryExists(FilePath) then
    CreateDir(FilePath);
  sFileNames:=FilePath+FileName;
  If FileExists(sFileNames) Then Begin
    FieldsData.LoadFromFile(sFileNames);
    FieldsData.Open;
  End Else
  Begin
    FieldsData.CommandText:=FiltStr;
    FieldsData.Open;
    FieldsData.SaveToFile(sFileNames,dfXMLUTF8);
  End;
end;

procedure ShowFieldDisp(CdsFields,CdsCust: TClientDataSet; sTableNames: String);
Var
  Field:TField;
  sFilter,sTables,sFieldName,sDispLabel:String;
  I,J,iTableCount:integer;
  sTableList:TStrings;
Begin
  Try
    sTableList:=TStringList.Create;
    xStrSplit(sTableNames, [','],sTableList);
    sFilter:=' Lower(TableName) In ( ';
    iTableCount:=sTableList.Count;
    if iTableCount=1 Then begin
      sFilter:=' Lower(TableName) = '''+LowerCase(sTableNames)+'''';
    End Else Begin
      For I:=0 To sTableList.Count-1 Do
        sTables:=sTables+','''+LowerCase(sTableList[i])+'''';
      Delete(sTables,1,1);
      sFilter:=sFilter+sTables+')';
    End;
    With CdsFields Do Begin
      Filtered:=False;
      CdsFields.FilterOptions := [foCaseInsensitive];
      Filter:=sFilter;
      Filtered:=True;
      For J:=0 To RecordCount-1 Do
      Begin
        sFieldName:=FieldByName('FieldName').AsString;
        If SFieldName<>'' then Begin
          Field:=CdsCust.FindField(sFieldName);
          If Field<>Nil Then Begin
            sDispLabel:=FieldByName('DispLabel').AsString;
            Field.DisplayLabel:=sDispLabel;
            Field.Required := FieldByName('Requisite').AsBoolean;
          End;
        End;
        Next;
      End;
    End;
  Except
    On E:Exception Do ;
  End;
End;

Function IsFieldPass(CdsFields,CdsCust:TClientDataSet;sTableName:String;sTitle:String): Boolean;
Const
  sFilter=' TableName =''%s'' and Requisite ';
Var I:Integer;
    sDispFormat,sFieldName,sMainLabel,sDispLabel,sText:String;
    Field: TField;
    bRequisite:Boolean;
begin
   Result:=True;
   sMainLabel:=sTitle;
  With CdsFields Do Begin
    Filtered:=False;
    sText:=Format(sFilter,[sTableName]);
    Filter:=sText;
    Filtered:=True;
    First;
    For I:=0 To RecordCount-1 Do
    Begin
      sDispFormat := FieldByName('DispFormat').AsString;
      sFieldName  := FieldByName('FieldName').AsString;
      sDispLabel  := FieldByName('DispLabel').AsString;
      bRequisite  := FieldByName('Requisite').AsBoolean;
      If sDispFormat='TITLE' Then
        sMainLabel:=sDispLabel    //判断是否为表标题
      Else If bRequisite Then
      Begin
        Field := cdsCust.FindField(sFieldName);
        If (Field<>nil)and(Field.IsNull) Then Begin
          if sMainLabel='' then sMainLabel := sTableName;
          Application.MessageBox(Pchar(sMainLabel+'的['+sDispLabel+']不能为空!'),'错误：',16);
          Result:=False;
          Exit;
        End;
      End;
      Next;
    End;
  End;
End;

end.