global.pas

文具仓库管理系统2.0（源码）delphi+access main in Mainmain.pas {FrmMain}, Login in LoginLogin.pas {FrmLogin},

SFormSelectPath             ='请选择您的数据库备份路径';
sFormSelectBackupFile       ='请选择您要还原的数据库文件。';
//============================================================
//  Other STring
//============================================================
sMenuChangeItem1            ='修改(&C)';
sMenuChangeItem2            ='修改(&C)你可以在右边的数据框内进行修改';

//============================================================
// procedure and function
//============================================================


//测试数据库文件是否存在
function DataBaseIsExist:boolean;
//从资源文件中释放出全新的数据库文件
procedure ExportNewDatabase;
//测试数据库的连接
function ConnectionDB:Boolean;
//测试登录密码是否正确
function CheckPassword:Boolean;
//字符串加密函数
function Encrypt(const s:string):string;
//简化 messagesbox 函数
function MsgBox(Msg:Variant;Title:string;Flag:longint):integer;
// ACCESS 数据库压缩函数
function CompressDB(Afile:string):boolean;
//导出 Excel 表格
procedure GenXlsFile(sPRG:TProgressBar;SDBGrid:TDBGrid;sDataSet:TADOQuery;Fn:String;Vis:Boolean);

const
  MyKey : array[1..15] of word=(78,57,41,8,27,20,19,52,54,80,6,3,26,1,56);
  
var
  ADOConnt:TADOConnection;
  LoginSucceed:boolean  = false;   //记录是否登录成功

implementation

uses login;

function DataBaseIsExist:boolean;
var
  fn:string;
begin
  fn:=ExtractFilePath(Paramstr(0))+'Data\'+SDefDataBaseName;
  if FileExists(fn) then
    Result:=true
    else
    Result:=False;
end;

//从资源文件中释放出全新的数据库文件
procedure ExportNewDatabase;
var
  fn:string;
  DataFile:TResourcesTream ;
begin
  fn:=ExtractFilePath(Paramstr(0))+'Data\'+SDefDataBaseName;
  if Msgbox(sMsgDataFileNoExists,sTitleConfirm,4)=IDYes then
  begin
    try
      MkDir(ExtractFilePath(Paramstr(0))+'Data');
    except
//      showmessage('目录名己存在!')
    end;
    DataFile:=TResourcesTream.Create(hInstance,'DataBase','LuozsSoft') ;
    DataFile.SaveToFile(fn);
    DataFile.Free;
    SetForegroundWindow(Application.Handle); //本语句是防止消息窗体被其它窗体覆盖
    Msgbox(sMsgDataFileCreateOk,sTitleHint,0);
    Application.Terminate;
  end;
end;

//测试数据库的连接
function ConnectionDB:Boolean;
var
  Fn:string;
begin
  Fn:=ExtractFilePath(paramstr(0))+'Data\'+SDefDataBaseName;
  ADOConnt:=TADOConnection.Create(Application);
  with ADOConnt do
  begin
    if Connected then close;   //如果己连接则关闭
    LoginPrompt:=False;       //将登录提示设为 不提示
    ConnectionString:=format(SConnectString,[Fn,SDefDataBasePwd]);
    try                //如果能打开数据库，则表示成功！
      open;
      Result:=true;
    except
      Result:=False;
      msgbox(Format(SMsgNotFindDataBase,[fn]),STitleError,1);
    end;
    close;
  end;
  ADOConnt.Free;
end;

//测试登录密码是否正确
function CheckPassword:Boolean;
var
  Fn,TempStr:string;
  ADOQry:TADOQuery;
begin
  Fn:=ExtractFilePath(paramstr(0))+'Data\'+SDefDataBaseName;
  ADOConnt:=TADOConnection.Create(Application);
  ADOQry:=TADOQuery.Create(Application);
  ADOQry.Connection :=ADOConnt;
  with ADOConnt do
  begin
    if Connected then close;   //如果己连接则关闭
    LoginPrompt:=False;       //将登录提示设为 不提示
    ConnectionString:=format(SConnectString,[Fn,SDefDataBasePwd]);
    open;
  end;
  with ADOQry do
  begin
    close;
    sql.Clear;
    sql.Text :=format(SSQLTY0,[STLogin]);
    open;
    first;
    if fieldValues[SFLoginPwd ] <> null then
      TempStr:=fieldValues[SFLoginPwd]
      else
      TempStr:='';
    close;
  end;
  if TempStr='' then
    begin
      Result:=True;
      exit;
    end
    else
    begin
      FrmLogin:=TFrmLogin.Create(Application);
      FrmLogin.ShowModal;
      if LoginSucceed then Result:=True else Result:=False;
      FrmLogin.Release;
    end;
  ADOConnt.Close;
end;

//字符串加密函数
function Encrypt(const s:string):string;
var
  j,k,tmp:word;
  tmpstr:String;
begin
  k:=1;
  for j:=1 to length(s) do
  begin
    tmp:=ord(s[j]) xor Mykey [k];   //按位操作
    tmpstr:=tmpstr+IntToHex(tmp,2);
    inc(k);
    if K> length(Mykey) then k:=1;
  end;
  Result :=tmpstr;

end;

function MsgBox(Msg:Variant;Title:string;Flag:longint):integer;
//简化MessageBox函数
begin
  if length(title)=0 then title:=SAppName;
  case flag of
    0:flag:=MB_OK + MB_ICONINFORMATION;
    1:flag:=MB_OK + MB_ICONERROR;
    2:flag:=MB_YESNO + MB_ICONERROR;
    3:flag:=MB_YESNO + MB_ICONWARNING;
    4:flag:=MB_YesNo +MB_ICONQUESTION;
    else
      flag:=MB_OK + MB_ICONERROR;
  end;
  Result:=application.MessageBox(pchar(vartostr(Msg)),pchar(Title),flag);
end;

function compressDB(Afile:string):boolean;
//
var
  DaoVar: OLEVariant;
begin
  try
  DaoVar := CreateOleObject('dao.DBEngine.36');
  if FileExists('db.tmp') then deletefile('db.tmp');
//  DaoVar.CompactDatabase(afile,'db.tmp');    //压缩无密码的数据库
  //压缩有密码的数据库。注意：密码不能为空
  DaoVar.CompactDatabase(afile,'db.tmp',';pwd='+SDefDataBasePwd+'',0,';pwd='+SDefDataBasePwd+'');
  if deletefile(afile) then RenameFile('db.tmp',Afile);
  result:=true;
  except
    result:=False;
  end;
end;

{导出 Excel 表格}
procedure GenXlsFile(sPRG:TProgressBar;SDBGrid:TDBGrid;sDataSet:TADOQuery;Fn:String;Vis:Boolean);
//uses ComObj;
var
  ExcelApp: Variant;
  i,j:integer;
begin
  try
    ExcelApp := CreateOleObject('Excel.Application');
  except
    application.MessageBox('系统中的MS Excel软件没有安装或安装不正确！','错误',MB_ICONERROR+MB_OK);
    exit;
  end;
  ExcelApp.visible:=vis;
  try
    excelapp.caption:='应用程序调用 Microsoft Excel';
    ExcelApp.WorkBooks.Add;
    //写入标题行
    for i:=1 to sDBGrid.FieldCount do
    begin
      ExcelApp.Cells[1,i].Value:=sDBGrid.Columns[i-1].Title.Caption ;
    end;
    sprg.Max:=sDataSet.RecordCount;   //插入进度条
    sDataSet.First;
    i:=2;
    while not sDataSet.Eof do
    begin
       for j:=0 to sDataSet.Fields.Count-1 do
       begin
         ExcelApp.Cells[i,j+1].Value :=sDataSet.Fields[j].AsString;
       end;
       sDataSet.Next;
       i:=i+1;
       sprg.StepBy(1);        //进度条步长
    end;
    sDataSet.First;
    sPrg.Position :=0;        //
    if application.MessageBox('数据导出完成.确认保存吗？','信息提示',MB_ICONQUESTION+MB_YESNO+MB_DEFBUTTON1+MB_SYSTEMMODAL)=IDYES then
    begin
      if not ExcelApp.ActiveWorkBook.Saved then
         ExcelApp.ActiveWorkBook.SaveAs(fn);
    end
    else begin
      ExcelApp.ActiveWorkBook.Saved := True; //不保存
    end;
  finally
    excelapp.quit; //退出EXCEL软件
  end;
end;


end.