allvar.pas

来自「图书馆管理系统设计详细资料」· PAS 代码 · 共 1,386 行 · 第 1/3 页

           + #10 + #13 + '出错值 : ' + s );
           result := 1;
         end;
    k := pos(' ',s);
    if k > 0
    then begin
           showmessage('字符串中含有《间隔符》出错！'
             + #10 + #13 + '字段名 : ' + mydbgrid.Columns[i].Title.Caption
             + #10 + #13 + '出错值 : ' + s );
           result := 2;
         end;

    if (quy.Fields.Fields[i].DataType = ftstring) and (result = 0)
    then begin
           if length(s) > quy.Fields.Fields[i].Size
           then begin
                  showmessage('字符串长度出错！'
                     +#13+'字段号..' + inttostr(i+1)
                     +#13+'字段名..' + mydbgrid.Columns[i].Title.Caption
                     +#13+'字段值..' + s );
                  result := i;
                end
           else SQL.Query[ukinsert].Params[i].Asstring := s;
         end
    else if quy.Fields.Fields[i].DataType = ftinteger
    then begin
           if not jcintfu(s)
           then begin
                  showmessage('整数类型出错！'
                     +#13+'字段号..' + inttostr(i+1)
                     +#13+'字段名..' + mydbgrid.Columns[i].Title.Caption
                     +#13+'字段值..' + s );
                  result := i;
                end
           else SQL.Query[ukinsert].Params[i].Asinteger := strtoint(s);
         end
    else if quy.Fields.Fields[i].DataType = ftfloat
         then begin
                if not jcrealfu(s)
                then begin
                       showmessage('实数类型出错！'
                          +#13+'字段号..' + inttostr(i+1)
                          +#13+'字段名..' + mydbgrid.Columns[i].Title.Caption
                          +#13+'字段值..' + s );
                       result := i;
                     end
                else SQL.Query[ukinsert].Params[i].AsFloat := strtofloat(s);
              end
    else if (quy.Fields.Fields[i].DataType = ftDate) or
            (quy.Fields.Fields[i].DataType = ftDatetime )
         then begin
                if not jcdateSPfu(s)
                then begin
                       showmessage('日期类型出错！'
                       +#13+'字段号..' + inttostr(i+1)
                       +#13+'字段名..' + mydbgrid.Columns[i].Title.Caption
                       +#13+'字段值..' + s );
                       result := i;
                     end
                else if s = ''
                     then SQL.Query[ukinsert].Params[i].Value := null
                     else SQL.Query[ukinsert].Params[i].Value := strtodate(s);
              end
         else SQL.Query[ukinsert].Params[i].Value := s;
    inc(i);
  end;
  if result = 0
  then begin
         SQL.Query[ukinsert].Params[i].Value := ADDjlhFU(vjlh);
         SQL.ExecSQL(ukinsert);
       end;

  quy.CachedUpdates := false;
end;

procedure delpmjlpd(quy : TQuery;sql : TUpdateSQL);
var vjlh : integer;
begin
  if not (MessageDLG('确定要删除显示在屏幕中的记录吗？',
           mtCONfirmation,[mbYes,mbNo],0) = mrYes)
  then exit;
  if quy.RecordCount > 0       //一条以上记录
  then begin
         quy.CachedUpdates := true;
         sql.SetParams(ukdelete);;
         while not quy.Eof do
         begin
           vjlh := quy.FieldByName('jlh').ASinteger;
           SQL.Query[ukdelete].Params[0].Value :=  vjlh ;
           SQL.ExecSQL(ukdelete);
           quy.Next;
         end;
         quy.CachedUpdates := false;
       end;
end;

procedure delpmjlnoakpd(quy : TQuery;sql : TUpdateSQL);
var vjlh : integer;
begin
  if quy.RecordCount > 0       //一条以上记录
  then begin
         quy.CachedUpdates := true;
         sql.SetParams(ukdelete);;
         while not quy.Eof do
         begin
           vjlh := quy.FieldByName('jlh').ASinteger;
           SQL.Query[ukdelete].Params[0].Value :=  vjlh ;
           SQL.ExecSQL(ukdelete);
           quy.Next;
         end;
         quy.CachedUpdates := false;
       end;
end;

procedure ExecDELpd(Quy:TQuery; sn : string);
begin
  if not (MessageDLG('确定要清空表吗？',mtCONfirmation,[mbYes,mbNo],0) = mrYes)
  then exit;
  quy.Close;
  quy.SQL.Clear;
  quy.SQL.Add(' delete from ' + sn );
  quy.ExecSQL;
  selectALLfu(Quy , sn , '');
end;

procedure ExecDELnoakpd(Quy:TQuery; sn : string);
begin
  quy.Close;
  quy.SQL.Clear;
  quy.SQL.Add(' delete from ' + sn );
  quy.ExecSQL;
  selectALLfu(Quy , sn , '');
end;

function selectALLfu(Quy:TQuery; sn , tj : string):integer;
begin
  quy.Close;
  quy.SQL.Clear;
  quy.SQL.Add(' select * from ' + sn + ' ' + tj );
  quy.Active := true;
  quy.First;
  result := quy.RecordCount;
end;

procedure delzd1pd(quy : Tquery; sn , s1,s2:string);
begin
  if not (MessageDLG('确定要删除 《 ' + s2 + ' 》 值的记录吗？'
            ,mtCONfirmation,[mbYes,mbNo],0) = mrYes)
  then exit;
  quy.Close;
  quy.SQL.Clear;
  quy.SQL.Add(' delete from ' + sn + ' where ' + s1 + ' = :aa ' );
  quy.Params[0].Value := s2;
  quy.ExecSQL;
end;

procedure deldatezd1pd(quy : Tquery; sn , s1,s2:string);
begin
  quy.Close;
  quy.SQL.Clear;
  quy.SQL.Add(' delete from ' + sn + ' where ' + s1 + ' = :aa ' );
  quy.Params[0].Value := strtodate(s2);
  quy.ExecSQL;
end;

procedure ExecSQLpd(Quy:TQuery; sn : string);
begin
  try
    quy.Close;
    quy.SQL.Clear;
    quy.SQL.Add( sn );
    quy.Active := true;
  except
    quy.Active := true;
  end;
end;

function delspdhfu(s : string):string;
var k : integer;
    sd : string;
begin
  sd := s;
  repeat
    k := pos(',',sd);
    if k > 0
    then delete(sd,k,1);
  until k = 0;

  repeat
    k := pos(' ',sd);
    if k > 0
    then delete(sd,k,1);
  until k = 0;
  result := sd;
end;

function jctxtvalue(quy:TQuery;sql:TUpdateSQL;s:string;i:integer;name:string):integer;
var k : integer;
begin
  result := 0;
  k := pos(',',s);
  if k > 0
  then begin
         showmessage('字符串中含有《逗号》出错！'
           + #10 + #13 + '字段名 : ' + name
           + #10 + #13 + '出错值 : ' + s );
         result := 1;
       end;
  k := pos(' ',s);
  if k > 0
  then begin
         showmessage('字符串中含有《间隔符》出错！'
           + #10 + #13 + '字段名 : ' + name
           + #10 + #13 + '出错值 : ' + s );
         result := 1;
       end;
  if (quy.Fields.Fields[i].DataType = ftstring) and (length(s) > quy.Fields.Fields[i].Size)
  then begin
         showmessage('字符串长度出错！'
             + #10 + #13 + '字段名 : ' + name
             + #10 + #13 + '出错值 : ' + s );
         result := 3;
       end
  else
  if (quy.Fields.Fields[i].DataType = ftinteger) and (not jcintfu(s))
  then begin
         showmessage('整数类型出错！'
             + #10 + #13 + '字段名 : ' + name
             + #10 + #13 + '出错值 : ' + s );
         result := 4;
       end
  else
  if (quy.Fields.Fields[i].DataType = ftfloat) and (not jcrealfu(s))
  then begin
         showmessage('实数类型出错！'
             + #10 + #13 + '字段名 : ' + name
             + #10 + #13 + '出错值 : ' + s );
         result := 5;
       end
  else
  if ((quy.Fields.Fields[i].DataType = ftDate) or
      (quy.Fields.Fields[i].DataType = ftDatetime )) and (not jcdateSPfu(s))
  then begin
         showmessage('日期类型出错！'
                  + #10 + #13 + '字段名 : ' + name
                  + #10 + #13 + '出错值 : ' + s );
         result := 6;
       end;
end;


procedure BookmarkBEG(quy:Tquery);
var i : integer;
begin
  KBookmark := quy.GetBookmark;
  sqltxt  := Quy.SQL.Text;
  i := 1 ;
  while i <= quy.ParamCount do
  begin
    sqlpams[i] := Quy.Params[i-1].Value;
    inc(i);
  end;
end;

procedure BookmarkEND(quy:Tquery);
var i : integer;
begin
  Quy.Close;
  Quy.SQL.Clear;
  Quy.SQL.Add(sqltxt);
  i := 1 ;
  while i <= quy.ParamCount do
  begin
    Quy.Params[i-1].Value := sqlpams[i];
    inc(i);
  end;
  Quy.Active := true;
  if not quy.IsEmpty
  then quy.GotoBookmark(KBookmark);
  quy.FreeBookmark(KBookmark);
end;

procedure GETcbox(CBbar:TControlBar;ls:integer);
var i,j : integer;
    s   : string;
begin
  for j := 0 to CBbar.ControlCount-1 do
  begin
    s := CBbar.Controls[j].GetNamePath;
    i := 1;
    repeat
      if s = 'CB' + inttostr(i)
      then CBboxary[i] := CBbar.Controls[j] as TComboBox;
      inc(i);
    until (s = 'CB' + inttostr(i-1)) or (i > ls);
  end;
end;

function GETfileSosfu(sd,sn:string):integer;
var SF : TSearchRec;
begin
  SosNameStrlist := Tstringlist.Create;
  if FindFirst( sd + sn,0, sf) = 0
  then begin
         SosNameStrlist.Add(sf.Name);
         while FindNext(sf) = 0 do
            SosNameStrlist.Add(sf.Name);
         FindClose(sf);
         SosNameStrlist.Sorted := true;
       end;
  result := SosNameStrlist.Count;
end;

procedure EraseSingelSospd(s : string);
var txt : textfile;
begin
  if not FileExists(s)
  then showmessage('文件' + s + '没有找到！')
  else begin
         assignfile(txt, S);
         Erase(txt);
       end;
end;

procedure ClearSingelSospd(FLbox : TFileListBox);
var txt : textfile;
    i   : integer;
    s   : string;
begin
  for i := 0 to FLBox.Items.Count - 1 do
  begin
    if FLBox.Selected[i] = true
    then begin
           s := FLBox.Directory+'\'+ FLBox.Items.Strings[i];
           if not FileExists(s)
           then showmessage('文件' + s + '没有找到！')
           else begin
                  assignfile(txt, S);
                  Erase(txt);
                end;
         end;
  end;
  FLBox.Update;
end;

procedure ClearallfileSospd(sd,sn:string);
var SF : TSearchRec;
    i : integer;
    txt : textfile;
begin
  SosNameStrlist := Tstringlist.Create;
  if FindFirst( sd + sn,0, sf) = 0
  then begin
         SosNameStrlist.Add(sf.Name);
         while FindNext(sf) = 0 do
            SosNameStrlist.Add(sf.Name);
         FindClose(sf);
         SosNameStrlist.Sorted := true;
       end;
  for i := 0 to SosNameStrlist.Count -1 do
  begin
    if not FileExists(sd + SosNameStrlist.Strings[i])
    then showmessage('文件' + SosNameStrlist.Strings[i] + '没有找到！')
    else begin
           assignfile(txt,sd + SosNameStrlist.Strings[i]);
           Erase(txt);
         end;
  end;
end;


///////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////

procedure insertjlpd(quy:tquery;SQL:TUpdateSQL;st:string;var vjlh:integer);
var i : integer;
    s : string;
    bol : boolean;
begin
 { DogData:=@jdog;
  DogBytes:=0;
  idog := ReadDog;
  if not(idog = 0)
  then begin
         showmessage('请安装软件狗后,再执行程序');
         exit;
       end;  }
  bol := false;
  quy.CachedUpdates := true;     //插入记录  st = 'aaa,bbb,ccc,ddd,';
  SQL.SetParams(ukinsert);
  i := 0;
  while i < (quy.FieldCount-1) do
  begin
    s := sltfu(st);
    if (quy.Fields.Fields[i].DataType = ftstring) and (bol = false)
    then begin
           if length(s) > quy.Fields.Fields[i].Size
           then begin
                  showmessage('字符串长度出错！.字段号..' + inttostr(i+1)+ '..'+ s );
                  bol := true;
                end
           else  SQL.Query[ukinsert].Params[i].Value := s
    end
    else
    if (quy.Fields.Fields[i].DataType = ftinteger) and (bol = false)
    then begin
           if not jcintfu(s)
           then begin
                  showmessage('整数类型出错！.字段号..' + inttostr(i+1)+ '..'+ s );
                  bol := true;
                end
           else SQL.Query[ukinsert].Params[i].Asinteger := strtoint(s);
         end
    else if (quy.Fields.Fields[i].DataType = ftfloat) and (bol = false)
         then begin
                if not jcrealfu(s)
                then begin
                       showmessage('实数类型出错！.字段号..' + inttostr(i+1)+ '..'+ s );
                       bol := true;
                     end
                else SQL.Query[ukinsert].Params[i].AsFloat := strtofloat(s);
              end
    else if (quy.Fields.Fields[i].DataType = ftDate) or
            (quy.Fields.Fields[i].DataType = ftDatetime )
         then begin
                if not jcdateSPfu(s)
                then begin
                       showmessage('日期类型出错！.字段号..' + inttostr(i+1)+ '..'+ s );
                       bol := true;
                     end
                else if s = ''
                     then SQL.Query[ukinsert].Params[i].Value := null
                     else SQL.Query[ukinsert].Params[i].Value := strtodate(s);
              end
         else SQL.Query[ukinsert].Params[i].Value := s;
    inc(i);
  end;
  if not bol
 then begin
         SQL.Query[ukinsert].Params[i].Value := ADDjlhFU(vjlh);
         SQL.ExecSQL(ukinsert);
       end;
  quy.CachedUpdates := false;
end;










initialization
  EditStr := '';

end.