⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 datamodule1_b.pas

📁 飞恒进销存(超市批发)管理系统(含源程序) 语言:Delphi 6/7 相关控件:FastReport 2.4以上, Ehlib 3.4以上
💻 PAS
📖 第 1 页 / 共 4 页
字号:
    fieldbyname('name').asstring:='';
  end;

end;

procedure TDataE2.tblType2NewRecord(DataSet: TDataSet);
begin
  with tblType2 do
  begin
    fieldbyname('type').asstring:=tblType1.fieldbyname('type').asstring;
    fieldbyname('code1').asstring:=tblType1.fieldbyname('code1').asstring;;
    fieldbyname('code2').asstring:='*';
    fieldbyname('name').asstring:='';
  end;

end;

procedure TDataE2.QueryGoodsCalcFields(DataSet: TDataSet);
begin
  with  QueryGoods do
    FieldByName('codename').value:=trim(FieldByName('code').value)+' '+trim(FieldByName('name').value);
end;

procedure TDataE2.DecodeSelection;
begin
  if sSelection[1]='1' then bNostore:=true else bNoStore:=false;
  if sSelection[2]='1' then bExtraPage:=true else bExtraPage:=false;
  nSysPaper:=strtoint(sSelection[3]);
  nSysLevel1:=strtoint(sSelection[4]); //各级编码的总长(含上级) - 1
  nSysLevel2:=nSysLevel1+strtoint(sSelection[5]);
  nSysLevel3:=nSysLevel2+strtoint(sSelection[6]);
  if sSelection[7]='1' then bInputTip:=true else bInputTip:=false;
  if sSelection[8]='1' then bFIFO:=true else bFIFO:=false;
  nSample:=strtoint(sSelection[9]);
  if sSelection[10]='1' then bZone:=true else bZone:=false;
  if sSelection[11]='1' then bPenStyle:=true else bPenStyle:=false;
  nInpriceType:=strtoint(sSelection[12]);
  nSumbit:=strtoint(sSelection[13]);
  if sSelection[14]='1' then bPrintBarcode:=true else bPrintBarcode:=false;
  nPageBottomMargin:=strtoint(sSelection[15])*10+strtoint(sSelection[16]);
  if sSelection[17]='1' then bTwoUnit:=true else bTwoUnit:=false;

  if nSaveDataDay=0 then nSaveDataDay:=999; //不册除数据
  if nSysLine=0 then nSysLine:=999;         //为0 不打印分隔线
end;

Function  TDataE2.ToMyValue(oldValue:real):real;
var
  nNum,nAbs:integer;
  nTmp:real;
begin
  nNum:=100;
  case nSumbit of
  0: nNum:=1;
  1: nNum:=10;
  2: nNum:=100;
  3: nNum:=1000;
  4: nNum:=10000;
  end;

  nAbs:=1;
  if OldValue <0 then nAbs:=-1;

  nTmp:=OldValue*nNum;

  nTmp:=nTmp+0.5*nAbs; //四舍五入

  nTmp:=int(nTmp)/nNum;

  result:=nTmp;
end;

procedure TDataE2.EncodeHotel;
var
   fSys,fHotel:TextFile;
   s,sFileName:string;
   nLength,i:integer;
begin
   AssignFile(fSys,'\sxm\data\飞恒.TXT');
   Reset(fSys);
   Readln(fSys,s);
   closeFile(fSys);

   AssignFile(fHotel,s);
   Reset(fHotel);
   readln(fHotel,s);
   closeFile(fHotel);

   nLength:=length(s);
   for i:=1 to nlength do
      s[i]:=chr( ord(s[i])xor ord(CopyRight[i mod 22+1]) xor ord(Software[i mod 16+1]) xor (ord(Developer[i mod 30])+i*2+8));

   AssignFile(fSys,'\sxm\data\飞恒.sys');
   Reset(fSys);
   Readln(fSys,sFileName);
   closeFile(fSys);

   AssignFile(fHotel,sFilename);
   ReWrite(fHotel);
   writeln(fHotel,s);
   closeFile(fHotel);
end;

procedure TDataE2.DecodeOneHotel ;
var
   fSys,fHotel:TextFile;
   s:string;
   ch:char;
   i,n:integer;
begin
   s:='\sxm\data\飞恒软件.txt';
   if FileExists(s) then
     AssignFile(fSys,'\sxm\data\飞恒软件.txt')
   else
     AssignFile(fSys,'\sxm\data\飞恒.sys');

   Reset(fSys);
   Readln(fSys,s);
   Readln(fSys,HotelId);
   closeFile(fSys);

   AssignFile(fHotel,s);
   Reset(fHotel);
   i:=1;
   n:=1;
   s:='';
   while not eof(fHotel) do
   begin
      read(fHotel,ch);
      ch:=chr( ord(ch) xor ord(CopyRight[i mod 22+1]) xor ord(Software[i mod 16+1]) xor (ord(Developer[i mod 30])+i*2+8));
      //for demo
      //ch:=chr( ord(ch) xor ord(CopyRight[i mod 21+1]) xor ord(Software[i mod 15+1]) xor (ord(Developer[i mod 30])+i*2+7));
      if ch='/' then
      begin
        if n=1 then HotelName:=s;
        if n=2 then
        try
          InstallDate:=strTodate(s);
        except
        end;
        if n=3 then HotelSpe:=StrToint(s);
        s:='';
        inc(n);
      end
      else
       s:=s+ch;

      inc(i);
   end;

   closeFile(fHotel);
end;

function TDataE2.ReadRegistry:string;
var
  sRegCode,sHotelid:string;
  Registry: TRegistry;
begin
  sRegCode:=RegisterCode(SerialNo(EncodeString(hotelName,EncodeKey)),hotelId);

  Registry:=TRegistry.Create;
  try
    Registry.OpenKey('\Software\ODBC\ODBC.INI\myMRP',False);
    case abs(HotelSpe) of
      1..9    :  sHotelId:=HotelId+'_HOTEL';
      100..999:  sHotelId:=HotelId+'_POS';
      else       sHotelId:=HotelId+'_MRP';
    end;
    result:=Registry.ReadString(sHotelId);
  finally
    Registry.Free;
  end;
end;

function TDataE2.WriteRegistry:boolean;
var
  sRegCode,sHotelid:string;
  Registry: TRegistry;
begin
  result:=false;
  sRegCode:=RegisterCode(SerialNo(EncodeString(hotelName,#143#7#91#37)),hotelId);

  Registry:=TRegistry.Create;
  try
    Registry.OpenKey('\Software\ODBC\ODBC.INI\myMRP',true);
    case abs(HotelSpe) of
      1..9    :  sHotelId:=HotelId+'_HOTEL';
      100..999:  sHotelId:=HotelId+'_POS';
      else       sHotelId:=HotelId+'_MRP';
    end;
    Registry.WriteString(sHotelId,sRegCode);
    result:=true;
  finally
    Registry.CloseKey ;
    Registry.Free;
  end;
end;

//对客户名称进行变换
function TDataE2.EncodeString(mCusName,mKey:string):string;
var
  I, J: Integer;
  s:string;
begin
  J := 1;
  s:='';
  for I := 1 to Length(mCusName) do
  begin
    s := s + Char(Ord(mCusName[I]) xor Ord(mKey[J]));
    if J + 1 <= Length(mKey) then
      Inc(J)
    else
      J := 1;
  end;
  { 自己加步骤 }
  result:=s;
end; { StringEncrypt }

//生成序列号,最后只取8位
function TDataE2.SerialNo(mString: string): string;
var
  I,n,k,m: Integer;
  S: string;
begin
  Result := '';
  S := '';
  m:=0;
  for I := 1 to Length(mString) do
  begin
    n:= m+ord(mString[I]) ;
    k:= n div 7;
    case k of
      0..9   : n:=k +48;
      10..35 : n:=k + 55;
    else
      n:=50;
    end;
    S := S + chr(n);
    m:=( m + n ) or (m-n);
  end;
  Result := s;
end; { StringToDisplay }

//由序列号生成注册号: 前8位为序列号,后7位为加密号
function TDataE2.RegisterCode(mString,mCusNo: string): string;
var
  I,n,k,m,j: Integer;
  S,ch: string;
begin
  Result := '';
  s:='';
  j:=1;
  for I:=1 to 8 do
  begin
    s := s + Char(Ord(mString[I]) xor (Ord(mCusNo[J])* Ord(mCusNo[3]) +1) );
    if J + 1 <= Length(mCusNo) then
      Inc(J)
    else
      J := 1;
  end;

  ch:=s;
  S := '';
  m:=0;
  for I := 1 to 7 do
  begin
    n:= m+ord( ord(mString[I]) xor ord(ch[8-I]) xor ord(ch[I])  ) ;
    k:= n div 7;
    case k of
      0..9   : n:=k +48;
      10..35 : n:=k + 55;
    else
      n:=53;
    end;
    S := S + chr(n);
    m:=( m + n ) or ( m - n   ) ;
  end;
  Result := copy(mString,1,5)+'-'+copy(mstring,6,3) + copy(s,1,2)+'-'+copy(s,3,5);
end; { StringToDisplay }

function TDataE2.GetWindowsPlatFormId:integer;
var
  OS: TOSVersionInfo;
  PlatformId: Dword;
{  function Plat(Pl: DWORD): string;
  begin
    case Pl of
      VER_PLATFORM_WIN32s: result := 'Win32s on Windows 3.1x';
      VER_PLATFORM_WIN32_WINDOWS: result := 'Windows 95/98/ME';
      VER_PLATFORM_WIN32_NT:   result := 'Windows NT/2000/XP';
    else
      result := 'Windows';
    end;
  end;}
begin
  PlatformId := 0;
  try
  with OS do
  begin
      dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
      if GetVersionEx(OS) then
      begin
        PlatformId := 0;//dwPlatformId;
        if dwPlatFormid =  VER_PLATFORM_WIN32_NT then
         if  (dwMajorVersion = 5 )and (dwMinorVersion = 1 ) then
          platformId:=1; //xp
      end;
  end; //Os
  except
  end;
  result:=PlatFormId;
end;

Function TDataE2.checkPrimaryKey(Tablename,FieldValue,sValue:string):boolean;
begin
  with ADOQuery1 do
  begin
    //查询FieldValue是否己存在
    close;
    sql.Clear ;
    sql.Add('select '+FieldValue+' from '+Tablename+' where '+FieldValue+' = :'+FieldValue);
    parameters[0].value:=sValue;
    open;
    result:=not eof;
  end;
end;

Function TDataE2.GetComputname:string;
var
  name:PChar;
  len:dword;
begin
  len:=30;
  getmem(name,30); //建立一指定大小的动态变量,并将指针指向该处
  getcomputername(name,len);
  result:=name;
end;


procedure TDataE2.ShowAdoError;
var
  sInfo:string;
  adoErrors:Errors;
  adoErr:Error;
  iCount:integer;
begin
  sInfo:='';
  adoErrors:=AdoConStore.Errors ;
  for iCount:=0 to adoErrors.count-1 do
  begin
    adoErr:=adoErrors.item[iCount];
    sInfo:=sInfo+'错误号: '+intTostr(adoErr.number)+chr(13);
    sInfo:=sInfo+'代码  : '+adoErr.source+chr(13);
    sInfo:=sInfo+'说明  : '+adoErr.description+chr(13);
    sInfo:=sInfo+'状态  : '+adoErr.sqlstate+chr(13);
  end;
  application.MessageBox(pchar(sInfo),'错误',MB_OK+MB_ICONINFORMATION);
end;

procedure TDataE2.tblGoodsNewRecord(DataSet: TDataSet);
begin
  tblGoods.FieldByName('perqty').AsInteger:=1
end;

procedure TDataE2.tblGoodsAfterScroll(DataSet: TDataSet);
begin
  if QuerySum.active then QuerySum.close;
  querySum.sql.clear;
  QuerySum.sql.Add('select o.*,s.name from onhand o,store s where o.goodsid= :goodsid and o.storeid=s.storeid');
  QuerySum.parameters[0].Value:=tblGoods.fieldbyname('goodsid').asinteger;
  QuerySum.open;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -