main.pas

修改exe文件的创建时间和修改时间

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, RzCmboBx, RzTabs, ExtCtrls, RzPanel, RzPopups, RzLabel,
  ADODB, Mask, RzEdit, RzButton, RzStatus, ComCtrls, RzBtnEdt, IniFiles,
  RzTray, Menus;

type
  TfrmMain = class(TForm)
    pgc1: TRzPageControl;
    tsModifyDBDate: TRzTabSheet;
    RzStatusBar1: TRzStatusBar;
    clcksts1: TRzClockStatus;
    stspn1: TRzStatusPane;
    tsModifyFileDate: TRzTabSheet;
    dtpCreateDate: TDateTimePicker;
    dtpCreateTime: TDateTimePicker;
    dtpModifyDate: TDateTimePicker;
    dtpModifyTime: TDateTimePicker;
    edtFile: TRzButtonEdit;
    btn4: TRzBitBtn;
    lbl5: TRzLabel;
    lbl6: TRzLabel;
    lbl7: TRzLabel;
    lbl8: TRzLabel;
    lbl9: TRzLabel;
    ti1: TRzTrayIcon;
    pm2: TPopupMenu;
    miView: TMenuItem;
    miAbout: TMenuItem;
    N1: TMenuItem;
    miExit: TMenuItem;
    gb1: TRzGroupBox;
    lbl2: TRzLabel;
    lbl3: TRzLabel;
    lbl4: TRzLabel;
    edtDBIP: TRzEdit;
    edtDBUser: TRzEdit;
    edtDBPWD: TRzEdit;
    btn2: TRzBitBtn;
    RzGroupBox1: TRzGroupBox;
    lbl1: TRzLabel;
    cbbVer: TRzComboBox;
    btn1: TRzBitBtn;
    dtpVerDate: TDateTimePicker;
    lbl10: TRzLabel;
    procedure FormCreate(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure edtFileButtonClick(Sender: TObject);
    procedure btn4Click(Sender: TObject);
    procedure miViewClick(Sender: TObject);
    procedure miExitClick(Sender: TObject);
  private
    { Private declarations }
    sSqlText: string;
    DBConn: TADOConnection;
    qryPub: TADOQuery;
    procedure WriteIni(sIdent, sValue: string);
  public
    { Public declarations }
  end;

function MsgDlg(Msg: string; frmType: Integer = 0; btnType: Integer = 0): Integer;
function CovFileDate(Fd: _FileTime): TDateTime;
procedure GetFileTime(const Tf: string);
procedure SetFileDateTime(const Tf: string);

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

function MsgDlg(Msg: string; frmType: Integer = 0; btnType: Integer = 0): Integer;
const
  arrIcon: array[0..3] of Cardinal = (MB_ICONINFORMATION, MB_ICONQUESTION, MB_ICONWARNING, MB_ICONSTOP);
  arrType: array[0..3] of string = ('信息', '询问', '警告', '错误');
var
  sTitle: string;
begin
  sTitle := arrType[frmType] + ' - 久远教育装备管理系统';
  result := Application.MessageBox(PAnsiChar(Msg), PAnsiChar(sTitle), arrIcon[frmType] + btnType + MB_TOPMOST);
end;

function CovFileDate(Fd: _FileTime): TDateTime;
{ 转换文件的时间格式 }
var
  Tct: _SystemTime;
  Temp: _FileTime;
begin
  FileTimeToLocalFileTime(Fd, Temp);
  FileTimeToSystemTime(Temp, Tct);
  CovFileDate := SystemTimeToDateTime(Tct);
end;

procedure GetFileTime(const Tf: string);
{ 获取文件时间，Tf表示目标文件路径和名称 }
const
  Model = 'yyyy-mm-dd,hh:mm:ss'; { 设定时间格式 }
var
  Tp: TSearchRec; { 申明Tp为一个查找记录 }
  T1, T2, T3: string;
begin
  FindFirst(Tf, faAnyFile, Tp); { 查找目标文件 }
  T1 := FormatDateTime(Model, CovFileDate(Tp.FindData.ftCreationTime));
  //返回文件的创建时间
  T2 := FormatDateTime(Model, CovFileDate(Tp.FindData.ftLastWriteTime));
  //返回文件的修改时间
  T3 := FormatDateTime(Model, Now);
  //返回文件的当前访问时间
  FindClose(Tp);
end;

procedure SetFileDateTime(const Tf: string);
{ 设置文件时间，Tf表示目标文件路径和名称 }
var
  Dt1, Dt2: Integer;
  Fs: TFileStream;
  Fct, Flt: TFileTime;
begin
  Dt1 := DateTimeToFileDate(Trunc(frmMain.dtpCreateDate.Date) + Frac(frmMain.dtpCreateTime.Time));
  Dt2 := DateTimeToFileDate(Trunc(frmMain.dtpModifyDate.Date) + Frac(frmMain.dtpModifyTime.Time));
  { 转换用户输入在DataTimePicker中的信息 }
  try
    FS := TFileStream.Create(Tf, fmOpenReadWrite);
    try
      if DosDateTimeToFileTime(LongRec(DT1).Hi, LongRec(DT1).Lo, Fct) and LocalFileTimeToFileTime(Fct, Fct)
        and DosDateTimeToFileTime(LongRec(DT2).Hi, LongRec(DT2).Lo, Flt) and LocalFileTimeToFileTime(Flt, Flt) then
        SetFileTime(FS.Handle, @Fct, @Flt, @Flt);
      { 设置文件时间属性 }
    finally
      FS.Free;
    end;
  except
    MsgDlg('日期修改操作失败！', 3);
    { 因为目标文件正在被使用等原因而导致失败 }
  end;
end;

procedure TfrmMain.WriteIni(sIdent, sValue: string);
var
  ini: TIniFile;
begin
  ini := TIniFile.Create('JyToolConfig.ini');
  try
    ini.WriteString('SYSTEM', sIdent, sValue);
  finally
    ini.Free;
  end
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  ini: TIniFile;
begin
  ini := TIniFile.Create('JyToolConfig.ini');
  try
    edtDBIP.Text := ini.ReadString('SYSTEM', 'DBIP','');
    edtDBUser.Text := ini.ReadString('SYSTEM', 'DBUser','');
    edtDBPWD.Text := ini.ReadString('SYSTEM', 'DBPWD','');
  finally
    ini.Free;
  end;
  DBConn := TADOConnection.Create(Self);
  qryPub := TADOQuery.Create(Self);
  qryPub.Connection := DBConn;
  dtpCreateDate.Date := Date;
  dtpModifyDate.Date := Date;
  dtpVerDate.Date := Date;
end;

procedure TfrmMain.btn2Click(Sender: TObject);
begin
  sSqlText := 'Provider=SQLOLEDB.1;Password=' + edtDBPwd.Text + ';Persist Security Info=True;User ID='
    + edtDBUser.Text + ';Initial Catalog=master;Data Source=' + edtDBIP.Text;
  try
    if DBConn.Connected then DBConn.Close;
    DBConn.ConnectionString := sSqlText;
    DBConn.LoginPrompt := False;
    DBConn.CommandTimeout := 15;
    DBConn.Connected := True;
    WriteIni('DBIP', edtDBIP.Text);
    WriteIni('DBUSER', edtDBUser.Text);
    WriteIni('DBPWD', edtDBPWD.Text);
    MsgDlg('数据库连接成功！');
  except
    on e: Exception do
    begin
      MsgDlg('连接数据库失败！' + #13#10#10 + e.Message, 3);
      Application.Terminate;
    end;
  end;
end;

procedure TfrmMain.btn1Click(Sender: TObject);
begin
  if not DBConn.Connected then
  begin
    MsgDlg('数据库还没有连接！');
    Exit;
  end;

  if cbbVer.ItemIndex = 0 then
  begin
    try
      sSqlText := 'select prover from zbgl_xj_ty.dbo.bbdzb';
      qryPub.Close;
      qryPub.SQL.Text := sSqlText;
      qryPub.Open;
      if not qryPub.IsEmpty then
      begin
        if MsgDlg('当前程序版本日期为' + qrypub.fieldByName('prover').AsString + ',确定修改为'
          + FormatDateTime('yyyy-mm-dd', dtpVerDate.Date), 1, 1) <> IDOK then Exit;
        sSqlText := 'update zbgl_xj_ty.dbo.bbdzb set prover=''' + FormatDateTime('yyyy-mm-dd', dtpVerDate.Date) + '''';
      end;
    except
      on e: Exception do
      begin
        MsgDlg('修改程序版本日期出错！' + #13#10#10 + e.Message, 3);
        Application.Terminate;
      end;
    end;
  end
  else if cbbVer.ItemIndex = 1 then
  begin
    try
      sSqlText := 'select prover from zbgl_gl_ty.dbo.bbdzb';
      qryPub.Close;
      qryPub.SQL.Text := sSqlText;
      qryPub.Open;
      if not qryPub.IsEmpty then
      begin
        if MsgDlg('当前程序版本日期为' + qrypub.fieldByName('prover').AsString + ',确定修改为'
          + FormatDateTime('yyyy-mm-dd', dtpVerDate.Date), 1, 1) <> IDOK then Exit;
        sSqlText := 'update zbgl_gl_ty.dbo.bbdzb set prover=''' + FormatDateTime('yyyy-mm-dd', dtpVerDate.Date) + '''';
      end;
    except
      on e: Exception do
      begin
        MsgDlg('修改程序版本日期出错！' + #13#10#10 + e.Message, 3);
        Application.Terminate;
      end;
    end;
  end;
  try
    qryPub.Close;
    qryPub.SQL.Text := sSqlText;
    qryPub.ExecSQL;
  except
    on e: Exception do
    begin
      MsgDlg('修改程序版日期出错！' + #13#10#10 + e.Message, 3);
      Application.Terminate;
    end;
  end;
end;

procedure TfrmMain.edtFileButtonClick(Sender: TObject);
var
  fn: string;
begin
  if PromptForFileName(fn) then edtFile.Text := fn;
end;

procedure TfrmMain.btn4Click(Sender: TObject);
begin
  if not FileExists(edtFile.Text) then
  begin
    MsgDlg('文件不存在!');
    Exit;
  end;
  if MsgDlg('确定修改文件创建日期和修改日期吗?', 1, 1) = IDOK then
    SetFileDateTime(edtFile.Text);
end;

procedure TfrmMain.miViewClick(Sender: TObject);
begin
  ti1.RestoreApp;
end;

procedure TfrmMain.miExitClick(Sender: TObject);
begin
  Close;
end;

end.