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

📄 main.~pas

📁 退休资料查询!我公司离退老干部数据管理!基于ACCESS数据库,提供了一个数据库压缩的源码和导出为EXCEL功能!
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ExtCtrls, SUIForm, SUIMainMenu, SUIMgr, SUITabControl,
  SUIImagePanel, SUIGroupBox, SUIButton, StdCtrls, SUIComboBox, DB, ADODB,
  Grids, DBGrids, SUIEdit,SUIThemes, SUIDBCtrls, SUIMemo, SUIListBox,
  ToolWin, ComCtrls, SUIToolBar, SUIStatusBar, ImgList, SUIPageControl;
Const
 SConnectionString       = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;'
                               +'Jet OLEDB:Database Password=%s;';

type
  TForm1 = class(TForm)
    suiThemeManager1: TsuiThemeManager;
    suiMainMenu1: TsuiMainMenu;
    Main1: TsuiForm;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    ADOTable1: TADOTable;
    DataSource1: TDataSource;
    ADOConnection1: TADOConnection;
    OpenDialog1: TOpenDialog;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    XP1: TMenuItem;
    MAC1: TMenuItem;
    DEEP1: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    suiStatusBar1: TsuiStatusBar;
    suiToolBar1: TsuiToolBar;
    ImageList1: TImageList;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    Timer1: TTimer;
    ToolButton6: TToolButton;
    N13: TMenuItem;
    suiPageControl1: TsuiPageControl;
    suiTabSheet1: TsuiTabSheet;
    suiTabSheet2: TsuiTabSheet;
    FindBox: TsuiGroupBox;
    Label10: TLabel;
    FINDGroupBox: TsuiGroupBox;
    ADDRadio: TsuiRadioButton;
    NRRadio: TsuiRadioButton;
    ADDEdit: TsuiEdit;
    NREdit: TsuiEdit;
    suiButton3: TsuiButton;
    DBGrid1: TsuiDBGrid;
    suiButton2: TsuiButton;
    inputBox: TsuiGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    suiEdit2: TsuiEdit;
    suiEdit3: TsuiEdit;
    suiEdit4: TsuiEdit;
    suiEdit5: TsuiEdit;
    suiEdit6: TsuiEdit;
    suiEdit7: TsuiEdit;
    suiEdit8: TsuiEdit;
    NEWButton: TsuiButton;
    ADDButton: TsuiButton;
    DELButton: TsuiButton;
    suiEdit9: TsuiEdit;
    Label11: TLabel;
    suiEdit16: TsuiEdit;
    Label12: TLabel;
    suiEdit10: TsuiEdit;
    Label13: TLabel;
    suiEdit11: TsuiEdit;
    Label14: TLabel;
    suiEdit12: TsuiEdit;
    Label15: TLabel;
    suiEdit13: TsuiEdit;
    Label16: TLabel;
    suiEdit14: TsuiEdit;
    Label17: TLabel;
    suiEdit15: TsuiEdit;
    DHRadio: TsuiRadioButton;
    DHEdit: TsuiEdit;
    QSNAMERadio: TsuiRadioButton;
    QSNAMEEdit: TsuiEdit;
    ComboBox1: TsuiComboBox;
    SaveDialog1: TSaveDialog;
    ToolButton7: TToolButton;
    ADOCommand1: TADOCommand;
    N12: TMenuItem;
    N14: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure suiButton2Click(Sender: TObject);
    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
      Field: TField; State: TGridDrawState);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure XP1Click(Sender: TObject);
    procedure MAC1Click(Sender: TObject);
    procedure suiButton3Click(Sender: TObject);
    procedure ADDRadioClick(Sender: TObject);
    procedure NRRadioClick(Sender: TObject);
    procedure ADDEditKeyPress(Sender: TObject; var Key: Char);
    procedure NREditKeyPress(Sender: TObject; var Key: Char);
    procedure N7Click(Sender: TObject);
    procedure NEWButtonClick(Sender: TObject);
    procedure ADDButtonClick(Sender: TObject);
    procedure DELButtonClick(Sender: TObject);
    procedure suiEdit3KeyPress(Sender: TObject; var Key: Char);
    procedure suiEdit4KeyPress(Sender: TObject; var Key: Char);
    procedure suiEdit5KeyPress(Sender: TObject; var Key: Char);
    procedure suiEdit6KeyPress(Sender: TObject; var Key: Char);
    procedure suiEdit7KeyPress(Sender: TObject; var Key: Char);
    procedure suiEdit8KeyPress(Sender: TObject; var Key: Char);
    procedure N11Click(Sender: TObject);
    procedure DEEP1Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure ToolButton6Click(Sender: TObject);
    procedure suiEdit10KeyPress(Sender: TObject; var Key: Char);
    procedure suiEdit11KeyPress(Sender: TObject; var Key: Char);
    procedure suiEdit12KeyPress(Sender: TObject; var Key: Char);
    procedure suiEdit13KeyPress(Sender: TObject; var Key: Char);
    procedure suiEdit14KeyPress(Sender: TObject; var Key: Char);
    procedure suiEdit16KeyPress(Sender: TObject; var Key: Char);
    procedure DHRadioClick(Sender: TObject);
    procedure QSNAMERadioClick(Sender: TObject);
    procedure FormCanResize(Sender: TObject; var NewWidth,
      NewHeight: Integer; var Resize: Boolean);
    procedure ToolButton7Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure SetupTable(sender:tobject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type
    PLCLD =  RECORD
      DNAME:STRING[30];
      LDNR:STRING[200];
    END;

var
  Form1: TForm1;
  NO:integer;
  myaccess:string;//保存文件路径

implementation

{$R *.dfm}

uses
 shellapi, PLCdetail, CreateTable,ComObj;


//=============================================================================
// Procedure: GetTempPathFileName
// Author   : ysai
// Date     : 2003-01-27
// Arguments: (None)
// Result   : string
//=============================================================================
function GetTempPathFileName():string;
//取得临时文件名
var
 SPath,SFile:array [0..254] of char;
begin
 GetTempPath(254,SPath);
 GetTempFileName(SPath,'~SM',0,SFile);
 result:=SFile;
 DeleteFile(result);
end;

//=============================================================================
// Procedure: CreateAccessFile
// Author   : ysai
// Date     : 2003-01-27
// Arguments: FileName:String;PassWord:string=''
// Result   : boolean
//=============================================================================
function CreateAccessFile(FileName:String;PassWord:string=''):boolean;
//建立Access文件,如果文件存在则失败
var
 STempFileName:string;
 vCatalog:OleVariant;
begin
 STempFileName:=GetTempPathFileName;
 try
   vCatalog:=CreateOleObject('ADOX.Catalog');
   vCatalog.Create(format(SConnectionString,[STempFileName,PassWord]));
   result:=CopyFile(PChar(STempFileName),PChar(FileName),True);
   DeleteFile(STempFileName);
 except
   result:=false;
 end;
end;

//=============================================================================
// Procedure: CompactDatabase
// Author   : ysai
// Date     : 2003-01-27
// Arguments: AFileName,APassWord:string
// Result   : boolean
//=============================================================================
function CompactDatabase(AFileName,APassWord:string):boolean;
//压缩与修复数据库,覆盖源文件
var
 STempFileName:string;
 vJE:OleVariant;
begin
 STempFileName:=GetTempPathFileName;
 try
   vJE:=CreateOleObject('JRO.JetEngine');
   vJE.CompactDatabase(format(SConnectionString,[AFileName,APassWord]),
       format(SConnectionString,[STempFileName,APassWord]));
   result:=CopyFile(PChar(STempFileName),PChar(AFileName),false);
   DeleteFile(STempFileName);
 except
   result:=false;
 end;
end;
//----------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin      //初始化设置
  adoconnection1.GetTableNames(ComboBox1.Items);
  ComboBox1.Text:=ComboBox1.Items.Strings[0];
  adotable1.Close;
  ADOTable1.ReadOnly:=true;
  adotable1.tablename:=ComboBox1.Items.Strings[0];
  adotable1.Open;
  //AdoTable1.Last;
  //NO:=strtoint(ADOTable1.Fields[0].AsString);
  //AdoTable1.First;
  ////////////////////////////////////////////////////
  FORM1.suiEdit2.Text:='系统自动加入' ;
  FORM1.suiedit3.Text:=ADOTable1.Fields[1].AsString ;
  FORM1.suiedit4.Text:=ADOTable1.Fields[2].AsString ;
  FORM1.suiedit5.Text:=ADOTable1.Fields[3].AsString ;
  FORM1.suiedit6.Text:=ADOTable1.Fields[4].AsString ;
  FORM1.suiedit7.Text:=ADOTable1.Fields[5].AsString ;
  FORM1.suiedit8.Text:=ADOTable1.Fields[6].AsString ;
  FORM1.suiedit9.Text:=ADOTable1.Fields[7].AsString ;
  FORM1.suiedit10.Text:=ADOTable1.Fields[8].AsString ;
  FORM1.suiedit11.Text:=ADOTable1.Fields[9].AsString ;
  FORM1.suiedit12.Text:=ADOTable1.Fields[10].AsString ;
  FORM1.suiedit13.Text:=ADOTable1.Fields[11].AsString ;
  FORM1.suiedit14.Text:=ADOTable1.Fields[12].AsString ;
  FORM1.suiedit15.Text:=ADOTable1.Fields[13].AsString ;
  FORM1.suiedit16.Text:=ADOTable1.Fields[14].AsString ;
  ////////////////////////////////////////////////////
  suiStatusBar1.Panels[1].text:=DateToStr(Time());
  suiStatusBar1.Panels[2].text:=TimeToStr(Time());
end;



//////////////以下为数据库的处理部分/////////////////
procedure TForm1.suiButton2Click(Sender: TObject);
        //打开新数据文件按钮
const
ConnStr = 'Provider=%s;Data Provider=%s;Data Source=%s';
mystr1='Provider=%s;Data Provider= %s;Data Source= %s;';
{给出接口参数}
myProvider='msdatashape.1';
mydataProvider='Microsoft.jet.oledb.4.0';
begin              //打开数据库并进行初始设置
  opendialog1.FileName:='*.mdb';
  if opendialog1.Execute then
    begin
    myaccess:=opendialog1.FileName;
    adoconnection1.Connected:=false;
      if not adoconnection1.connected then
        adoconnection1.ConnectionString:=format(mystr1,
          [myProvider,mydataprovider,myaccess]);
        adoconnection1.GetTableNames(ComboBox1.Items);
    ComboBox1.Text:=ComboBox1.Items.Strings[0];
    adotable1.tablename:=ComboBox1.Items.Strings[0];
    adoconnection1.Connected:=true;
    adotable1.Active:=true;
    end;
end;

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin        //以彩色显示
if gdSelected in State then
    Exit;
  if ADOTable1.RecNo mod 2 = 0 then
    DBGrid1.Canvas.Brush.Color := clInfoBk
  else
    DBGrid1.Canvas.Brush.Color := RGB(191, 255, 223);
    DBGrid1.DefaultDrawColumnCell(Rect,DataCol,Column,State);
    DBGrid1.Canvas.Pen.Color := $00C08000;
    DBGrid1.Canvas.MoveTo(Rect.Left, Rect.Bottom);
    DBGrid1.Canvas.LineTo(Rect.Right, Rect.Bottom);
    DBGrid1.Canvas.MoveTo(Rect.Right, Rect.Top);
    DBGrid1.Canvas.LineTo(Rect.Right, Rect.Bottom);
end;

procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
  Field: TField; State: TGridDrawState);
begin
with DBGrid1.Canvas do
  begin
    Pen.Color := clBlue;
    MoveTo(Rect.Left, Rect.Bottom);
    LineTo(Rect.Right, Rect.Bottom);
    Pen.Color := clGreen;
    MoveTo(Rect.Right, Rect.Top);
    LineTo(Rect.Right, Rect.Bottom);
  end;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  adotable1.Close;
  adotable1.tablename:=ComboBox1.Items.Strings[ComboBox1.itemindex];
  adotable1.Open;
end;

procedure TForm1.suiButton3Click(Sender: TObject);
var
sn:string;
begin               //查询按钮
if ADDRadio.Checked then
begin
   sn:=ADDedit.text;
   if ADOTable1.Locate('姓名',sn,[loCaseInsensitive]) then
   begin
      FORM2.suiGroupBox1.CAPTION:='查询成功';
      FORM2.Top:=DBGrid1.Top;
      FORM2.Left:=DBGrid1.Left;
      FORM2.SHOW;
      FORM2.edit1.Text:=ADOTable1.Fields[0].AsString ;
      FORM2.edit2.Text:=ADOTable1.Fields[1].AsString ;
      FORM2.edit3.Text:=ADOTable1.Fields[2].AsString ;
      FORM2.edit4.Text:=ADOTable1.Fields[3].AsString ;
      FORM2.edit5.Text:=ADOTable1.Fields[4].AsString ;
      FORM2.edit6.Text:=ADOTable1.Fields[5].AsString ;
      FORM2.edit7.Text:=ADOTable1.Fields[6].AsString ;
      FORM2.edit8.Text:=ADOTable1.Fields[7].AsString ;
      FORM2.edit9.Text:=ADOTable1.Fields[8].AsString ;
      FORM2.edit10.Text:=ADOTable1.Fields[9].AsString ;
      FORM2.edit11.Text:=ADOTable1.Fields[10].AsString ;
      FORM2.edit12.Text:=ADOTable1.Fields[11].AsString ;
      FORM2.edit13.Text:=ADOTable1.Fields[12].AsString ;
      FORM2.edit14.Text:=ADOTable1.Fields[13].AsString ;
      FORM2.edit15.Text:=ADOTable1.Fields[14].AsString ;
   end
   else
      FORM2.suiGroupBox1.CAPTION:='查询失败';
end;
if NRRadio.Checked then
 begin
  sn:=NRedit.text;
  if ADOTable1.Locate('身份证号',sn,[loCaseInsensitive]) then
  begin
      FORM2.suiGroupBox1.CAPTION:='查询成功';
      FORM2.Top:=DBGrid1.Top;
      FORM2.Left:=DBGrid1.Left;
      FORM2.SHOW;
      //a:=ADOTable1.Seek('点地址',edit3.text);
      FORM2.edit1.Text:=ADOTable1.Fields[0].AsString ;
      FORM2.edit2.Text:=ADOTable1.Fields[1].AsString ;
      FORM2.edit3.Text:=ADOTable1.Fields[2].AsString ;
      FORM2.edit4.Text:=ADOTable1.Fields[3].AsString ;
      FORM2.edit5.Text:=ADOTable1.Fields[4].AsString ;
      FORM2.edit6.Text:=ADOTable1.Fields[5].AsString ;
      FORM2.edit7.Text:=ADOTable1.Fields[6].AsString ;
      FORM2.edit8.Text:=ADOTable1.Fields[7].AsString ;
      FORM2.edit9.Text:=ADOTable1.Fields[8].AsString ;
      FORM2.edit10.Text:=ADOTable1.Fields[9].AsString ;
      FORM2.edit11.Text:=ADOTable1.Fields[10].AsString ;
      FORM2.edit12.Text:=ADOTable1.Fields[11].AsString ;
      FORM2.edit13.Text:=ADOTable1.Fields[12].AsString ;
      FORM2.edit14.Text:=ADOTable1.Fields[13].AsString ;
      FORM2.edit15.Text:=ADOTable1.Fields[14].AsString ;
  end
  else
      FORM2.suiGroupBox1.CAPTION:='查询失败';
end;
if DHRadio.Checked then
begin
   sn:=DHedit.text;
   if ADOTable1.Locate('电话',sn,[loCaseInsensitive]) then
   begin
      FORM2.suiGroupBox1.CAPTION:='查询成功';
      FORM2.Top:=DBGrid1.Top;
      FORM2.Left:=DBGrid1.Left;
      FORM2.SHOW;
      FORM2.edit1.Text:=ADOTable1.Fields[0].AsString ;
      FORM2.edit2.Text:=ADOTable1.Fields[1].AsString ;
      FORM2.edit3.Text:=ADOTable1.Fields[2].AsString ;

⌨️ 快捷键说明

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