allvar.pas

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

unit allvar;
interface
uses Windows, Messages, SysUtils,Dialogs,Classes,Controls,StdCtrls,
     Db,DBTables,DBCtrls,Registry,Graphics,Forms,Grids,Variants,
     DBGrids,ComCtrls,ExtCtrls,Buttons,MMSystem,FileCtrl;

var vRQ         : tdate;
    Gbeg,Gend   : longint;

const vln  = 30;  //查询选择数组预定义长度
      CBln = 80;  //COMBOX数组预定义长度

type Taryslt = record
                 index   : array[1..vln] of integer;
                 caption : array[1..vln] of string;
                 name    : array[1..vln] of string;
                 value   : array[1..vln] of string;
                 tedit   : array[1..vln] of Tedit;
                 vln,sltik        : integer;
                 sltname,sltvalue : string;
               end;


var  sltvar : Taryslt;
     CBboxary : array[0..CBln] of TComboBox;

var  aryindex    : array[0..vln] of integer;
     arysltname  : array[0..vln] of string;
     arysltvalue : array[0..vln] of string;
     arysltedit  : array[0..vln] of Tedit;
     sltzdname,sltzdvalue : string;
     sltik       : integer;
     KBookmark   : TBookmark;
     SQLtxt      : string;
     SQLpams     : array[1..10] of string;

var XTdatetime   : Tdatetime;
    SosNameStrlist : Tstringlist;
    EditStr      : string;

function  usestime : string;
procedure GETtimeBEGpd;
function  getFnamefu : string;
//List函数
procedure savelistboxpd(cbox : Tlistbox;txt : string);
procedure loadlistboxpd(cbox : Tlistbox; txt : string);
//Memo函数
procedure saveMemoboxpd(cbox : TMemo;txt : string);
procedure loadMemoboxpd(cbox : TMemo; txt : string);
//Combox下选框函数
procedure savecomboxpd(cbox : Tcombobox;txt : string);
procedure loadcomboxpd(cbox : Tcombobox; txt : string);
procedure addcomboxpd(cbox : tcombobox);
procedure delcomboxpd(cbox : tcombobox);
//记录号函数
function  maxjlhfu(quy:Tquery;sn:string):integer;
function  ADDjlhFU(var vXTjlh : integer) : integer;
//空格函数
function  delallspfu( s : string) : string;
function  addbefspfu(s:string;i:integer):string;
function  addaftspfu(s:string;i:integer):string;
//串函数
function  sltfu(var s : string) : string;
function  addintstrfu(st:string):string;
function  addbef2fu(ik:integer):string;
//检查转换值函数
function  jcintfu(s:string) : boolean;
function  jcrealfu(s:string):boolean;
function  jcdateSPfu(s:string) : boolean;
function  jcdatefu(s:string) : boolean;
function  jctxtvalue(quy : TQuery; sql : TUpdateSQL;s:string;i:integer;name:string):integer;
//机器函数
function  maxlistboxwidh(listbox : Tlistbox):integer;
procedure initbootpd(Runbz,RunName : string);
//查询付值函数
procedure sltvarclearpd;
procedure addslteditpd(name,value,caption : string;index : integer);
function  getselectnumfu:integer;
function  getselecttextfu:string;
//文件函数
procedure savequyfilepd(StatusBar:TStatusBar;quy:tquery;fname:string);
procedure openquyfilepd(StatusBar:TStatusBar;quy:tquery;SQL:TUpdateSQL;fname:string;var vjlh:integer);
//记录函数
function  insertjlfu(quy:tquery;SQL:TUpdateSQL;st:string;var vjlh:integer;mydbgrid:Tdbgrid):integer;
function  selectALLfu(Quy:TQuery; sn , tj : string):integer;
function  selectMultisfu(Quy:TQuery;sn,Mzd,Mval:string;ln:integer;tj:string):integer;
function  selectORfu(Quy:TQuery;sn,Mzd,Mval:string;ln:integer;tj:string):integer;
function  selectBEGtoENDfu(Quy:TQuery;sn,vZD,vmil,vmax : string;tj:string):integer;
function  selectMultisfwfu(Quy:TQuery;sn,Mzd,Mval:string;ln:integer;vZD,vmil,vmax,tj:string):integer;
procedure modifypmjl(quy:tquery;SQL:TUpdateSQL;dpltxt,zdname,newvalue:string);
procedure modifypmjlNoak(quy:tquery;SQL:TUpdateSQL;dpltxt,zdname,newvalue:string);
procedure modifyMultisZd(kquy:tquery;kSQL:TUpdateSQL;mzd,mval:string;ln,vjlh:integer);
function  modifyjlfu(quy:tquery;SQL:TUpdateSQL;st:string;vjlh:integer;mydbgrid:Tdbgrid):integer;
procedure delpmjlpd(quy : TQuery;sql : TUpdateSQL);
procedure delpmjlNoakpd(quy : TQuery;sql : TUpdateSQL);
procedure delzd1pd(quy : Tquery; sn , s1,s2:string);
procedure delDATEzd1pd(quy : Tquery; sn , s1,s2:string);
procedure ExecDELpd(Quy:TQuery; sn : string);
procedure ExecDELNoakpd(Quy:TQuery; sn : string);
procedure ExecSQLpd(Quy:TQuery; sn : string);

procedure BookmarkBEG(quy:Tquery);
procedure BookmarkEND(quy:Tquery);

procedure GETcbox(CBbar:TControlBar;ls:integer);

function  GETfileSosfu(sd,sn:string):integer;
procedure ClearallfileSospd(sd,sn:string);
procedure ClearSingelSospd(FLBox : TFileListBox);
procedure EraseSingelSospd(s : string);
////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////
procedure insertjlpd(quy:tquery;SQL:TUpdateSQL;st:string;var vjlh:integer);
implementation

function getFnamefu : string;
begin
  XTdatetime := now();
  result := copy(datetimetostr(XTdatetime), 6,2) +
            copy(datetimetostr(XTdatetime), 9,2) +
            copy(datetimetostr(XTdatetime),12,2)+
            copy(datetimetostr(XTdatetime),15,2)+
            copy(datetimetostr(XTdatetime),18,2);
end;

function jcfliefu(s,d:string):integer;
var k,j : integer;
    sp : string;
begin
  k := 0; sp := s;
  repeat
    j := pos(d,sp);
    if j > 0
    then begin
           inc(k);
           delete(sp,j,1);
         end;
  until j = 0 ;
  result := k ;
end;

function maxjlhfu(quy:Tquery;sn:string):integer;
begin
  quy.Close;
  quy.SQL.Clear;
  quy.SQL.Add(' select * from ' + sn + ' order by jlh ' );
  quy.Active := true;
  quy.Last;
  result := quy.FieldByName('jlh').Asinteger;
end;

procedure GETtimeBEGpd;
begin
  Gbeg := timegettime;
end;

function usestime : string;
var gl : integer;
    gm,gs,gms : integer;
begin
  Gend := timegettime;
  if Gend > Gbeg
  then gl  := Gend - Gbeg
  else gl := 0;
  gms := gl mod 1000;
  gl  := gl div 1000;
  gm  := gl div 60 ;
  gs  := gl mod 60 ;
  result := '操作用时:'
   + inttostr(gm) + '分' + inttostr(gs) + '秒' + inttostr(gms) + '毫秒';
end;

procedure savelistboxpd(cbox : Tlistbox;txt : string);
begin
  cbox.Items.SaveToFile(txt); 
end;

procedure loadlistboxpd(cbox : Tlistbox; txt : string);
begin
  if FileExists(txt)
  then cbox.Items.LoadFromFile(txt);
end;

procedure saveMemoboxpd(cbox : TMemo;txt : string);
begin
  cbox.Lines.SaveToFile(txt);
end;

procedure loadMemoboxpd(cbox : TMemo; txt : string);
begin
  if FileExists(txt)
  then cbox.Lines.LoadFromFile(txt);
end;

procedure savecomboxpd(cbox : Tcombobox;txt : string);
begin
  cbox.Items.SaveToFile(txt);
end;

procedure loadcomboxpd(cbox : Tcombobox; txt : string);
begin
  if FileExists(txt)
  then begin
	 cbox.Items.LoadFromFile(txt);
         if cbox.Items.Count > 0
         then cbox.Text := cbox.Items[0];
       end;
end;

procedure addcomboxpd(cbox : tcombobox);
begin
  if ( CBox.Items.IndexOf(CBox.text) < 0 )
  and (CBox.text <> '')
  then CBox.Items.Insert(0,CBox.text);
end;

procedure delcomboxpd(cbox : tcombobox);
begin
  CBox.Items.Delete(cbox.ItemIndex);
  CBox.Text := '';
end;

function ADDjlhFU(var vXTjlh : integer) : integer;
begin
  inc(vXTjlh);
  result := vXTjlh;
end;

function delallspfu( s : string) : string;
var i : integer;
begin
  if s <> ''
  then repeat
         i := pos(' ',s);
         if i > 0
         then delete(s ,i,1);
       until pos(' ',s) < 1;
  result := s;
end;

function addbef2fu(ik:integer):string;
begin
  if length(inttostr(ik)) < 2
  then result := '0'+ inttostr(ik)
  else result := inttostr(ik);
end;

function addbefspfu(s:string;i:integer):string;
var g : string;
begin
  if length(s) < i
  then begin
         repeat
           s:= ' ' + s ;
         until (length(s) >= i);
         g := s ;
       end
  else g := copy(s,1,i);
  result := g ;
end;

function addaftspfu(s:string;i:integer):string;
var g : string;
begin
  if length(s) < i
  then begin
         repeat
           s:= s + ' ';
         until (length(s) >= i);
         g := s ;
       end
  else g := copy(s,1,i);
  result := g ;
end;

function sltfu(var s : string) : string;
var i  : integer;
begin
  i := pos(',',s);
  result := copy(s,1,i-1);
  delete(s,1,i);
end;

function jcintfu(s:string) : boolean;
begin
  result := true;
  try
    strtoint(s);
  except
    result := false
  end;
end;

function jcrealfu(s:string):boolean;
begin
  result := true;
  try
    strtofloat(s);
  except
    result := false
  end;
end;

function jcdateSPfu(s:string) : boolean;
begin
  result := true;
  if s <> ''
  then try
        vRQ := strtodate(s);
       except
         result := false;
       end;
end;

function jcdatefu(s:string) : boolean;
begin
  result := true;
  try
    vRQ := strtodate(s);
  except
    result := false;
  end;
end;

function deldecfu( s : string) : string;
var i : integer;
begin
  try
    i := 1;
  repeat
    if s[i] = '.'
    then delete(s,i,1);
    inc(i);
  until (i >= length(s));
    result :=  s ;
  except
    result := '';
  end;
end;

function addintstrfu(st:string):string;
var i : integer;
begin
  i := strtoint(st);
  inc(i);
  result := inttostr(i);
end;

function maxlistboxwidh(listbox : Tlistbox):integer;
var i, MaxWidth: integer;
begin
  MaxWidth := 0;
  for i := 0 to ListBox.Items.Count - 1 do
    if MaxWidth < ListBox.Canvas.TextWidth(ListBox.Items.Strings[i])
    then MaxWidth := ListBox.Canvas.TextWidth(ListBox.Items.Strings[i]);
  SendMessage(ListBox.Handle, LB_SETHORIZONTALEXTENT, MaxWidth+2, 0);
  result := MaxWidth;
end;

procedure initbootpd(Runbz,RunName : string);
Var RegF : TRegistry;                    //安装Windows启动运行程序
begin
  RegF := TRegistry.Create;
  RegF.RootKey := HKEY_LOCAL_MACHINE;
  RegF.OpenKey('SOFTWARE/Microsoft/Windows/CurrentVersion/Run',True);
  if not RegF.ValueExists(Runbz)
  then  RegF.WriteString(Runbz,RunName);
  RegF.Free;
end;

{存库表记录到文件}
procedure savequyfilepd(StatusBar:TStatusBar;quy:tquery;fname:string);
var txt : textfile;
    gs  : string;
    i   : integer;
begin
  if quy.IsEmpty
  then exit;
  assignfile(txt,fname);
  rewrite(txt);
  while not Quy.Eof do
  begin
    i := 0; gs := '';
    while i < quy.FieldCount do
    begin
      gs := gs + quy.Fields.Fields[i].AsString  + ',';
      inc(i);
    end;
    writeln(txt,gs);
    StatusBar.SimpleText := gs;
    Quy.Next;
  end;
  closefile(txt);
end;

{读文件记录入库表}
procedure openquyfilepd(StatusBar:TStatusBar;quy:tquery;SQL:TUpdateSQL;fname:string;var vjlh:integer);
var txt : textfile;
    gs,s  : string;
    i,j   : integer;
begin
  if not FileExists(fname)
  then Exit;
  try
  assignfile(txt,fname);
  reset(txt); j := 0;
  quy.CachedUpdates := true;
  SQL.SetParams(ukinsert);
  while not Eof(txt) do
  begin
    readln(txt,gs); inc(j);
    StatusBar.SimpleText := gs;
    try
    i := 0;
    while i < (quy.FieldCount-1) do
    begin
      s := sltfu(gs);
      if (quy.Fields.Fields[i].DataType = ftDate) or
         (quy.Fields.Fields[i].DataType = ftDatetime )
      then begin
             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;
    SQL.Query[ukinsert].Params[i].Value := ADDjlhFU(vjlh);
    SQL.ExecSQL(ukinsert);

    except
      messagedlg('输入文件出错!!! 第《' + inttostr(j)+ '》行!',mtinformation,[mbok],0);
      StatusBar.SimpleText := gs ;
      quy.Active := true;
      break;
    end;
  end;
  finally
    closefile(txt);
    StatusBar.SimpleText := gs ;
    quy.CachedUpdates := false;
  end;
end;

{修改屏幕选出记录的单一字段值
需要字段名、新值并切询问是否修改}
procedure modifypmjl(quy:tquery;SQL:TUpdateSQL;dpltxt,zdname,newvalue:string);
var ik : integer;
begin
  if (zdname = '')
  then begin
         messagedlg('没有选择字段名!',mtinformation,[mbok],0);
         Exit;
       end;
  if not (messagedlg('修改[ ' + dpltxt + ' ]字段值' + char(10) + char(13)
             + '新值为...'+ newvalue,mtconfirmation,[mbyes,mbno],0) = mryes)
  then Exit;

  while not quy.Eof do
  begin
    ik := quy.Fieldbyname('jlh').value;
    quy.CachedUpdates := true;