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

📄 constunt.~pas

📁 适合新手 绝对精品 仓库管理系统 本人花钱购买来的源代
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
      begin
        if Trim(Fields[0].AsString) <> '' then
          Result.Add(Fields[0].AsString);
        Next;
      end;
      Close;
    finally
      Free;
    end;
end;

function TLogonInf.GetHwggLst: TStringList;
begin
  Result := TStringList.Create;

  with TADOQuery.Create(nil) do
    try

      Connection := FdbCkgl;
      Prepared;
      Close;
      SQL.Clear;
      SQL.Add('select gg from rk group by gg');
      Open;
      while not Eof do
      begin
        if Trim(Fields[0].AsString) <> '' then
          Result.Add(Fields[0].AsString);
        Next;
      end;
      Close;
    finally
      Free;
    end;
end;

function TLogonInf.GetYsfsLst: TStringList;
const
  cYsfs: array[0..3] of string = ('汽车', '火车', '飞机', '轮船');
var
  I: Byte;
begin
  Result := TStringList.Create;

  with TADOQuery.Create(nil) do
    try

      Connection := FdbCkgl;
      Prepared;
      Close;
      SQL.Clear;
      SQL.Add('select yxfs from ck group by yxfs');
      Open;
      while not Eof do
      begin
        if Trim(Fields[0].AsString) <> '' then
          Result.Add(Fields[0].AsString);
        Next;
      end;
      Close;
      for I := 0 to Length(cYsfs) - 1 do
        if Result.IndexOf(cYsfs[I]) = -1 then
          Result.Add(cYsfs[I]);
    finally
      Free;
    end;
end;

function TLogonInf.GetShdzLst: TStringList;
begin
  Result := TStringList.Create;

  with TADOQuery.Create(nil) do
    try

      Connection := FdbJbda;
      Prepared;
      Close;
      SQL.Clear;
      SQL.Add('select dz from kh');
      Open;
      while not Eof do
      begin
        if Trim(Fields[0].AsString) <> '' then
          Result.Add(Fields[0].AsString);
        Next;
      end;

      Close;
      Connection := FdbCkgl;
      SQL.Clear;
      SQL.Add('select shdz from ck group by shdz');
      Open;
      while not Eof do
      begin
        if Result.IndexOf(Fields[0].AsString) = - 1 then
          Result.Add(Fields[0].AsString);
        Next;
      end;
      Close;
    finally
      Free;
    end;

end;

function TLogonInf.GetJhrmLst: TStringList;
begin
  Result := TStringList.Create;

  with TADOQuery.Create(nil) do
    try
      Connection := FdbCkgl;
      Close;
      SQL.Clear;
      SQL.Add('select jhr from jc group by jhr');
      Open;
      while not Eof do
      begin
        Result.Add(Fields[0].AsString);
        Next;
      end;
      Close;
    finally
      Free;
    end;
end;


function TLogonInf.GetAllRecord(const TabName,
  FieldName: ShortString): TStringList;
begin
  Result := TStringList.Create;
  //设置默认前缀
  with TADOQuery.Create(nil) do
    try
      //设置查询组件的属性,使其连接到数据库jbda
      Connection := FdbJbda;
      Prepared;
      Close;
      //清空sql语句
      SQL.Clear;
      //添加带参数的查询符合查询条件的记录的sql语句
      SQL.Add('select %s from %s');
      //设置参数的实值
      SQL.Text := Format(SQL.Text, [FieldName, TabName]);
      //打开查询
      Open;
      //判断是否有符合条件的记录
      while not Eof do
      //有符合条件的记录,将搜索到的记录的FieldName字段的值添加到result变量中
      begin
        if Trim(Fields[0].AsString) <> '' then
          Result.Add(Fields[0].AsString);
        Next;
      end;
      //关闭查询
      Close;
    finally
     //释放查询组件
      Free;
    end;
end;

function TLogonInf.GetTabEnNameLst: TStringList;
var
  I: Byte;
begin
  Result := TStringList.Create;
  Result.Clear;
  for I := 0 to Length(CkEnTab) - 1 do
    Result.Add(CkEnTab[I]);
end;

function TLogonInf.GetTabCnNameLst: TStringList;
var
  I: Byte;
begin
  Result := TStringList.Create;
  Result.Clear;
  for I := 0 to Length(CkCnTab) - 1 do
    Result.Add(CkCnTab[I]);  
end;

function TLogonInf.GetFieldCnNameLst: TStringList;
var
  I: Byte;
begin
  Result := TStringList.Create;
  Result.Clear;

  FFieldTypeLst := TStringList.Create;
  FFieldTypeLst.Clear;
  
  with TADOQuery.Create(nil) do
    try
      Connection := FdbCkgl;
      Close;
      SQL.Clear;
      SQL.Add('select * from ' + CkEnTab[FTabNameIndex]
        + ' where bh = -1');
      Open;
      for I := 0 to FieldCount - 1 do
      begin
        Result.Add(GetCnFieldName(Fields[I].FieldName));
        case Fields[I].DataType of
          ftString, ftMemo, ftFixedChar, ftWideString, ftFmtMemo:
            if Fields[I].FieldName = CkEnTab[FTabNameIndex] + 'rq' then
              FFieldTypeLst.Add('date')
            else
              FFieldTypeLst.Add('string');
              
          ftBoolean:
            FFieldTypeLst.Add('boolean');
            
          else
            FFieldTypeLst.Add('int');
        end;
        
      end;

      Close;
    finally
      Free;
    end;
end;


procedure TLogonInf.SetTabNameIndex(Value: Integer);
begin
  FTabNameIndex := Value;
end;

procedure TLogonInf.SetFieldNameIndex(Value: Integer);
begin
  FFieldNameIndex := Value;
end;

procedure TLogonInf.SetOpratorIndex(Value: Integer);
begin
  FOpratorIndex := Value;
end;

procedure TLogonInf.SetLinkIndex(Value: Integer);
begin
  FLinkIndex := Value;
end;

function TLogonInf.GetCnFieldName(const EnFieldName: ShortString)
  : ShortString;
var
  I: Word;
begin
  Result := EnFieldName;

  for I := 0 to Length(En_FieldName) - 1 do
    if EnFieldName = En_FieldName[I] then
      Result := Cn_FieldName[I];

end;

function TLogonInf.GetOpratorCnLst: TStringList;
var
  I: Byte;
begin
  Result := TStringList.Create;
  Result.Clear;
  for I := 0 to Length(Cn_Oprator) - 1 do
    Result.Add(Cn_Oprator[I]);
end;



function TLogonInf.GetLinkCnLst: TStringList;
var
  I: Byte;
begin
  Result := TStringList.Create;
  Result.Clear;
  for I := 0 to Length(Cn_Link) - 1 do
    Result.Add(Cn_Link[I]);
end;

function TLogonInf.GetChangePwd: Boolean;
begin
  Result := True;
  //设置默认值
  with TADOQuery.Create(nil) do
    try
      //设置查询组件的属性,使其连接到数据库jbda
      Connection := FdbJbda;
      Connection.BeginTrans;
      Close;
      //清除sql语句
      SQL.Clear;
      if FNewPassWord = '' then
        FNewPassWord := 'null'
      else
        FNewPassWord := #39 + FNewPassWord + #39;
      //添加修改密码的sql语句
      SQL.Add('update czy set mm = ' + FNewPassWord
        + ' where name = ''' + FUserName + #39);
      try
        //执行sql语句
        ExecSQL;
        //提交所作的修改
        Connection.CommitTrans;
      except
        //系统出现异常,设置函数返回值为false
        Result := False;
        //系统出现异常,取消所作的修改
        Connection.RollbackTrans;
      end;
    finally
      //释放查询组件
      Free;
    end;

end;

procedure TLogonInf.SetNewPassWord(Value: ShortString);
begin
  FNewPassWord := Value;
end;

function TLogonInf.GetNextPzh(const TabName, VDate: ShortString)
  : ShortString;
begin
  with TADOQuery.Create(nil) do
    try
      Connection := FdbCkgl;
      Close;
      SQL.Clear;
      SQL.Add('select count(bh) from %s where %s = ''%s''');
      SQL.Text := Format(SQL.Text, [TabName, TabName + 'rq', VDate]);
      Open;
      Result := Format('%s%4.4d', [FormatDateTime(GDateFormat,
        StrToDate(VDate)), Fields[0].AsInteger]);
      Close;
    finally
      Free;
    end;  
end;

function TLogonInf.UpdateLog(const Content: string): Boolean;
begin
  //初始化函数返回值为false
  Result := True;
  //设置默认值
  with TADOQuery.Create(nil) do
    try
      //设置查询组件的属性,使其连接到数据库ckgl
      Connection := FdbCkgl;
      Close;
      Close; 与会
      //清除sql语句
      SQL.Clear;
      //设置添加此次操作记录的
      SQL.Add('insert into log ([logdate], [content], [username]) '
        + 'values ('''
        + DateToStr(Now)  + ''', '''
        + Content + ''', ''' + FUserName + ''')');
      try
        ExecSQL;
      except
        Result := False;
      end;
      Close;
    finally
      Free;
    end;
end;

function TLogonInf.UpdateKc(const Ck, Hwlb, Hwgg, Hwdw, Hwcd: string;
  const Hwsl, Dj: Double): Boolean;
begin
  //初始化函数返回值
  Result := True;
  //设置默认前缀
  with TADOQuery.Create(nil) do
    try
      //设置查询组件的属性,使其连接到数据库ckgl
      Connection := FdbCkgl;
      Close;
      Close;
      //清除sql语句
      SQL.Clear;
      if Dj = 0 then
        //该物品的单价为0,添加在kc表中搜索是否有与此物品具有相同规格、相同类别和相同存储仓库的物品
        SQL.Add('select ck, hwlb, hwgg, hwdw, hwsl, dj, hwcd from kc '
          + 'where hwlb = ''' + Hwlb + ''' and hwgg = '''
          + Hwgg + ''' and ck = ''' + Ck + #39)
      else
      //该物品的单价为0,添加在kc表中搜索是否有与此物品具有相同规格、相同类别、相同单价、相同产地和相同存储仓库的物品
        SQL.Add('select ck, hwlb, hwgg, hwdw, hwsl, dj, hwcd from kc '
          + 'where hwlb = ''' + Hwlb + ''' and hwgg = '''
          + Hwgg + ''' and ck = ''' + Ck + ''' and dj = '
          + CurrToStr(Dj) + ' and hwcd = ''' + Hwcd + #39);
      //打开查询
      Open;
      //判断是否有满足所设条件的记录
      if RecordCount = 0 then
      //库存中存在符合查询条件的记录,添加新物品,并设置各个字段的值
      begin
        Append;
        //设置存储仓库字段的值
        Fields[0].AsString := Ck;
        //设置货物类别字段的值
        Fields[1].AsString := Hwlb;
        //设置货物规格字段的值
        Fields[2].AsString := Hwgg;
        //设置货物单位字段的值
        Fields[3].AsString := Hwdw;
        //设置货物数量字段的值
        Fields[4].Value := Hwsl;
        //设置货物单价字段的值
        Fields[5].Value := Dj;
        //设置货物产地字段的值
        Fields[6].AsString := Hwcd;
      end
      else
      //库存中不存在符合查询条件的记录,修改该物品记录中互殴为数量字段的值
      begin
        Edit;
        Fields[4].AsInteger := Fields[4].Value + Hwsl;
      end;
      try
        //提交所作的修改或添加
        Post;
      except
        //系统出现异常,设置函数返回值为false
        Result := False;
      end;
      Close;
    finally
      //释放该查询组件所占的资源
      Free;
    end;


end;



function TLogonInf.Sjbf(const TargetDir: ShortString): Boolean;
var
  ExistsFileName: string;
begin
  //初始化函数返回值
  Result := True;
  //设置默认前缀
  with TIniFile.Create(WorkPath + 'infor.ini') do
    try
      try
        ExistsFileName := ReadString('Normal', 'DBJbdaConnection', '');
        //备份数据库jbda
        CopyFile(PChar(ExistsFileName), PChar(TargetDir
          + ExtractFileName(ExistsFileName)), True);

        ExistsFileName := ReadString('Normal', 'DBCkglConnection', '');
        //备份数据库ckgl
        CopyFile(PChar(ExistsFileName), PChar(TargetDir
          + ExtractFileName(ExistsFileName)), True);
      except
        //系统出现异常,设置函数返回值为false
        Result := False;
      end;
    finally
      Free;
    end;
end;

function TLogonInf.Sjhf(const FileNames: TStringList): Boolean;
var
  ExistsFileName: string;
begin
  //初始化函数返回值
  Result := False;
  if FileNames.Count <> 2 then
    Exit;
  //断开与数据jbda的连接
  FdbJbda.Connected := False;
  //断开与数据库ckgl的连接
  FdbCkgl.Connected := False;
  //设置默认前缀
  with TIniFile.Create(WorkPath + 'infor.ini') do
    try
      ExistsFileName := ReadString('Normal', 'DBJbdaConnection', '');
      //恢复数据库jbda
      CopyFile(PChar(FileNames.Strings[0]),
        PChar(ExtractFilePath(ExistsFileName)
        + ExtractFileName(FileNames.Strings[0])), False);
      //恢复数据库ckgl
      CopyFile(PChar(FileNames.Strings[1]),
        PChar(ExtractFilePath(ExistsFileName)
        + ExtractFileName(FileNames.Strings[1])), False);
    finally
      Free;
    end;
  //设置按数返回值为true
  Result := True;
end;

procedure TLogonInf.Ckpd(const PdBeginTime, PdEndTime: string);
begin
  with TADOQuery.Create(nil) do
    try
      Connection := FdbCkgl;
      Close;  //, , kcsl
      SQL.Clear;
      SQL.Add('insert into pd (pdbrq, pderq, hplb, cd, gg, pdck, '
        + 'pky, czy, jldw) select ''%s'', ''%s'', rk.hplb, rk.cd, '
        + 'rk.gg, rk.cfck,  '
//        + 'iif(sum(ck.ckze - rk.rkze)=null,0,sum(ck.ckze - rk.rkze)) '
        + 'sum(ck.ckze - rk.rkze) / 2, ''%s'', rk.jldw '
        + 'from rk, ck '
        + 'where rk.rkrq >= ''%s'' and rk.rkrq <= ''%s'' '
        + 'group by rk.hplb, rk.cd, rk.gg, rk.cfck, ck.chck, rk.jldw'
        );
        //,

      SQL.Text := Format(SQL.Text,
       [PdBeginTime, PdEndTime, LogonInf.UserName,
         PdBeginTime, PdEndTime]);

      //MessageBox(0, PChar(SQL.Text), MsgI, Msg1IBTN);
      //Exit;
      ExecSQL;
    finally
      Free;
    end;

end;


procedure TLogonInf.DeletePdData(const TableName: string);
begin
  with TADOQuery.Create(nil) do
    try
      Connection := FdbCkgl;
      Close;
      SQL.Clear;
      SQL.Add('delete from %s');
      SQL.Text := Format(SQL.Text, [TableName]);
      ExecSQL;
      Close;
    finally
      Free;
    end;
end;

function TLogonInf.GetEnFieldName(const CnFieldName: string): string;
var
  I: Word;
begin
  Result := CnFieldName;

  for I := 0 to Length(Cn_FieldName) - 1 do
    if CnFieldName = Cn_FieldName[I] then
      Result := En_FieldName[I];
 
end;

end.


⌨️ 快捷键说明

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