dmunit.~pas

根据客户对销售人员回款返利和业绩返利的功能需求所开发

unit dmUnit;

interface

uses
  SysUtils, Classes, DB, ADODB,Dialogs,FORMs,windows;

type
  Tdm = class(TDataModule)
    ADOConnection1: TADOConnection;
    ADOConnection2: TADOConnection;
    cdsPSWD: TADOQuery;
    cdsPSWDCOMPNO: TStringField;
    cdsPSWDUSR: TStringField;
    cdsPSWDNAME: TStringField;
    cdsPSWDPWD: TStringField;
    cdsPSWDMNG: TStringField;
    cdsPSWDE_DAT: TDateTimeField;
    cdsPSWDDEP: TStringField;
    cdsPSWDB_DAT: TDateTimeField;
    cdsPSWDREM: TStringField;
    cdsPSWDSPC_CTL: TStringField;
    cdsPSWDALL_CMP: TStringField;
    cdsPSWDCOMP_BOSS: TStringField;
    cdsPSWDMOD: TBlobField;
    cdsPSWDNO_DESKTOP: TStringField;
    cdsPSWDISSHOW: TStringField;
    cdsPSWDDEP_UP: TStringField;
    cdsPSWDISMAIL: TStringField;
    cdsPSWDE_MAIL: TStringField;
    cdsPSWDISGROUP: TStringField;
    cdsPSWDISSALM: TStringField;
    cdsPSWDISCUST: TStringField;
    cdsPSWDISYG: TStringField;
    cdsPSWDUPD_DD: TDateTimeField;
    cdsPSWDPWD_CHG: TStringField;
    cdsPSWDEXPIRE_ID: TStringField;
    cdsPSWDPWD_NOTCHG: TStringField;
    cdsPSWDLANG_ID: TStringField;
    cdsPSWDEXPIRE_DD: TDateTimeField;
    cdsPSWDHOSTNAME: TWideStringField;
    cdsCOMP: TADOQuery;
    cdsCOMPCOMPNO: TStringField;
    cdsCOMPNAME: TStringField;
    DataSource1: TDataSource;
    cdsPSWDdisUser: TStringField;
    qryQuery: TADOQuery;
    qryQuery1: TADOQuery;
    ADOQuery1: TADOQuery;
    ado1: TADOQuery;
    ado2: TADOQuery;
    procedure cdsPSWDCalcFields(DataSet: TDataSet);
  private
    { Private declarations }
  public
    COMPNO,USR:String;
    Login:Boolean;
    COMP_BOSS:Boolean;
    ComputerName:string;
    zt:String;//账套
      function Enc(Str:String):String;//字符加密函數  這是用的一個異或加密
      function Dec(Str:String):String;//字符解密函數
     Function F_formatStr(const s:string;iLength:integer):string;
     function EncryptionEngine(Src, Key: String; Encrypt: Boolean): string;
     function MakePWD(szBPWD: String): String;
     procedure getQuery(sql:string);
      procedure qryExecute(sql:String);
      function setLengthStr(i,width:integer):string;//数据，长度
       function getSubString(s:string;pos:integer):string;
       function getQty1(prd_no:string;qty:double):double;
           function  GetAutoNo(table :String;PKField: String;Search:String): string;
            Procedure getSearch(var vForm:TFORM;qry:TADOQuery;initSql,FieldA_TIME,FieldB_TIME,S_Caption,FieldA,TitleA,FieldB,TitleB:String);
    { Public declarations }
  end;

var
  dm: Tdm;

  const

      XorKey:array[0..7] of Byte=($B2,$09,$AA,$55,$93,$6D,$84,$47); //字符串加密用


implementation

uses frmSearchUnit;

{$R *.dfm}

{ Tdm }

function Tdm.Dec(Str: String): String;
var
 i,j:Integer;
begin
 Result:='';
 j:=0;
 for i:=1 to Length(Str) div 2 do
   begin
     Result:=Result+Char(StrToInt('$'+Copy(Str,i*2-1,2)) xor XorKey[j]);
     j:=(j+1) mod 8;
   end;

end;

function Tdm.Enc(Str: String): String;
var
 i,j:Integer;
begin
 Result:='';
 j:=0;
 for i:=1 to Length(Str) do
   begin
     Result:=Result+IntToHex(Byte(Str[i]) xor XorKey[j],2);
     j:=(j+1) mod 8;
   end;
end;

procedure Tdm.cdsPSWDCalcFields(DataSet: TDataSet);
begin
 cdsPswd.FieldByName('disUser').AsString:=F_formatStr(cdsPswdUSR.AsString,10)+'      '+f_formatStr(cdsPswdName.AsString,10);
end;

function Tdm.F_formatStr(const s: string; iLength: integer): string;
var
  tempS:string;
  i:integer;
begin
  tempS:=s;
  if length(s)>iLength then
    temps:=copy(s,1,iLength)
  else
    begin
      for i:=length(s) to iLength-1 do
        temps:=temps+' ';
    end;
  result:=temps;  
end;

function Tdm.EncryptionEngine(Src, Key: String; Encrypt: Boolean): string;
var
  KeyLen    :Integer;
  KeyPos    :Integer;
  offset    :Integer;
  dest      :string;
  SrcPos    :Integer;
  SrcAsc    :Integer;
  TmpSrcAsc :Integer;
  Range     :Integer;
begin
  KeyLen:=Length(Key);
  if KeyLen = 0 then key:='sunlike.com';
  KeyPos:=0;
  Range:=256;
  if Encrypt then
  begin
      Randomize;
      offset:=Random(Range);
      dest:=format('%1.2x',[offset]);
      for SrcPos := 1 to Length(Src) do
      begin
           SrcAsc:=(Ord(Src[SrcPos]) + offset) MOD 255;
           if KeyPos < KeyLen then KeyPos:= KeyPos + 1 else KeyPos:=1;
           SrcAsc:= SrcAsc xor Ord(Key[KeyPos]);
           dest:=dest + format('%1.2x',[SrcAsc]);
           offset:=SrcAsc;
      end;
  end
  else
  begin
      try
        offset:=StrToInt('$'+ copy(src,1,2));
        SrcPos:=3;
        repeat
              SrcAsc:=StrToInt('$'+ copy(src,SrcPos,2));
              if KeyPos < KeyLen Then KeyPos := KeyPos + 1 else KeyPos := 1;
              TmpSrcAsc := SrcAsc xor Ord(Key[KeyPos]);
              if TmpSrcAsc <= offset then
                   TmpSrcAsc := 255 + TmpSrcAsc - offset
              else
                   TmpSrcAsc := TmpSrcAsc - offset;
              dest := dest + chr(TmpSrcAsc);
              offset:=srcAsc;
              SrcPos:=SrcPos + 2;
        until SrcPos >= Length(Src);
      except
      end;
  end;
  Result:=dest;

end;

function Tdm.MakePWD(szBPWD: String): String;
var
     Loopi, iLenght : Integer;
begin
  szBPWD:=UpperCase(szBPWD);
  iLenght:= Length(szBPWD);
  for Loopi  :=1 to iLenght do
    szBPWD[Loopi] := Char(Integer(szBPWD[Loopi]) + Loopi + 30);

  if (iLenght mod 2) = 1 then
    szBPWD[iLenght]:= Char(Integer(szBPWD[iLenght]) - iLenght - 30);
  Result := szBPWD;
end;

procedure Tdm.getQuery(sql: string);
begin
 qryQuery.Active:=False;
  qryQuery.SQL.Clear;
  qryQuery.SQL.Add(sql);
  qryQuery.Active:=True;
end;

procedure Tdm.qryExecute(sql: String);
begin
  adoquery1.Active:=False;
  adoQuery1.SQL.Clear;
  adoQuery1.SQL.Add(sql);
  try
    adoQuery1.ExecSQL;

  except
     showMessage(sql);
  end;
end;

function Tdm.setLengthStr(i, width: integer): string;
var
  j,k:integer;
  s:string;
begin
  s:=intToStr(i);
  for k:=1 to width do
    s:='0'+s;
  {for j:=length(s) to width do
    s:='0'+s; }
  result:=s;  


end;

function Tdm.getSubString(s: string; pos: integer): string;
var
  temp:String;
  ch:char;
  i,j:Integer;
begin
   j:=0;
   temp:='';
   for i:=0 to length(s) do
     begin
       if s[i]=';' then
         inc(j);
       if i>pos then
         begin
           if j=pos then
            temp:=temp+s[i];
          end;
     end;
   result:=temp;

end;

function Tdm.getQty1(prd_no: string; qty: double): double;
VAR
  sql,t1,t2:STRING;
  r:double;
BEGIN


        r:=0;
        sql:='select FORMULA from prdt where prd_no='''+PRD_NO+'''';
        ado1.Active:=False;
        ado1.SQL.Clear;
        ado1.SQL.Add(sql);
        ado1.Active:=True;
        if ado1.Fields[0].AsString<>'' then
          begin
            t1:=ado1.Fields[0].AsString;

            t2:=dm.getSubString(ado1.Fields[0].asstring,5);
            t2:=copy(t2,12,length(t2));
            sql:='select '+formatFloat('0.00000',qty)+t2+'.00';
            ado2.Active:=False;
            ado2.SQL.Clear;
            ado2.SQL.Add(sql);
            ado2.Active:=true;
            r:=ado2.Fields[0].AsFloat;
          end;

     result:=r;
end;
 

function Tdm.GetAutoNo(table, PKField, Search: String): string;

begin
    dm.getQuery('SELECT MAX(right('+PKField+',4)) AS AutoNO FROM '+table+' Where ' + PKField +' LIKE  ''' + Search + '%'' AND ISNUMERIC(right('+PKField+',4))=1');
     //CommandText:='SELECT MAX(right('+PKField+',4)) AS AutoNO FROM '+table+' Where ' + PKField +' LIKE  ''' + Search + '%'' AND ISNUMERIC(right('+PKField+',4))=1';
     //Open;
     if not dm.qryQuery.Fields[0].IsNull then
            result:=Search+FormatFloat('0000',dm.qryQuery.Fields[0].AsInteger+1)
     else
            result:=Search+'0001';
end;

procedure Tdm.getSearch(var vForm: TFORM; qry: TADOQuery; initSql,
  FieldA_TIME, FieldB_TIME, S_Caption, FieldA, TitleA, FieldB,
  TitleB: String);
begin
 if qry.State in [dsInsert,dsEdit] then
    begin
      if Application.MessageBox('数据已经修改，是否放弃保存','放弃保存?', MB_ICONINFORMATION +MB_YESNO)=IDNO then exit
      else
        qry.Cancel;
    end;
  if vForm=nil  then
    begin
     vForm:=tfrmSearch.create(self);
     (vForm as TfrmSearch).dsSource.DataSet:=qry;
     (vForm as TfrmSearch).DBGrid1.Columns[0].FieldName:=FieldA;
     (vForm as TfrmSearch).DBGrid1.Columns[1].FieldName:=FieldB;
     (vForm as TfrmSearch).DBGrid1.Columns[0].Title.Caption:=TitleA;
     (vForm as TfrmSearch).DBGrid1.Columns[1].Title.Caption:=TitleB;
     (vForm as TfrmSearch).initSql:=initSql;
     (vForm as TfrmSearch).FieldA:=FieldA;
     (vForm as TfrmSearch).FieldB:=FieldB;
     (vForm as TfrmSearch).FieldA_TIME:=FieldA_TIME;
     (vForm as TfrmSearch).S_Caption:=s_Caption;
     (vForm as TfrmSearch).S_DD.Date :=now;
     (vForm as TfrmSearch).E_DD.Date :=now;
   end;

     (vForm as TfrmSearch).show;
end;

end.